$CONTROL MAP,CODE,USLINIT                                               00010000
<< ABORTDUMP -- MODULE 58 >>                                   <<01070>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$CONTROL MAIN=ABORTDUMP,SEGMENT=ABORTDUMP                      <<00652>>00030000
$CONTROL PRIVILEGED                                                     00032000
          << >>                                                         00034000
          << A B O R T    APR 15,1976 >>                                00036000
          <<TRAP MECHANISM AND ABORT INTERFACE INTRINSICS>>             00038000
          << >>                                                         00040000
BEGIN                                                                   00042000
EQUATE                                                                  00044000
         DSTB      =2,                                                  00046000
         PCBB      =3,                                                  00048000
         CPCB      =4,                                                  00050000
         PCBSIZE   =16,                                                 00052000
         SYSTEMSL  =0,                                                  00054000
         CCG       =0,                                                  00056000
         CCL       =1,                                                  00058000
         CCE       =2;                                                  00060000
INTEGER  STATUS    =Q-1,                                                00062000
         X         =X;                                                  00064000
LOGICAL  POINTER DSTL'=DSTB,                                            00066000
                 PCBL'=PCBB;                                            00068000
INTEGER POINTER DSTI'=DSTB;                                    <<00652>>00070000
INTEGER POINTER                                                         00072000
                 PCBI'=PCBB;                                            00074000
DEFINE   F         =ABSOLUTE#,                                          00076000
         ABS       =ABSOLUTE#,                                 <<03046>>00078000
         LOG       =LOGICAL#,                                  <<03046>>00080000
         ASMB      =ASSEMBLE#,                                          00082000
         DUPLICATE =ASMB(DUP)#,                                         00084000
         TRIPLICATE=ASMB(DUP,DUP)#,                                     00086000
         PIX       =(F(CPCB)-F(PCBB))#,                                 00088000
         TRAPSOFF  =PUSH(STATUS);TOS.(2:1)_0;SET(STATUS)#,              00090000
         DISABLE   =ASMB(SED 0)#,                                       00092000
       SYSTEMFLAG=(6:1)#,                                      <<01549>>00094000
         LBITE     =( 0: 8)#,                                           00096000
         RBITE     =( 8: 8)#,                                           00098000
         TRAPFLD   =( 2: 1)#,                                           00100000
         CCFLD     =( 6: 2)#,                                           00102000
         CSTFIELD  =( 8: 8)#;                                           00104000
$PAGE                                                                   00106000
EQUATE PIINFONIMPPINWORDNUM=%10;                               <<01549>>00108000
DEFINE PSIMFIELD=(0:3)#;                                       <<01549>>00110000
          << >>                                                         00112000
          <<EXTERNAL PROCEDURES>>                                       00114000
          << >>                                                         00116000
                                                               <<01549>>00118000
INTEGER PROCEDURE CONVEXTLABELTODELTAP(EXTLABEL);              <<01549>>00120000
VALUE EXTLABEL;                                                <<01549>>00122000
INTEGER EXTLABEL;                                              <<01549>>00124000
OPTION EXTERNAL;                                               <<01549>>00126000
                                                               <<01549>>00128000
LOGICAL PROCEDURE RESETBREAKBITS(A,B);                         <<00.EB>>00130000
   VALUE      A,B;                                                      00132000
   INTEGER    A,B;                                                      00134000
   OPTION     EXTERNAL;                                                 00136000
LOGICAL PROCEDURE IOCONTROL(LDEV,FUNC);                                 00138000
   VALUE      LDEV,FUNC;                                                00140000
   INTEGER    LDEV,FUNC;                                                00142000
   OPTION     EXTERNAL;                                                 00144000
INTEGER PROCEDURE BUILDSEGID(SEGTYPE,SEGNUMBER,PIN);           <<01632>>00146000
VALUE SEGTYPE,SEGNUMBER,PIN;                                   <<01632>>00148000
INTEGER SEGTYPE,SEGNUMBER,PIN;                                 <<01632>>00150000
OPTION EXTERNAL;                                               <<01632>>00152000
INTEGER PROCEDURE CONVSEGIDTOSTINX(SEGIDENT);                  <<01632>>00154000
VALUE SEGIDENT;                                                <<01632>>00156000
INTEGER SEGIDENT;                                              <<01632>>00158000
OPTION EXTERNAL;                                               <<01632>>00160000
PROCEDURE SET'PSIF(PINX,FLAG);                                          00162000
   VALUE      PINX,FLAG;                                                00164000
   INTEGER    PINX;                                                     00166000
   LOGICAL    FLAG;                                                     00168000
   OPTION     EXTERNAL;                                                 00170000
PROCEDURE CLEAR'PSIF(PINX,FLAG);                                        00172000
   VALUE      PINX,FLAG;                                                00174000
   INTEGER    PINX;                                                     00176000
   LOGICAL    FLAG;                                                     00178000
   OPTION     EXTERNAL;                                                 00180000
PROCEDURE HELP;                                                         00182000
   OPTION     EXTERNAL;                                                 00184000
PROCEDURE FREEZE(EN,TYPE,PINX);                                         00186000
   VALUE      EN,TYPE,PINX;                                             00188000
   INTEGER    EN,TYPE,PINX;                                             00190000
   OPTION     EXTERNAL;                                                 00192000
PROCEDURE UNFREEZE(EN,TYPE,PINX);                                       00194000
   VALUE      EN,TYPE,PINX;                                             00196000
   INTEGER    EN,TYPE,PINX;                                             00198000
  OPTION EXTERNAL;                                                      00200000
          << >>                                                         00202000
PROCEDURE TERMINATE;                                                    00204000
  OPTION EXTERNAL;                                                      00206000
          << >>                                                         00208000
PROCEDURE SUDDENDEATH(N);                                               00210000
  VALUE N;LOGICAL N;OPTION EXTERNAL;                                    00212000
          << >>                                                         00214000
LOGICAL PROCEDURE EXCHANGEDB(IX);                                       00216000
  VALUE IX;LOGICAL IX;OPTION EXTERNAL;                                  00218000
          << >>                                                         00220000
LOGICAL PROCEDURE SETSYSDB;     OPTION EXTERNAL;                        00222000
          << >>                                                         00224000
PROCEDURE RESETDB(IX);                                                  00226000
  VALUE IX;LOGICAL IX;OPTION EXTERNAL;                                  00228000
          << >>                                                         00230000
PROCEDURE RESUMESOFTINT;                                       <<03046>>00232000
   OPTION EXTERNAL;                                            <<03046>>00234000
             << >>                                             <<03046>>00236000
LOGICAL PROCEDURE SETCRITICAL;                                          00238000
  OPTION EXTERNAL;                                                      00240000
          << >>                                                         00242000
PROCEDURE RESETCRITICAL(C);                                             00244000
  VALUE C;LOGICAL C;OPTION EXTERNAL;                                    00246000
          << >>                                                         00248000
INTEGER PROCEDURE MAKEPRESENT(M,T,O,P);                                 00250000
  VALUE   M,T,O,P;                                                      00252000
  INTEGER M,T,O,P;        OPTION EXTERNAL;                              00254000
          << >>                                                         00256000
          << >>                                                         00258000
PROCEDURE ERRORON;         OPTION EXTERNAL;                             00260000
          << >>                                                         00262000
PROCEDURE ERROREXIT(I,E,P);                                             00264000
  VALUE I,E,P;LOGICAL I,E,P;OPTION EXTERNAL;                            00266000
          << >>                                                         00268000
DOUBLE PROCEDURE CHEK(INT,FL,PARM,CAPM,OVM);                            00270000
  VALUE   INT,FL,PARM,CAPM,OVM;                                         00272000
  LOGICAL INT,FL,OVM;                                                   00274000
  DOUBLE  PARM,CAPM;                                                    00276000
  OPTION EXTERNAL,VARIABLE;                                             00278000
          << >>                                                         00280000
LOGICAL PROCEDURE GETJCW;                                      <<U.RAO>>00282000
OPTION EXTERNAL;                                               <<U.RAO>>00284000
          << >>                                                         00286000
PROCEDURE SETJCW(W);                                                    00288000
  VALUE W;LOGICAL W;OPTION EXTERNAL;                                    00290000
          << >>                                                         00292000
PROCEDURE PROCFILE(PIN,B);                                              00294000
  VALUE PIN;LOGICAL PIN;BYTE ARRAY B;OPTION EXTERNAL;                   00296000
          << >>                                                         00298000
DOUBLE PROCEDURE LOGICALCST(PHYCST);                                    00300000
  VALUE PHYCST;LOGICAL PHYCST;OPTION EXTERNAL;                          00302000
          << >>                                                         00304000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<02.EB>>00306000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<02.EB>>00308000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<02.EB>>00310000
      DST,IOTYPE;                                              <<02.EB>>00312000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<02.EB>>00314000
      DST,IOTYPE;                                              <<02.EB>>00316000
   OPTION VARIABLE,EXTERNAL;                                   <<02.EB>>00318000
PROCEDURE STACKDUMP(FL,ID,FLAGS,SELEC);                        <<C0.00>>00320000
BYTE ARRAY FL;LOGICAL FLAGS;INTEGER ID;DOUBLE ARRAY SELEC;     <<C0.00>>00322000
OPTION FORWARD,VARIABLE;                                       <<00652>>00324000
                                                               <<C0.00>>00326000
PROCEDURE MARKER(P,BOUTB);                                     <<C0.00>>00328000
VALUE P;INTEGER P;BYTE ARRAY BOUTB;                            <<C0.00>>00330000
OPTION FORWARD;                                                <<00652>>00332000
                                                               <<C0.00>>00334000
PROCEDURE REGIST(SX,BOUTB);                                    <<C0.00>>00336000
VALUE SX;INTEGER SX;BYTE ARRAY BOUTB;                          <<C0.00>>00338000
OPTION FORWARD;                                                <<00652>>00340000
                                                               <<C0.00>>00342000
INTEGER PROCEDURE PHYSICALCST(P,S);                            <<C0.00>>00344000
VALUE P,S;INTEGER P,S;    OPTION EXTERNAL;                     <<C0.00>>00346000
                                                               <<C0.00>>00348000
PROCEDURE DEBUG;    OPTION EXTERNAL;                           <<C0.00>>00350000
LOGICAL PROCEDURE DMOVE'(DS,DI,N,LOC,D,NU);                    <<00652>>00352000
VALUE DS,DI,N,LOC,D,NU;                                        <<00652>>00354000
LOGICAL DS,D; INTEGER DI,N,LOC,NU;                             <<00652>>00356000
OPTION EXTERNAL;                                               <<00652>>00358000
                                                               <<00652>>00360000
LOGICAL PROCEDURE PXDSEG(FUNC,PARM);                           <<00652>>00362000
VALUE FUNC,PARM; LOGICAL FUNC,PARM;                            <<00652>>00364000
OPTION EXTERNAL;                                               <<00652>>00366000
                                                               <<00652>>00368000
INTRINSIC ASCII,FOPEN,FCLOSE,FGETINFO,FWRITE;                  <<00652>>00370000
INTRINSIC FCHECK,FCONTROL,PRINT;                               <<00652>>00372000
                                                               <<00652>>00374000
$PAGE                                                                   00376000
                                                               <<C0.00>>00378000
LOGICAL PROCEDURE SYSTEM(CSTEN);                                        00380000
   VALUE      CSTEN;                                                    00382000
   INTEGER    CSTEN;                                                    00384000
   OPTION     INTERNAL;                                                 00386000
   BEGIN                                                                00388000
INTEGER SEGID;                                                 <<01632>>00390000
SEGID:=BUILDSEGID(IF CSTEN > %300 THEN 2 <<PROGRAM>>           <<01632>>00392000
ELSE 1,CSTEN,PIX/PCBSIZE);                                     <<01632>>00394000
SYSTEM:=DSTL'(CONVSEGIDTOSTINX(SEGID)+1).SYSTEMFLAG;           <<01632>>00396000
   END <<SYSTEM>> ;                                                     00398000
$PAGE                                                                   00400000
            << >>                                                       00402000
            << ABORT ROUTINE >>                                         00404000
            << >>                                                       00406000
<<MODE.(0:8) = NUMBER OF MARKERS TO BE DELETED.           >>   <<U.RAO>>00408000
<<MODE.(8:8) = TYPE OF ABORT                              >>   <<U.RAO>>00410000
<<   0 = INTERNAL INTERRUPT, HARDWARE OR SIMULATED.       >>   <<U.RAO>>00412000
<<       CODE = TYPE OF INTERNAL INTERRUPT.               >>   <<U.RAO>>00414000
<<          0 = ?                                         >>   <<U.RAO>>00416000
<<          1 = INTEGER OVERFLOW                          >>   <<U.RAO>>00418000
<<          2 = FLOATING POINT OVERFLOW                   >>   <<U.RAO>>00420000
<<          3 = FLOATING POINT UNDERFLOW                  >>   <<U.RAO>>00422000
<<          4 = INTEGER DIVIDE BY ZERO                    >>   <<U.RAO>>00424000
<<          5 = FLOATING POINT DIVIDE BY ZERO             >>   <<U.RAO>>00426000
<<          6 = PRIVILEGED MODE INSTRUCTION TRAP          >>   <<U.RAO>>00428000
<<          7 = UNIMPLEMENTED INSTRUCTION TRAP            >>   <<U.RAO>>00430000
<<          8 = EXTENDED PRECISION OVERFLOW               >>   <<U.RAO>>00432000
<<          9 = EXTENDED PRECISION UNDERFLOW              >>   <<U.RAO>>00434000
<<         10 = EXTENDED PRECISION DIVIDE BY ZERO         >>   <<U.RAO>>00436000
<<         11 = DECIMAL OVERFLOW                          >>   <<U.RAO>>00438000
<<         12 = INVALID ASCII DIGIT IN DECIMAL INSTRUCTION>>   <<U.RAO>>00440000
<<         13 = INVALID DECIMAL DIGIT                     >>   <<U.RAO>>00442000
<<         14 = INVALID SOURCE WORD COUNT                 >>   <<U.RAO>>00444000
<<         15 = INVALID DECIMAL OPERAND LENGTH            >>   <<U.RAO>>00446000
<<         16 = DECIMAL DIVIDE BY ZERO                    >>   <<U.RAO>>00448000
<<         17 = STT UNCALLABLE                            >>   <<U.RAO>>00450000
<<         18 UNUSED                                      >>   <<U.RAO>>00452000
<<         19 UNUSED                                      >>   <<U.RAO>>00454000
<<         20 = STACK OVERFLOW                            >>   <<U.RAO>>00456000
<<         21 UNUSED                                      >>   <<U.RAO>>00458000
<<         22 = BAD STACK MARKER                          >>   <<U.RAO>>00460000
<<         23 = ILLEGAL ADDRESS (NO SUCH MEMORY ADDRESS)  >>   <<U.RAO>>00462000
<<         24 = BOUNDS VIOLATION (TYPICALLY USER ERROR)   >>   <<U.RAO>>00464000
<<         25 = NON-RESPONDING MODULE                     >>   <<U.RAO>>00466000
<<         26 UNUSED                                      >>   <<U.RAO>>00468000
<<         27 UNUSED                                      >>   <<U.RAO>>00470000
<<         28 UNUSED                                      >>   <<U.RAO>>00472000
<<         29 = STACK UNDERFLOW                           >>   <<U.RAO>>00474000
<<         30 = CST VIOLATION                             >>   <<U.RAO>>00476000
<<         31 = STT VIOLATION                             >>   <<U.RAO>>00478000
<<MODE.(8:8) = 1 => INTRINSIC ERROR                           ><<U.RAO>>00480000
<<   CODE = INTRINEXIT, DEFINED AS                            ><<U.RAO>>00482000
<<         10:6 = NUMBER OF PARAMETER WORDS                   ><<U.RAO>>00484000
<<         0:10 = INTRINSIC NUMBER                            ><<U.RAO>>00486000
<<   PARAM = TYPE OF ERROR                                    ><<U.RAO>>00488000
<<         1 = ILLEGAL DB REGISTER (SPLIT STACK NOT ALLOWED   ><<U.RAO>>00490000
<<         2 = ILLEGAL CAPABILITY (INSUFFICIENT CAPABILITY)   ><<U.RAO>>00492000
<<         3 = OMITTED PARAMETER (REQUIRED PARM FOR OPT. VAR.)><<U.RAO>>00494000
<<         4 = INCORRECT S REGISTER (NOT ENOUGH STACK)        ><<U.RAO>>00496000
<<         5 = PARAMETER ADDRESS VIOLATION                    ><<U.RAO>>00498000
<<         6 = PARAMETER END ADDRESS VIOLATION                ><<U.RAO>>00500000
<<         7 = ILLEGAL PARAMETER (?)                          ><<U.RAO>>00502000
<<         8 = PARAMETER VALUE INVALID                        ><<U.RAO>>00504000
<<         9 = INCORRECT Q REGISTER                           ><<U.RAO>>00506000
<<MODE.(8:8) = 2 => QUIT CALL                                 ><<U.RAO>>00508000
<<   CODE = 0                                                 ><<U.RAO>>00510000
<<   PARAM = USER SUPPLIED QUIT NUMBER                        ><<U.RAO>>00512000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 18, PROCESS QUIT>>     <<U.RAO>>00514000
<<MODE.(8:8) = 3 => QUITPROG CALL                             ><<U.RAO>>00516000
<<   CODE = 0                                                 ><<U.RAO>>00518000
<<   PARAM = USER SUPPLIED QUIT NUMBER                        ><<U.RAO>>00520000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 19, PROGRAM QUIT>>     <<U.RAO>>00522000
<<MODE.(8:8) = 4 => STACK OVERFLOW IN DATASEG                 ><<U.RAO>>00524000
<<   CODE & PARAM IGNORED.                                    ><<U.RAO>>00526000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 20, STACK OVERFLOW>>   <<U.RAO>>00528000
<<MODE.(8:8) = 5 => HARD KILL FROM ABORTPROG (:ABORT, ETC.)   ><<U.RAO>>00530000
<<   CODE & PARAM IGNORED.                                    ><<U.RAO>>00532000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 21, PROGRAM KILLED>>   <<U.RAO>>00534000
            << ABORT:PROCESS LOC:LIBRARY LOC:MESSAGE  >>                00536000
            <<  CR  :SYSPROC LOC:LIBRARY LOC:MESSAGE  >>                00538000
            << >>                                                       00540000
PROCEDURE ABORT(MODE,CODE,PARAM);                                       00542000
  VALUE   MODE,CODE,PARAM;                                              00544000
  LOGICAL MODE,CODE,PARAM;                                              00546000
  OPTION  PRIVILEGED,UNCALLABLE;                                        00548000
  BEGIN                                                                 00550000
                                                               <<02.EB>>00552000
          EQUATE                                                        00554000
                     PCBLINK=5,                                         00556000
                     PCBSYS =9 ,                                        00558000
                     PXQINIT=3,    <<PCBX>>                             00560000
                     PXABORTY=12,                                       00562000
                     PXAMASK=14,                               <<03046>>00564000
                     PXAPLAB=15,                               <<03046>>00566000
                     PXSPLAB=17,                               <<03046>>00568000
                     PXCPLAB=%77,                              <<03046>>00570000
                     PXERROR=35,                                        00572000
                     SML   =PCBSYS-PCBLINK,                             00574000
                     LIBRX=0,      <<LOC>>                              00576000
                     PROCX=4,                                           00578000
                     PV  =1,                                            00580000
                     CSTL=2,                                            00582000
                     TYPL=3,                                            00584000
                     PROGN=3,                                           00586000
                     STOP ="..",   <<SPEC CHAR>>                        00588000
                     COLON="::",                                        00590000
                     ASTER="**",                                        00592000
                     QUEST="??",                                        00594000
                     PERCENT="%%",                                      00596000
                     PCB2 = 2,                                          00598000
                     BLANK="  ",                               <<02.EB>>00600000
                     MISCSET=3,                                <<02.EB>>00602000
                     PGMERRSET=4,                              <<02.EB>>00604000
                     INTRINSET=5,                              <<02.EB>>00606000
                     RUNTIMESET=6,                             <<02.EB>>00608000
                     FSYSSET=8,                                <<02.EB>>00610000
                     LOADSET=9,                                <<02.EB>>00612000
                     CREATESET=10,                             <<02.EB>>00614000
                     ACTIVATESET=11,                           <<02.EB>>00616000
                     SUSPENDSET=12,                            <<02.EB>>00618000
                     MYCOMMANDSET=13,                          <<02.EB>>00620000
                     LOCKGLORINSET=14,                         <<02.EB>>00622000
                     PARAMSG=15,                               <<02.EB>>00624000
                     FS=FSYSSET,                               <<02.EB>>00626000
                     L=LOADSET,                                <<02.EB>>00628000
                     C=CREATESET,                              <<02.EB>>00630000
                     A=ACTIVATESET,                            <<02.EB>>00632000
                     S=SUSPENDSET,                             <<02.EB>>00634000
                     M=MYCOMMANDSET,                           <<02.EB>>00636000
                     LK=LOCKGLORINSET;                         <<02.EB>>00638000
          DEFINE     SIGNFLD=(0:1)#,                                    00640000
                     IFLD=(0:10)#,     <<PARAMETERS>>                   00642000
                     RSOFLD=(3:1)#,                                     00644000
                     PCBDSTF=(1:10)#,  <<PCB>>                          00646000
                     PCBFTHF=(0:8)#,                                    00648000
                     PCBSYSF=(6:1)# ,                                   00650000
                     PCBSOMF=(6:3)#,                                    00652000
                     PFLD=(2:14)#;     <<SM>>                           00654000
                                                               <<03046>>00656000
          DEFINE     INSTR'TRAP= TYPE=0 AND ((CODE>16 LAND     <<03046>>00658000
                                 CODE<>20) OR CODE = 6 OR      <<03046>>00660000
                                 CODE=7) #,                    <<03046>>00662000
                     ARITH'TRAP= TYPE=0 AND CODE<=16 AND       <<03046>>00664000
                                 CODE<>6 AND CODE <>7 #;       <<03046>>00666000
          BYTE ARRAY LIBR(0:11)=PB_"SYSLPUSLGRSL";                      00668000
          << >>                                                         00670000
          DOUBLE DBVALUE;                                               00672000
          LOGICAL PROGFLAG,CRITFLAG,DBFIXED;                            00674000
          INTEGER I,J,K,BP,WP,LN,TYPE;                                  00676000
          INTEGER JMIN,PHY,CSTX,PX,T,PPP,LTYP;                          00678000
          INTEGER DBSAVE,PLAB,STATX,XX;                                 00680000
          INTEGER PIN,PINX,CNT,LIBX,PXFIX=T;                            00682000
          INTEGER ARRAY STAK(*)=DB+0;                                   00684000
          INTEGER ARRAY STACK(*)=Q+0;                                   00686000
          ARRAY ERROR(0:5)=Q;                                           00688000
          ARRAY LOC(0: 7)=Q;                                            00690000
          ARRAY MSG(0:50)=Q;                                            00692000
          BYTE ARRAY BMSG(*)=MSG;                                       00694000
          BYTE ARRAY NAME(*)=MSG(20);                                   00696000
$PAGE                                                                   00698000
                                                               <<C0.00>>00700000
<<VARIABLE FOR STACK ABORT>>                                   <<C0.00>>00702000
ARRAY PCBX(*)=Q+0;                                             <<C0.00>>00704000
LOGICAL STDF,JOBTYPE=CRITFLAG,RWF=PROGFLAG;                             00706000
INTEGER DBGCST=WP,DBGDP=LN;                                    <<C0.00>>00708000
LOGICAL SYSCST;                                                <<C0.00>>00710000
INTEGER BASE=PIN,QIN=CNT,INX=JMIN;                             <<C0.00>>00712000
DOUBLE ARRAY DUMP(*)=MSG(0);                                   <<C0.00>>00714000
INTEGER BASES;                                                 <<C0.00>>00716000
ARRAY WDUMP(*)=MSG(0);                                         <<C0.00>>00718000
<<VARIABLES FOR ABORT MESSAGE>>                                <<C+.09>>00720000
INTEGER                                                        <<02.EB>>00722000
   PARAM' = I,                                                 <<02.EB>>00724000
   INTRINDEX = J,                                              <<02.EB>>00726000
   TABLENO = K,                                                <<02.EB>>00728000
   MSGNO = BP;                                                 <<02.EB>>00730000
                                                                        00732000
BYTE ARRAY INTRIN(*) = PB :=                                   <<02.EB>>00734000
                                                               <<02.EB>>00736000
<<      0  1  2  3  4  5  6  7  8  9  >>                       <<02.EB>>00738000
                                                               <<02.EB>>00740000
<< 0 >> 0,FS,FS,FS,FS,FS,FS,FS, 0,FS,                          <<02.EB>>00742000
<<10 >>FS,FS,FS,FS,FS,FS,FS,FS,FS,FS,                          <<02.EB>>00744000
<<20 >>FS, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00746000
<<30 >> 0, 0, 0, 0,LK, 0, 0, 0, 0, 0,                          <<02.EB>>00748000
<<40 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00750000
<<50 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00752000
<<60 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00754000
<<70 >> 0, M, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00756000
<<80 >> L, L, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00758000
<<90 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00760000
<<100>> C, 0, 0, S, A, 0, 0, 0, 0, 0,                          <<02.EB>>00762000
<<110>> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>00764000
<<120>> C;                                                     <<02.EB>>00766000
                                                               <<02.EB>>00768000
ARRAY INTRIN'(*) = INTRIN;                                     <<02.EB>>00770000
                                                               <<02.EB>>00772000
          << >>                                                         00774000
          <<INIT BUFFER AND BYTE POINTER>>                              00776000
    SUBROUTINE INITBUF;                                                 00778000
      BEGIN                                                             00780000
          MSG _ BLANK;                                                  00782000
          MOVE MSG(1) _ MSG,(40);                                       00784000
          BP_2;                                                         00786000
      END;                                                              00788000
                                                                        00790000
                                                                        00792000
          <<FORMAT SPECIAL CHARACTER>>                                  00794000
    SUBROUTINE CHAR(CH);                                                00796000
      VALUE    CH;                                                      00798000
      LOGICAL  CH;                                                      00800000
      BEGIN                                                             00802000
          BMSG(BP)_CH;                                                  00804000
          BP := BP + 1;                                                 00806000
      END;                                                              00808000
          <<CONVERT/FORMAT OCTAL NUMBER>>                               00810000
    SUBROUTINE FORMOCT(N);                                              00812000
      VALUE    N;                                                       00814000
      INTEGER  N;                                                       00816000
      BEGIN                                                             00818000
          CHAR(PERCENT);                                                00820000
          LN_ASCII(N, 8,BMSG(BP));                                      00822000
          IF LN=0 THEN LN_1;                                            00824000
          MOVE BMSG(BP)_BMSG(BP+6-LN),(6);                              00826000
          BP := BP + LN;                                                00828000
      END;                                                              00830000
          <<FORMAT   (SEG #).(P-PB LOC) >>                              00832000
    SUBROUTINE FORMLOC(IX);                                             00834000
      VALUE    IX;                                                      00836000
      LOGICAL  IX;                                                      00838000
      BEGIN                                                             00840000
          CHAR(STOP);                                                   00842000
          IF LOC(IX)<>0 OR NOT PROGFLAG                                 00844000
               THEN  FORMOCT(LOC(IX+CSTL))                              00846000
               ELSE  CHAR(QUEST);                                       00848000
          CHAR(STOP);                                                   00850000
          IF LOC(IX)<>0                                                 00852000
               THEN  FORMOCT(LOC(IX+PV)-1)                              00854000
               ELSE  CHAR(QUEST);                                       00856000
      END;                                                              00858000
          <<FORMAT PROCESS LOCATION  :(FILE).(SEG #).(P-PB LOC) >>      00860000
    SUBROUTINE PROCLOC;                                                 00862000
      BEGIN                                                             00864000
          CHAR(COLON);                                                  00866000
          MOVE BMSG(BP) _ NAME,(CNT);                                   00868000
          NAME _ BLANK;                                                 00870000
          MOVE NAME(1) _ NAME,(CNT);                                    00872000
          BP := BP + CNT;                                               00874000
          FORMLOC(PROCX);                                               00876000
      END;                                                              00878000
                                                                        00880000
                                                                        00882000
          <<FORMAT PROCREATED PROCESS  :*XLIB.(SEG #).(P-PB LOC)  >>    00884000
                                                                        00886000
    SUBROUTINE PRCRLOC;                                                 00888000
      BEGIN                                                             00890000
          CHAR(COLON);                                                  00892000
          CHAR(ASTER);                                                  00894000
          MOVE BMSG(BP)_LIBR(LOC(PROCX+TYPL)&LSL(2)),(4);               00896000
          BP := BP + 4;                                                 00898000
          FORMLOC(PROCX);                                               00900000
      END;                                                              00902000
                                                                        00904000
                                                                        00906000
          <<FORMAT LIBRARY LOCATION  : SLIB.(SEG #).(P-PB LOC) >>       00908000
                                                                        00910000
    SUBROUTINE LIBRLOC;                                                 00912000
      BEGIN                                                             00914000
          IF LOC(LIBRX)=0 THEN RETURN;                                  00916000
          CHAR(COLON);                                                  00918000
          MOVE BMSG(BP)_LIBR(LOC(LIBRX+TYPL)&LSL(2)),(4);               00920000
          BP := BP + 4;                                                 00922000
          FORMLOC(LIBRX);                                               00924000
      END;                                                              00926000
                                                                        00928000
                                                                        00930000
          <<KILL PROGRAM PROCESS STRUCTURE>>                            00932000
                                                                        00934000
   SUBROUTINE KILLPROG;                                                 00936000
     BEGIN                                                              00938000
         IF PCBI'(PINX+PCBSYS).PCBSOMF = 0 THEN                         00940000
          BEGIN                                                         00942000
           TOS _ PCBI'(X_X-SML).PCBFTHF; <<FATHER LINK>>                00944000
DADL     : TOS _ PCBI'(TOS*PCBSIZE+PCBLINK).PCBFTHF;<<DAD>>             00946000
           IF PCBI'(X_X+SML).PCBSOMF <> 1 THEN                          00948000
            GOTO DADL;           <<NOT USER SON OF MAIN>>               00950000
           DEL;                                                         00952000
           SET'PSIF(X:=X-PCBSYS,%40);   <<SET HK PSEUDO INT>>  <<00.05>>00954000
          END;                                                          00956000
    END <<KILLPROG>> ;                                                  00958000
                                                                        00960000
INTEGER SUBROUTINE NEXTSET(SETNO,MSGNO);                       <<02.EB>>00962000
   VALUE SETNO,MSGNO;                                          <<02.EB>>00964000
   INTEGER SETNO,MSGNO;                                        <<02.EB>>00966000
BEGIN << EXTRACTS BYTE FROM INTRIN ARRAY FOR INTRINSICS >>     <<02.EB>>00968000
                                                               <<02.EB>>00970000
NEXTSET := IF SETNO = INTRINSET THEN                           <<02.EB>>00972000
   IF LOGICAL(MSGNO) THEN INTRIN'(MSGNO &LSR(1)).(8:8)         <<02.EB>>00974000
   ELSE INTRIN'(MSGNO &LSR(1)).(0:8) ELSE                      <<02.EB>>00976000
      << GET LEFT OR RIGHT BYTE FROM ARRAY >>                  <<02.EB>>00978000
   IF SETNO = LOADSET THEN FSYSSET ELSE                        <<02.EB>>00980000
   IF SETNO = CREATESET THEN LOADSET ELSE 0;                   <<02.EB>>00982000
                                                               <<02.EB>>00984000
END; << NEXTSET >>                                             <<02.EB>>00986000
                                                                        00988000
$PAGE                                                                   00990000
          << >>                                                         00992000
          TRAPSOFF;                                                     00994000
          PINX _ PIX;                                                   00996000
          IF PCBL'(PINX+PCBSYS).PCBSYSF THEN                            00998000
           SUDDENDEATH(310);     <<SYSTEM PROCESS>>                     01000000
          IF (CRITFLAG_SETCRITICAL) THEN                                01002000
           SUDDENDEATH(311);     <<CRITICAL ABORT>>                     01004000
                                                                        01006000
          DBFIXED := FALSE;                                             01008000
          IF INTEGER(PCBL'(PINX+PCB2))<0 THEN  << ABSOLUTE DB >>        01010000
            BEGIN                                                       01012000
              DBFIXED := 1;                                             01014000
              PUSH( DB );   DBVALUE := TOS;                             01016000
              RESETDB(-1);                                              01018000
            END;                                                        01020000
          DBSAVE := EXCHANGEDB( 0 );  << SET DB TO STACK >>             01022000
                                                                        01024000
          <<GET PCBX INFO & STACK BOUND>>                               01026000
          PUSH(Q,DL);                                                   01028000
          T_TOS;                                                        01030000
          PXFIX _ T-STAK(T-2);          <<INDEX TO PXFIX>>              01032000
          TOS _ STAK(PXFIX+PXQINIT);    <<INITIAL Q>>                   01034000
          ASMB(XCH);                                                    01036000
          JMIN _ TOS-TOS+8;             <<QI-Q+8>>                      01038000
          <<GET ERROR MESSAGE INDICES>>                                 01040000
          ERROR _ 0;                                                    01042000
          MOVE ERROR(1) _ ERROR,(5);                                    01044000
          J _ PXFIX+PXERROR+1;         <<INTRINSIC ERROR CST>>          01046000
          STAK(J-1) _ 0;               <<ERROR LEVEL>>                  01048000
          I_-1;                                                         01050000
          WHILE (I_I+1)<6 DO                                            01052000
               BEGIN TOS_STAK(J+I);                                     01054000
                     IF = THEN BEGIN DEL; GOTO PRL END;                 01056000
                     STAK(X)_0;                                         01058000
                     ERROR(I)_TOS;                                      01060000
               END;                                                     01062000
          <<GET PROCESS/PROGRAM INFO>>                                  01064000
  PRL:    INITBUF;                                                      01066000
          TYPE_MODE.RBITE;                                              01068000
          << >>                                                         01070000
          << >>                                                         01072000
          <<TRAP TO USER - TYPE=0,1 >>                                  01074000
          << >>                                                         01076000
          IF TYPE>1 THEN GOTO PRF;                                      01078000
          <<CHECK FOR NO TRAP REQUEST>>                                 01080000
          << GET OFFSET TO APPROPRIATE PLABEL >>               <<03046>>01082000
          IF TYPE = 1 THEN X_PXFIX + PXSPLAB                   <<03046>>01084000
          ELSE IF ARITH'TRAP THEN X_PXFIX + PXAPLAB            <<03046>>01086000
          ELSE X_PXFIX + PXCPLAB;                              <<03046>>01088000
          IF (PLAB_STAK(X))=0 THEN GOTO PRF;                            01090000
          CSTX_PLAB.RBITE;                                              01092000
          IF TYPE=0 THEN                                       <<03046>>01094000
             BEGIN << SET UP PARM TO USER TRAP PROCEDURE >>    <<03046>>01096000
             IF INSTR'TRAP THEN TOS := CODE                    <<03046>>01098000
             ELSE IF ARITH'TRAP THEN                           <<03046>>01100000
                BEGIN                                          <<03046>>01102000
                << IS CODE ONE OF TRAPS SPECIFIED >>           <<03046>>01104000
                << IN ARITH. MASK?                >>           <<03046>>01106000
                IF CODE<6 THEN I_%40&LSR(CODE)                 <<03046>>01108000
                ELSE I_%40&LSL(CODE-8);                        <<03046>>01110000
                TOS _ LOGICAL(I) LAND                          <<03046>>01114000
                      LOGICAL(STAK(PXFIX+PXAMASK));            <<03046>>01116000
                IF = THEN GOTO PRF;                            <<03046>>01118000
                END                                            <<03046>>01120000
             ELSE GOTO PRF;                                    <<03046>>01122000
             END;                                              <<03046>>01124000
          <<MOVE USER STACK MARKER>>                                    01128000
          I_J_0;                                                        01130000
          WHILE (I_I+1)<=INTEGER(MODE.LBITE) DO                         01132000
                     J_J-STACK(J);                                      01134000
          K_STACK(J-1).RBITE;                                           01136000
          TOS_LOGICALCST(K);                                            01138000
          IF < THEN GOTO PRF;                                           01140000
          DDEL;                                                         01142000
          IF SYSTEM(K) THEN GOTO PRF;                                   01144000
          TOS_PLAB;                                            <<B0.06>>01146000
          TOS.(0:1)_1;                                         <<B0.06>>01148000
          IF <> AND STACK(J-1)<0 THEN GOTO PRF;                <<B0.06>>01150000
          PLAB_TOS;                                            <<B0.06>>01152000
          K_TYPE*7+1;                                                   01154000
          I_0;                                                          01156000
          WHILE (I_I+1)<=4 DO                                           01158000
               BEGIN STACK(J+K)_STACK(J);                               01160000
                     J_J-1;                                             01162000
               END;                                                     01164000
          <<INSERT PARAMETERS>>                                         01166000
          IF TYPE=0                                                     01168000
            THEN STACK(J+1)_TOS                                <<B0.01>>01170000
            ELSE BEGIN STACK(J+1)_CODE;                                 01172000
                       STACK(J+2)_PARAM;                                01174000
                       I_2;                                             01176000
                       WHILE (I_I+1)<=K DO                              01178000
                             STACK(J+I)_ERROR(I-3);                     01180000
                 END;                                                   01182000
          <<CHANGE/PICKUP USER S.M. INFO>>                              01184000
          XX:=STACK(-3);                                       <<B0.07>>01186000
          J:=J+K+3;                                            <<B0.07>>01188000
          TOS:=STACK(J);                                       <<B0.07>>01190000
          TOS.CCFLD_CCL;                                                01192000
          DUPLICATE;                                                    01194000
          STACK(X)_TOS;                                                 01196000
          TOS.RSOFLD_0;                                                 01198000
          TOS.RBITE_CSTX;                                               01200000
          STATX_TOS;                                                    01202000
          TOS_STACK(X_X+1)+K;                                           01204000
          STACK(X)_TOS;                                                 01206000
          <<CONVERT PLABEL TO (P-PB) ADDRESS>>                          01208000
          PUSH(STATUS);                                                 01210000
          PHY_TOS.RBITE;                                                01212000
          RESETCRITICAL (CRITFLAG);                            <<00840>>01214000
          PX:=CONVEXTLABELTODELTAP(PLAB);                      <<01549>>01216000
          <<BUILD EXIT STACK MARKER>>                                   01218000
          STACK(X_X+1)_XX;         <<X>>                                01220000
          STACK(X_X+1)_PX;         <<DELTA P>>                          01222000
          STACK(X_X+1)_STATX;      <<STATUS>>                           01224000
          STACK(X_X+1)_4;          <<DELTA Q>>                          01226000
          PUSH( Q );                                                    01228000
          TOS := TOS + X;  << OFFSET TO EXIT MARKER >>                  01230000
          SET(Q);                                                       01232000
          <<****>>                                                      01234000
          ASSEMBLE(EXIT 0);                                             01236000
          <<****>>                                                      01238000
          << >>                                                         01240000
          << >>                                                         01242000
PRF:      CLEAR'PSIF(PINX,%40);                                         01244000
          STAK(PXFIX+PXERROR) _ 1;     <<ERROR LEVEL>>                  01246000
          TOS _ STAK(PXFIX+PXABORTY);<<ABORT Y:INIT CST>>               01248000
          DUPLICATE;                                                    01250000
          TOS.SIGNFLD _ 1;                                              01252000
          STAK(X) _ TOS;                                                01254000
          LIBX_TOS.RBITE;                                               01256000
          PROGFLAG_FALSE;                                               01258000
          PIN _ PINX/PCBSIZE;                                           01260000
          PROCFILE(PIN,NAME);                                           01262000
          IF = THEN BEGIN PROGFLAG_TRUE;                                01264000
                          SCAN NAME UNTIL %6440,1;                      01266000
                          CNT_TOS-@NAME;                                01268000
                          LIBX_0;                                       01270000
                END;                                                    01272000
          <<GET STACK MARKER INFO>>                                     01274000
          << -USER & LIBRARY SEG>>                                      01276000
          I_J_K_0;                                                      01278000
          WHILE (I_I+1)<=INTEGER(MODE.LBITE) DO                         01280000
                     J_J-STACK(J);                                      01282000
         SYSCST _ SYSTEM(STACK(J-1).RBITE);                             01284000
          CSTX_PX_0;                                                    01286000
          LOC(LIBRX)_LOC(PROCX)_0;                                      01288000
  NEXT:   PPP_STACK(J-2).PFLD;                                          01290000
          PHY_STACK(J-1).RBITE;                                         01292000
          LOC(K     )_J;                                                01294000
          LOC(X_X+1 )_PPP;                                              01296000
          TOS _LOGICALCST(PHY);                                         01298000
          LOC(X_X+1 )_TOS;                                              01300000
          DUPLICATE;                                                    01302000
          LOC(X_X+1 )_TOS;                                              01304000
          LTYP_TOS;                                                     01306000
          IF PHY<>CSTX THEN                                             01308000
               BEGIN CSTX_PHY; PX_PPP; END;                             01310000
          IF TYPE > 3 AND SYSTEM(PHY) THEN                              01312000
           GOTO BUMPJ;                                                  01314000
          IF PROGFLAG AND LTYP=PROGN THEN GOTO CONT;                    01316000
          IF PHY=LIBX THEN GOTO CONT;                                   01318000
          K_PROCX;                                                      01320000
  BUMPJ:  T_J-STACK(J);            <<NEXT MARKER>>                      01322000
          IF T>=J OR T<JMIN THEN GOTO OUTM;                             01324000
          J_T;                                                          01326000
          GOTO NEXT;                                                    01328000
  OUTM:   IF K=0 THEN LOC(K+PV)_PX;                                     01330000
          LOC(K_PROCX)_0;                                               01332000
          IF NOT PROGFLAG THEN                                          01334000
               BEGIN TOS_LOGICALCST(LIBX);                              01336000
                     LOC(X_X+2)_TOS;                                    01338000
                     LOC(X_X+1)_TOS;                                    01340000
               END;                                                     01342000
          GOTO TERM;                                                    01344000
          HELP;                                                         01346000
  CONT:   IF K<>0 THEN GOTO TERM;  <<FOUND ABORTED SEG>>                01348000
          MOVE LOC(PROCX)_LOC(LIBRX),(PROCX);  <<USER SEG>>             01350000
          LOC(LIBRX)_0;                                                 01352000
TERM:                                                          <<C0.00>>01354000
                                                               <<02.EB>>01356000
<<  BUILD & PRINT ABORT MESSAGE >>                             <<02.EB>>01358000
                                                               <<02.EB>>01360000
MOVE BMSG := "ABORT ";                                         <<02.EB>>01362000
BP := 6;                                                       <<02.EB>>01364000
IF PROGFLAG THEN PROCLOC ELSE PRCRLOC;                         <<02.EB>>01366000
LIBRLOC;                                                       <<02.EB>>01368000
BMSG(BP) := 0;                                                 <<02.EB>>01370000
PRINT(MSG,0,0);                                                <<02.EB>>01372000
GENMSG(-1,@BMSG); << PRINT ABORT: ED.MPE.%0.%0 >>              <<02.EB>>01374000
IF TYPE = 3 THEN KILLPROG;                                     <<02.EB>>01376000
PARAM' := PARAM;                                               <<02.EB>>01378000
INTRINDEX := IF TYPE = 1 THEN 0 ELSE 6;                        <<02.EB>>01380000
TABLENO := IF TYPE = 1 THEN INTRINSET ELSE PGMERRSET;          <<02.EB>>01382000
MSGNO := IF TYPE = 0 THEN CODE ELSE IF TYPE = 1 THEN CODE.     <<02.EB>>01384000
   (0:10) ELSE TYPE +16;                                       <<02.EB>>01386000
IF TYPE=1 THEN  <<INTRINSIC ERROR>>                            <<U.RAO>>01388000
   SETJCW(%140000 LOR LOGICAL(MSGNO+1000))<<LOR INTRINSIC NO.>><<U.RAO>>01390000
ELSE IF TYPE = 0 THEN  <<INTERNAL INT. ERROR>>                 <<U.RAO>>01392000
   SETJCW(%140000 LOR LOGICAL(MSGNO))   <<MASK LOR ERROR NO.>> <<U.RAO>>01394000
ELSE IF TYPE = 5 THEN   <<PROGRAM KILLED, NO NUMBER>>          <<U.RAO>>01396000
   SETJCW(%140000)                                             <<U.RAO>>01398000
ELSE   <<TYPE IS QUIT OR QUITPROG>>                            <<U.RAO>>01400000
   SETJCW(%100000 LOR PARAM);  <<MASK LOR USER PARAM>>         <<U.RAO>>01402000
DO BEGIN                                                       <<02.EB>>01404000
   GENMSG(MISCSET,TABLENO,%10000,MSGNO,,,,,,,,,%100000);       <<02.EB>>01406000
   GENMSG(TABLENO,MSGNO,,,,,,,,,,,IF PARAM' <> 0 THEN          <<02.EB>>01408000
      %100000 ELSE 0);                                         <<02.EB>>01410000
   IF PARAM' <> 0 THEN GENMSG(MISCSET,PARAMSG,%10000,          <<02.EB>>01412000
      PARAM'); << PRINT PARAM = >>                             <<02.EB>>01414000
   TABLENO := NEXTSET(TABLENO,MSGNO);                          <<02.EB>>01416000
   PARAM' := ERROR(INTRINDEX).(0:8); << INTRIN PARAM >>        <<02.EB>>01418000
   MSGNO :=  ERROR(INTRINDEX).(8:8); << NEXT MSGNO >>          <<02.EB>>01420000
   IF MSGNO < 20 THEN TABLENO := RUNTIMESET;                   <<02.EB>>01422000
   INTRINDEX := INTRINDEX +1;                                  <<02.EB>>01424000
END UNTIL (ERROR(INTRINDEX -1) = 0 OR INTRINDEX > 5);          <<02.EB>>01426000
RESETCRITICAL(0);                                              <<02.EB>>01428000
                                                               <<02.EB>>01430000
<<  ABORT STACK DUMP MECHANISM>>                               <<C0.00>>01432000
                                                               <<C0.00>>01434000
PUSH(Q,DL);ASSEMBLE(XCH,SUB;DUP,STAX);                         <<C0.00>>01436000
TOS:=PCBX(X-2);X:=TOS-TOS+12;                                  <<C0.00>>01438000
TOS:=PCBX(X).(6:2);           <<TWO FLAGS>>                    <<C0.00>>01440000
INX:=X;                                                        <<C0.00>>01442000
QIN:=PCBX(X-9);              <<QIN VALUE>>                     <<C0.00>>01444000
RWF:=NOT TOS;                <<READ WRITE FLAG ON PROG FILE>>  <<C0.00>>01446000
                                                               <<C0.00>>01448000
<<FIND OUT IF TO GO THERE>>                                    <<C0.00>>01450000
PUSH(Q,DL);ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                    <<C0.00>>01452000
STDF:=PCBX(TOS-PCBX(X)+5).(0:6);       <<SETDUMP FLAGS>>       <<C0.00>>01454000
JOBTYPE:=PCBX(X+1).(5:1);              <<INTRACTIVE>>          <<C0.00>>01456000
                                                               <<C0.00>>01458000
IF (TYPE<=4) LAND STDF.(10:1) LAND NOT SYSCST THEN             <<00.05>>01460000
BEGIN                        <<ARMED>>                         <<C0.00>>01462000
<<OUTPUT HEADER=TITLE,REGISTERS,MARKERS>>                      <<C0.00>>01464000
INITBUF;                                                       <<C0.00>>01466000
MOVE BMSG:="*** ABORT STACK ANALYSIS ***";                     <<C0.00>>01468000
PRINT(MSG,-28,0); INITBUF;                                     <<C0.00>>01470000
PRINT(MSG,0,%201);                                             <<C0.00>>01472000
                                                               <<C0.00>>01474000
PUSH(Q); I:=0;  J:=MODE.(0:8);                                 <<C0.00>>01476000
WHILE (I:=I+1)<=J DO                                           <<C0.00>>01478000
BEGIN              <<GET USER MARKER>>                         <<C0.00>>01480000
ASSEMBLE(DUP);                                                 <<C0.00>>01482000
TOS:=TOS-STAK(TOS);                                            <<C0.00>>01484000
END;                                                           <<C0.00>>01486000
                                                               <<C0.00>>01488000
TRIPLICATE;                                                             01490000
REGIST(*,BMSG); PRINT(MSG,-34,0); INITBUF;                     <<C0.00>>01492000
MARKER(*,BMSG);PRINT(MSG,-62,0);INITBUF;                       <<C0.00>>01494000
                                                               <<C0.00>>01496000
<<PRINT MARKER TRACE>>                                         <<C0.00>>01498000
DUPLICATE;                                                              01500000
I:=TOS;                                                        <<C0.00>>01502000
WHILE (I:=I-STAK(I))>QIN DO                                    <<C0.00>>01504000
BEGIN                                                          <<C0.00>>01506000
MARKER(I,BMSG);                                                <<C0.00>>01508000
IF < OR STAK(X)<4 THEN                                         <<C0.00>>01510000
  BEGIN INITBUF;MOVE BMSG:="INVALID MARKER";I:=-1;END;         <<C0.00>>01512000
PRINT(MSG,-62,0);INITBUF;                                      <<C0.00>>01514000
END;                                                           <<C0.00>>01516000
BASE:=TOS;BASES:=BASE-4;                                       <<C0.00>>01518000
                                                               <<C0.00>>01520000
<<LEGITIMATE REQUEST ?>>                                       <<C0.00>>01522000
                                                               <<C0.00>>01524000
TOS:=LOGICALCST(STAK(BASE-1).(8:8));                           <<C0.00>>01526000
ASSEMBLE(DEL);                                                 <<C0.00>>01528000
IF TOS=0 THEN GO OUT;        <<SYSTEM SL>>                     <<C0.00>>01530000
                                                               <<C0.00>>01532000
IF RWF LAND JOBTYPE THEN                                       <<C0.00>>01534000
BEGIN                        <<OK LET'S GO>>                   <<C0.00>>01536000
PUSH(Q,DL); T _ TOS; PXFIX _ T-STAK(T-2);                               01538000
STAK(PXFIX+PXERROR) _ 0;      <<TURN OFF ERROR BIT>>                    01540000
DBGCST:=(@DEBUG).(8:8);                                        <<C0.00>>01542000
          DBGDP:=CONVEXTLABELTODELTAP(@DEBUG);                 <<01549>>01544000
TOS:=BASE; PUSH(Q);  X := TOS-TOS;                             <<C0.00>>01546000
                                                                        01548000
EXCHANGEDB(DBSAVE);   << RESTORE ENVIRONMENT >>                         01550000
IF DBFIXED THEN                                                         01552000
  BEGIN                                                                 01554000
    SETSYSDB;                                                           01556000
    TOS := DBVALUE;                                                     01558000
    SET( DB );                                                          01560000
  END;                                                                  01562000
                                                                        01564000
STACK(X+1):=0;     <<X>>                                       <<C0.00>>01566000
STACK(X+1):=DBGDP;           <<DELTA P>>                       <<C0.00>>01568000
STACK(X+1):=%140000+DBGCST;                                    <<C0.00>>01570000
STACK(X+1):=4;     <<DELTA Q>>                                 <<C0.00>>01572000
                                                                        01574000
DISABLE;                                                                01576000
PUSH( Q );                                                              01578000
TOS := TOS + X;   << OFFSET TO EXIT MARKER >>                           01580000
SET( Q );                                                               01582000
ASSEMBLE( EXIT 0 );                                                     01584000
END;                                                                    01586000
                                                                        01588000
IF NOT RWF THEN GO OUT;                                        <<C0.00>>01590000
IF STDF.(13:3)=0 THEN GO OUT;      <<NOTHING TO DUMP>>         <<C0.00>>01592000
PCBX(INX).(0:4):=MODE&LSR(8)+1;                                <<C0.00>>01594000
<<PREPARE PARAMETERS FOR STACKDUMP>>                           <<C0.00>>01596000
J:=2;                                                          <<C0.00>>01598000
TOS:=-1; TOS:=0;             <<STOPPER>>                       <<C0.00>>01600000
IF STDF.(13:2)<>0 THEN                                         <<C0.00>>01602000
BEGIN                                                          <<C0.00>>01604000
J:=J+2;                                                        <<C0.00>>01606000
IF STDF.(14:1) THEN                                            <<C0.00>>01608000
BEGIN              <<QIN TO S>>                                <<C0.00>>01610000
TOS:=BASES-QIN+1;                                              <<C0.00>>01612000
TOS:=QIN;          <<ADDRESS>>                                 <<C0.00>>01614000
END ELSE                                                       <<C0.00>>01616000
BEGIN              <<Q-63 TO S>>                               <<C0.00>>01618000
TOS:=STAK(BASE-STAK(BASE)); ASSEMBLE(DUP);                     <<C0.00>>01620000
IF TOS>63 THEN                                                 <<C0.00>>01622000
BEGIN                                                          <<C0.00>>01624000
ASSEMBLE(DEL);                                                 <<C0.00>>01626000
TOS:=63; TOS:=BASES-X; ASSEMBLE(ADD);                          <<C0.00>>01628000
TOS:=X-63;                                                     <<C0.00>>01630000
END ELSE                                                       <<C0.00>>01632000
BEGIN                                                          <<C0.00>>01634000
TOS:=BASES-X; ASSEMBLE(ADD);                                   <<C0.00>>01636000
TOS:=X-STAK(X);                                                <<C0.00>>01638000
END;                                                           <<C0.00>>01640000
END;                                                           <<C0.00>>01642000
END;                                                           <<C0.00>>01644000
                                                               <<C0.00>>01646000
IF STDF THEN                                                   <<C0.00>>01648000
BEGIN              <<DL TO QIN>>                               <<C0.00>>01650000
J:=J+2;                                                        <<C0.00>>01652000
PUSH(DL); ASSEMBLE(DUP);                                       <<C0.00>>01654000
TOS:=TOS-QIN;                                                  <<C0.00>>01656000
ASSEMBLE(NEG,XCH);                                             <<C0.00>>01658000
END;                                                           <<C0.00>>01660000
                                                               <<C0.00>>01662000
I:=-1;                                                         <<C0.00>>01664000
WHILE (I:=I+1)<=J DO WDUMP(I):=TOS;                            <<C0.00>>01666000
TOS := STDF&LSR(3);   <<SET UP FLAGS FOR STACKDUMP>>           <<04712>>01668000
ASSEMBLE(TCBC 15);    <<REVERSE ASCII DUMP BIT>>               <<04712>>01670000
STDF := TOS;                                                   <<04712>>01672000
STACKDUMP(,,STDF,DUMP(0));                                     <<C0.00>>01674000
                                                               <<C0.00>>01676000
END;                                                           <<C0.00>>01678000
                                                               <<C0.00>>01680000
OUT:                                                           <<C0.00>>01682000
          TERMINATE;                                                    01684000
          << >>                                                         01686000
    END;                                                                01688000
$PAGE                                                                   01690000
            << >>                                                       01692000
<<********************************************************>>            01694000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            01696000
<<********************************************************>>            01698000
            <<USER PROCESS ABORT . (TYPE=2)                             01700000
               NUM = QUIT IDENTIFICATION FOR USER          >>           01702000
<<********************************************************>>            01704000
            << >>                                                       01706000
PROCEDURE QUIT(NUM);                                                    01708000
  VALUE   NUM;                                                          01710000
  INTEGER NUM;                                                          01712000
  OPTION  PRIVILEGED;                                                   01714000
  BEGIN                                                                 01716000
          EQUATE TYPE=2, MARK=1, MODE=[8/MARK,8/TYPE];                  01718000
          << >>                                                         01720000
          ABORT(MODE,0,NUM);                                            01722000
  END;                                                                  01724000
$PAGE                                                                   01726000
            << >>                                                       01728000
<<********************************************************>>            01730000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            01732000
<<********************************************************>>            01734000
            <<USER PROGRAM ABORT . (TYPE=3)                             01736000
               NUM = QUITPROG IDENTIFICATION FOR USER       >>          01738000
<<********************************************************>>            01740000
            << >>                                                       01742000
PROCEDURE QUITPROG(NUM);                                                01744000
  VALUE   NUM;                                                          01746000
  INTEGER NUM;                                                          01748000
  OPTION  PRIVILEGED;                                                   01750000
  BEGIN                                                                 01752000
          EQUATE TYPE=3, MARK=1, MODE=[8/MARK,8/TYPE];                  01754000
          << >>                                                         01756000
          ABORT(MODE,0,NUM);                                            01758000
  END;                                                                  01760000
$PAGE                                                                   01762000
                                                                        01764000
<<********************************************************>>            01766000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            01768000
<<********************************************************>>            01770000
          <<ENABLE/DISABLE HARDWARE ARITHMETIC TRAP INTERNAL            01772000
               INTERRUPT.                                               01774000
                                                                        01776000
               STATE = TRUE  ENABLE TRAPS                               01778000
                     = FALSE DISABLE TRAPS                              01780000
                                                                        01782000
               CODE: CC=0 OK. DISABLED ORIGINALLY                       01784000
                     CC>0 OK. ENABLED ORIGINALLY                        01786000
                     CC<0 (NULL)                           >>           01788000
<<********************************************************>>            01790000
            << >>                                                       01792000
PROCEDURE ARITRAP(STATE);                                               01794000
  VALUE   STATE;                                                        01796000
  LOGICAL STATE;                                                        01798000
  OPTION  PRIVILEGED;                                                   01800000
  BEGIN                                                                 01802000
          EQUATE ERRN=51,EXITN=1;                                       01804000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               01806000
          << >>                                                         01808000
          ERRORON;                                                      01810000
          TOS _ STATUS; DUPLICATE;                                      01812000
          TOS.CCFLD _ TOS.TRAPFLD&LSL(1)+CCE;                           01814000
          TOS.TRAPFLD _ STATE;                                          01816000
          TOS.(4:1) _ 0;               <<OVERFLOW BIT>>                 01818000
          STATUS _ TOS;                                                 01820000
          ERROREXIT(ERREX,0,0);                                         01822000
  END;                                                                  01824000
$PAGE                                                          <<03046>>01826000
LOGICAL PROCEDURE CHECKTRAPLABEL(PLABEL,USERSTACKMARKER);      <<03046>>01828000
VALUE PLABEL,USERSTACKMARKER;                                           01830000
                                                                        01832000
<<FUNCTION                                                              01834000
  CHECKS THAT THE USER'S LABEL MEETS ALL THE RULES FOR PLABELS.         01836000
  INTERRUPT PROCEDURE RULES.                                            01838000
                                                                        01840000
  CALLER'S CODE DOMAIN     INTERRUPT PROCEDURE REQUIREMENTS             01842000
  --------------------     --------------------------------             01844000
  NONPRIV PROGRAM SEG      NONPRIV; PROG, GROUP SL, ACCT SL             01846000
                                                                        01848000
  PRIV; PROG, GROUP SL     PRIV OR NONPRIV; PROG, GROUP SL,             01850000
  ACCT SL                  ACCT SL                                      01852000
                                                                        01854000
  PRIV OR NONPRIV,         PRIV OR NONPRIV; IN ANY NON-MPE              01856000
  NON-MPE SYSTEM SL        SYSTEM SL>>                                  01858000
                                                                        01860000
<<INPUT>>                                                               01862000
  INTEGER                                                               01864000
    PLABEL,              <<USER TRAP PROCEDURE'S PLABEL>>               01866000
    USERSTACKMARKER;     <<# WORDS FROM CALLER'S STACK MARKER TO        01868000
                           THE USER'S STACK MARKER.  THIS STACK         01870000
                           MARKER IS USED TO DETERMINE THE              01872000
                           PERMISSIBLE RANGE OF THE PLABEL.>>           01874000
                                                                        01876000
<<OUTPUT                                                                01878000
    CHECKTRAPLABEL         THE FINISHED FORM OF THE PLABEL.             01880000
                           (0:1)  EXECUTION CONTEXT.                    01882000
                                  0 - PROCEDURE MAY EXECUTE IN          01884000
                                      PRIVILEGED MODE.                  01886000
                                  1 - PROCEDURE MAY ONLY EXECUTE        01888000
                                      IN USER MODE.                     01890000
                           (1:15) PLABEL.                               01892000
    CONDITIONCODE          CCE - VALID PLABEL                           01894000
                           CCL - ILLEGAL PLABEL                         01896000
                           CCG - NOT RETURNED.>>                        01898000
                                                                        01900000
OPTION PRIVILEGED,UNCALLABLE;                                           01902000
                                                                        01904000
BEGIN                                                                   01906000
LOGICAL                                                                 01908000
  STATUS=Q-1;                                                           01910000
DEFINE                                                                  01912000
  RETURNCONDCODE     = STATUS.(6:2)#;                                   01914000
EQUATE                                                                  01916000
  SYSTEMSL           = 0,                                               01918000
  PROGRAMSEG         = 3,                                               01920000
  CCE                = 2,                                               01922000
  CCL                = 1;                                               01924000
INTEGER ARRAY                                                           01926000
  STACKMARKER(*)=Q+0;                                                   01928000
INTEGER                                                                 01930000
  CALLERSTATUS,CALLERTYPE,PROCEDURETYPE,CALLERCSTN,PROCEDURECSTN,       01932000
  PCBPT,PIN,TRAPLOGICALCST,SEGID;                                       01934000
                                                                        01936000
                                                                        01938000
SUBROUTINE CHECKEXIT(CONDITIONCODE);                                    01940000
VALUE CONDITIONCODE;                                                    01942000
INTEGER CONDITIONCODE;                                                  01944000
  BEGIN                                                                 01946000
  RETURNCONDCODE:=CONDITIONCODE;                                        01948000
  ASSEMBLE(EXIT 2);                                                     01950000
  END;  <<CHECKEXIT>>                                                   01952000
LOGICAL SUBROUTINE SYSTEM(CSTNUM);                                      01954000
VALUE CSTNUM;                                                           01956000
INTEGER CSTNUM;                                                         01958000
  BEGIN  <<RETURNS TRUE IF SEGMENT IS AN MPE SYSTEM LIB SEGMENT>>       01960000
  SEGID:=BUILDSEGID(IF CSTNUM > %300 THEN 2 ELSE 1,CSTNUM,PIN);         01962000
  SYSTEM:=DSTL'(CONVSEGIDTOSTINX(SEGID)).SYSTEMFLAG;                    01964000
  END;  <<SYSTEM>>                                                      01966000
<<INITIALIZATION>>                                                      01968000
PIN:=(PCBPT:=(ABS(CPCB)-ABS(PCBB)))/PCBSIZE;                            01970000
CALLERSTATUS:=STACKMARKER(-STACKMARKER-USERSTACKMARKER-1);              01972000
TOS:=LOGICALCST(CALLERCSTN:=CALLERSTATUS.(8:8)); <<SEG TYPE>>           01974000
DEL; CALLERTYPE:=TOS;                                                   01976000
TOS:=LOGICALCST(PROCEDURECSTN:=PLABEL.(8:8)); <<NEW SEG TYPE>>          01978000
IF < THEN CHECKEXIT(CCL);                                               01980000
TRAPLOGICALCST:=TOS;                                                    01982000
PROCEDURETYPE:=TOS;                                                     01984000
                                                                        01986000
<<CHECK LABEL VALIDITY>>                                                01988000
IF CALLERTYPE = PROGRAMSEG THEN                                         01990000
   BEGIN  <<PROGRAM>>                                                   01992000
   PHYSICALCST(PIN,TRAPLOGICALCST);                                     01994000
   IF <> THEN CHECKEXIT(CCL);                                           01996000
   END                                                                  01998000
ELSE IF CALLERTYPE = SYSTEMSL THEN                                      02000000
   BEGIN  <<SYSTEM SL>>                                                 02002000
   IF NOT SYSTEM(CALLERCSTN) AND SYSTEM(PROCEDURECSTN) THEN             02004000
      CHECKEXIT(CCL);                                                   02006000
   PLABEL.(0:1):=0;                                                     02008000
   END                                                                  02010000
ELSE                                                                    02012000
   BEGIN  <<USER-PROG, GSL, PSL>>                                       02014000
   IF PROCEDURETYPE = SYSTEMSL THEN CHECKEXIT(CCL);                     02016000
   IF CALLERSTATUS < 0 THEN                                             02018000
      PLABEL.(0:1):=0  <<CALLER PRIV, MAKE TRAP PROCEDURE PRIV>>        02020000
   ELSE                                                                 02022000
      BEGIN  <<CALLER IS NONPRIV, THEREFORE TRAP PROC MUST BE NONPRIV>> 02024000
      SEGID:=BUILDSEGID(IF PROCEDURECSTN > %300 THEN 2                  02026000
      ELSE 1,PROCEDURECSTN,PIN);                                        02028000
      IF LOG(DSTL'(CONVSEGIDTOSTINX(SEGID)).(1:1)) THEN                 02030000
        CHECKEXIT(CCL);  <<MODE ERROR>>                                 02032000
      PLABEL.(0:1):=1;                                                  02034000
      END;                                                              02036000
   END;                                                                 02038000
                                                                        02040000
CHECKTRAPLABEL:=PLABEL;                                                 02042000
CHECKEXIT(CCE);                                                         02044000
END;  <<CHECKTRAPLABEL>>                                                02046000
$PAGE                                                          <<03046>>02048000
            << >>                                                       02050000
            <<SET-UP TRAP MECHANISM IN PCBX (P-LABEL & MASK IF          02052000
               ARITHMETIC). RETURN THE ORIGINAL VALUES.                 02054000
               TEST THE VALIDITY OF P-LABEL                             02056000
                     PLAB < 0 - ARM                                     02058000
                          = 0 - DISARM                                  02060000
                          > 0 -ARM(OLD NON PRIV VALUE)         <<B0.06  02062000
               CODE: CC=0 OK. ARMED                                     02064000
                     CC>0 OK. DISARMED                                  02066000
                     CC<0 NO. ILLEGAL PLAB                 >>           02068000
            << >>                                                       02070000
                                                               <<03046>>02072000
<<NOTE - THE PLABEL CHECKING AND CONVERSION DONE BY THIS         HM.XX  02074000
         PROCEDURE IS THE SAME AS CHECKTRAPLABEL.  WOULD         HM.XX  02076000
         HAVE REPLACED IT WITH A CALL TO CHECKTRAPLABEL          HM.XX  02078000
         EXCEPT IT IS DORMANT AND HARD TO CHANGE.>>            <<03046>>02080000
LOGICAL PROCEDURE TRAPLABEL(N,MASK,PLAB,XMASK,XPLAB);                   02082000
  VALUE   N,MASK,PLAB;                                                  02084000
  INTEGER N,MASK,PLAB,XMASK,XPLAB;                                      02086000
  OPTION  PRIVILEGED,UNCALLABLE;                               <<01070>>02088000
  BEGIN                                                                 02090000
          EQUATE     PXAPLAB  = 15,   <<ARITH TRAP>>           <<01070>>02092000
                     DEBUGLAB = 19;   <<DEBUG TRAP>>           <<01070>>02094000
          INTEGER ARRAY STAK(*)=Q+0;                           <<B0.06>>02096000
          INTEGER POINTER P;                                            02098000
          INTEGER STAT,TYPE,TYPEL,SCSTN,PCSTN;                          02100000
          INTEGER PIN,LCST;                                    <<C0.00>>02102000
          INTEGER SEGID;                                       <<01632>>02104000
          LOGICAL CCERR_CCE;                                            02106000
          << >>                                                         02108000
          STAT_STAK(-STAK(0)-1);       <<CALL STATUS>>         <<B0.06>>02110000
              IF N=PXAPLAB AND MASK=0 OR PLAB=0  THEN       <<01.02>>   02112000
               BEGIN CCERR_CCG;                                         02114000
                     MASK_0;                                            02116000
                     GOTO CONT;                                         02118000
               END;                                                     02120000
          TOS _ LOGICALCST(SCSTN_STAT.RBITE); <<CALL SEG TYPE>>         02122000
          DEL;                                                 <<B0.06>>02124000
          TYPE_TOS;                                            <<B0.06>>02126000
          TOS _ LOGICALCST(PCSTN_PLAB.RBITE); <<NEW SEG TYPE>>          02128000
          IF < THEN                                            <<B0.06>>02130000
           BEGIN                       <<INVALID LABEL>>       <<B0.06>>02132000
  ERR:      CCERR_CCL;                                         <<B0.06>>02134000
            GOTO FIN;                                          <<B0.06>>02136000
           END;                                                <<B0.06>>02138000
          LCST_TOS;                                            <<C0.00>>02140000
          TYPEL_TOS;                                           <<B0.06>>02142000
          IF TYPE=3 THEN                                       <<C0.00>>02144000
           BEGIN  <<PROGRAM>>                                  <<C0.00>>02146000
            PIN _ PIX/PCBSIZE;                                          02148000
            PHYSICALCST(PIN,LCST);                             <<C0.00>>02150000
            IF <> THEN GOTO ERR;                               <<C0.00>>02152000
           END;                                                <<C0.00>>02154000
          IF TYPE=0 THEN                                       <<B0.06>>02156000
           BEGIN                       <<SYSTEM SL>>           <<B0.06>>02158000
            IF SYSTEM(SCSTN) THEN GOTO SIGN;                            02160000
            IF SYSTEM(PCSTN) THEN GOTO ERR;                             02162000
  SIGN:     TOS_PLAB;                                          <<B0.06>>02164000
            ASSEMBLE(TCBC 0);                                  <<B0.06>>02166000
            PLAB_TOS;                                          <<B0.06>>02168000
           END ELSE                                            <<B0.06>>02170000
           BEGIN                       <<USER-PROG,GSL,PSL>>   <<B0.06>>02172000
            IF TYPEL=0 THEN GOTO ERR;                          <<B0.06>>02174000
            IF STAT<0 THEN GOTO SIGN;  <<PRIV CALL>>           <<B0.06>>02176000
             SEGID:=BUILDSEGID(IF PCSTN > %300 THEN 2          <<01632>>02178000
             ELSE 1,PCSTN,PIX/PCBSIZE);                        <<01632>>02180000
             IF DSTL'(CONVSEGIDTOSTINX(SEGID)).(1:1) THEN      <<01632>>02182000
             GOTO ERR;         <<MODE ERROR>>                           02184000
            PLAB.(0:1)_1;                                      <<B0.06>>02186000
           END;                                                <<B0.06>>02188000
          IF N=DEBUGLAB THEN                                   <<01070>>02190000
           BEGIN                                               <<01070>>02192000
            << RETURN MODIFIED LABEL IN XPLAB >>               <<01070>>02194000
            XPLAB := PLAB;                                     <<01070>>02196000
            GOTO FIN;                                          <<01070>>02198000
           END;                                                <<01070>>02200000
  CONT:   PUSH(DL);                                                     02202000
          @P_TOS;                                                       02204000
          @P_@P-P(-2)+N;                                                02206000
          TOS_P;                                               <<B0.06>>02208000
          IF <> THEN IF STAT>=0                                <<B0.06>>02210000
           THEN TOS.(0:1)_1                                    <<B0.06>>02212000
           ELSE ASSEMBLE(TCBC 0);                              <<B0.06>>02214000
          XPLAB_TOS;                                           <<B0.06>>02216000
          XMASK_P(-1);                                                  02218000
          P_PLAB;                                                       02220000
          IF N=PXAPLAB THEN P(-1)_MASK;                                 02222000
  FIN:    TRAPLABEL_CCERR;                                              02224000
  END;                                                                  02226000
$PAGE                                                                   02228000
            << >>                                                       02230000
<<********************************************************>>            02232000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            02234000
<<********************************************************>>            02236000
            <<ARM/DISARM ARITHMETIC TRAP MECHANISM WITH SELECTIVE       02238000
               MASK AND EXTERNAL LABEL. RETURNS THE ORIGINAL            02240000
               MASK AND EXTERNAL LABEL.                                 02242000
                                                                        02244000
               MASK  = BIT MASK FOR ARM(=1)/DISARM(=0)                  02246000
                             BIT 15 - FLT PT DIVIDE BY 0                02248000
                             BIT 14 - INTEGER DIVIDE BY 0               02250000
                             BIT 13 - FLT PT UNDERFLOW                  02252000
                             BIT 12 - INTEGER UNDERFLOW                 02254000
                             BIT 11 - INTEGER OVERFLOW                  02256000
                             BIT 10 - DBL. PREC. OVERFLOW      <<B0.01  02258000
                             BIT  9 - DBL. PREC. UNDERFLOW     <<B0.01  02260000
                             BIT  8 - DBL. PREC. DIV. BY ZERO  <<B0.01  02262000
                             BIT  7 - DECIMAL OVERFLOW         <<B0.07  02264000
                             BIT  6 - INVALID ASCII DIGIT      <<B0.07  02266000
                             BIT  5 - INVALID SOURCE WORD COUNT<<B0.07  02268000
                             BIT  4 - INVALID DECIMAL DIGIT    <<B0.07  02270000
                             BIT  3 - INVALID DECIMAL OPERAND  <<B0.07  02272000
                                      LENGTH                   <<B0.07  02274000
                             BIT  2 - DECIMAL DIV ZERO         <<B0.07  02276000
               PLAB  <> 0 EXTERNAL LABEL                                02278000
                     =  0 DISARM MECHANISM                              02280000
                                                                        02282000
               CODE: CC=0 OK. ARMED                                     02284000
                     CC>0 OK. DISARMED                                  02286000
                     CC<0 NO. ILLEGAL PLAB                 >>           02288000
<<********************************************************>>            02290000
            << >>                                                       02292000
PROCEDURE XARITRAP(MASK,PLAB,XMASK,XPLAB);                              02294000
  VALUE   MASK,PLAB;                                                    02296000
  INTEGER MASK,PLAB,XMASK,XPLAB;                                        02298000
  OPTION  PRIVILEGED;                                                   02300000
  BEGIN                                                                 02302000
          EQUATE ERRN=50,EXITN=4;                                       02304000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               02306000
          EQUATE PXAPLAB=15;                                            02308000
          << >>                                                         02310000
          ERRORON;                                                      02312000
          CHEK(ERREX,%4,%240D);                                         02314000
          STATUS.CCFLD_TRAPLABEL(PXAPLAB,MASK,PLAB,XMASK,XPLAB);        02316000
          ERROREXIT(ERREX,0,0);                                         02318000
  END;                                                                  02320000
$PAGE                                                                   02322000
            << >>                                                       02324000
<<********************************************************>>            02326000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            02328000
<<********************************************************>>            02330000
            <<ARM/DISARM LIBRARY TRAP MECHANISM WITH EXTERNAL           02332000
               LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.              02334000
                                                                        02336000
               PLAB  <> 0 EXTERNAL LABEL                                02338000
                     =  0 DISARM MECHANISM                              02340000
                                                                        02342000
               CODE: CC=0 OK. ARMED                                     02344000
                     CC>0 OK. DISARMED                                  02346000
                     CC<0 NO. ILLEGAL PLAB                 >>           02348000
<<********************************************************>>            02350000
            << >>                                                       02352000
PROCEDURE XLIBTRAP(PLAB,XPLAB);                                         02354000
  VALUE   PLAB;                                                         02356000
  INTEGER PLAB,XPLAB;                                                   02358000
  OPTION  PRIVILEGED;                                                   02360000
  BEGIN                                                                 02362000
          EQUATE ERRN=52,EXITN=2;                                       02364000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               02366000
          EQUATE PXLPLAB=16;                                            02368000
          INTEGER DUM;                                                  02370000
          << >>                                                         02372000
          ERRORON;                                                      02374000
          CHEK(ERREX,%2,%10D);                                          02376000
          STATUS.CCFLD_TRAPLABEL(PXLPLAB,0,PLAB,DUM,XPLAB);             02378000
          ERROREXIT(ERREX,0,0);                                         02380000
  END;                                                                  02382000
$PAGE                                                                   02384000
            << >>                                                       02386000
<<********************************************************>>            02388000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            02390000
<<********************************************************>>            02392000
            <<ARM/DISARM SYSTEM TRAP MECHANISM WITH EXTERNAL            02394000
               LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.              02396000
                                                                        02398000
               PLAB  <> 0 EXTERNAL LABEL                                02400000
                     =  0 DISARM MECHANISM                              02402000
                                                                        02404000
               CODE: CC=0 OK. ARMED                                     02406000
                     CC>0 OK. DISARMED                                  02408000
                     CC<0 NO. ILLEGAL PLAB                 >>           02410000
<<********************************************************>>            02412000
            << >>                                                       02414000
PROCEDURE XSYSTRAP(PLAB,XPLAB);                                         02416000
  VALUE   PLAB;                                                         02418000
  INTEGER PLAB,XPLAB;                                                   02420000
  OPTION  PRIVILEGED;                                                   02422000
  BEGIN                                                                 02424000
          EQUATE ERRN=53,EXITN=2;                                       02426000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               02428000
          EQUATE PXSPLAB=17;                                            02430000
          INTEGER DUM;                                                  02432000
          << >>                                                         02434000
          ERRORON;                                                      02436000
          CHEK(ERREX,%2,%10D);                                          02438000
          STATUS.CCFLD_TRAPLABEL(PXSPLAB,0,PLAB,DUM,XPLAB);             02440000
          ERROREXIT(ERREX,0,0);                                         02442000
  END;                                                                  02444000
            << >>                                              <<03046>>02446000
<<********************************************************>>   <<03046>>02448000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>   <<03046>>02450000
<<********************************************************>>   <<03046>>02452000
<<          ARM/DISARM CODE TRAP MECHANISM WITH EXTERNAL  >>   <<03046>>02454000
<<          LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.   >>   <<03046>>02456000
<<          THE TRAPS HANDLED BY THIS MECHANISM ARE:      >>   <<03046>>02458000
<<             PRIVILEGED MODE INSTR.                     >>   <<03046>>02460000
<<             UNIMPLEMEMTED INSTR.                       >>   <<03046>>02462000
<<             STT UNCALLABLE                             >>   <<03046>>02464000
<<             BAD STACK MARKER                           >>   <<03046>>02466000
<<             ILLEGAL ADDRESS                            >>   <<03046>>02468000
<<             BOUNDS VIOLATION                           >>   <<03046>>02470000
<<             NON-RESPONDING MODULE                      >>   <<03046>>02472000
<<             STACK UNDERFLOW                            >>   <<03046>>02474000
<<             CST VIOLATION                              >>   <<03046>>02476000
<<             STT VIOLATION                              >>   <<03046>>02478000
<<                                                        >>   <<03046>>02480000
<<             PLAB  <> 0 EXTERNAL LABEL                  >>   <<03046>>02482000
<<                   =  0 DISARM MECHANISM                >>   <<03046>>02484000
<<                                                        >>   <<03046>>02486000
<<             CODE: CC=0 OK. ARMED                       >>   <<03046>>02488000
<<                   CC>0 OK. DISARMED                    >>   <<03046>>02490000
<<                   CC<0 NO. ILLEGAL PLAB                >>   <<03046>>02492000
<<********************************************************>>   <<03046>>02494000
            << >>                                              <<03046>>02496000
PROCEDURE XCODETRAP(PLAB,XPLAB);                               <<03046>>02498000
  VALUE   PLAB;                                                <<03046>>02500000
  INTEGER PLAB,XPLAB;                                          <<03046>>02502000
  OPTION  PRIVILEGED;                                          <<03046>>02504000
  BEGIN                                                        <<03046>>02506000
          EQUATE ERRN=57,EXITN=2;                              <<03046>>02508000
          EQUATE ERREX=[10/ERRN,6/EXITN];                      <<03046>>02510000
          EQUATE PXCPLAB=%77;                                  <<03046>>02512000
          INTEGER DUM;                                         <<03046>>02514000
          << >>                                                <<03046>>02516000
          ERRORON;                                             <<03046>>02518000
          CHEK(ERREX,%2,%10D);                                 <<03046>>02520000
          STATUS.CCFLD_TRAPLABEL(PXCPLAB,0,PLAB,DUM,XPLAB);    <<03046>>02522000
          ERROREXIT(ERREX,0,0);                                <<03046>>02524000
  END;                                                         <<03046>>02526000
$PAGE                                                                   02528000
            << >>                                                       02530000
<<********************************************************>>            02532000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            02534000
<<********************************************************>>            02536000
            <<ARM/DISARM "CONTROL Y" MECHANISM WITH EXTERNAL            02538000
               LABEL.RETURNS THE ORIGINAL EXTERNAL LABEL.               02540000
                                                                        02542000
               PLAB  <> 0 EXTERNAL LABEL                                02544000
                     =  0 DISARM MECHANISM                              02546000
                                                                        02548000
               CODE: CC=0 OK. ARMED                                     02550000
                     CC>0 OK. DISARMED                                  02552000
                     CC<0 NO. ILLEGAL PLAB                 >>           02554000
<<********************************************************>>            02556000
            << >>                                                       02558000
                                                                        02560000
                                                                        02562000
PROCEDURE XCONTRAP(PLABEL,OLDPLABEL);                                   02564000
VALUE PLABEL;                                                           02566000
INTEGER PLABEL,OLDPLABEL;                                               02568000
OPTION PRIVILEGED;                                                      02570000
                                                                        02572000
COMMENT: SETS UP THE CONTROL Y MECANISM FOR THE CALLER PROCESS.         02574000
         RETIRNS:                                                       02576000
            CC=CCE   OK CONTROL Y ARMED                                 02578000
            CC=CCG   OK CONTROL Y DISARMED                              02580000
            CC=CCL   FAILURE                                            02582000
                        1.NOT A SESSION                                 02584000
                        2.ILLEGAL PLABEL(NOT EXTERNAL/SYSTEM LABEL...)  02586000
                                                                        02588000
            OLDPLABEL IS AN EXTERNAL LABEL.                             02590000
      ;                                                                 02592000
                                                                        02594000
BEGIN                                                                   02596000
          EQUATE ERRN=54,EXITN=2;                                       02598000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               02600000
      EQUATE STINX=3;                                                   02602000
      ARRAY PCBX(*)=Q+0;                                                02604000
      EQUATE LDT=14,LDTSIZE=5;                                          02606000
      INTEGER STDIN,CC,PIN;                                             02608000
      ARRAY LDTABLE(*)=DB+0;                                            02610000
                                                                        02612000
                                                                        02614000
      ERRORON;                                                          02616000
      CHEK(ERREX,%2,%10D);                                              02618000
      PUSH(Q,DL);                                                       02620000
      ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                                  02622000
      TOS:=-PCBX(X);                                                    02624000
      ASSEMBLE(ADD);                                                    02626000
      TOS:=TOS+STINX;                                                   02628000
      X:=TOS;                                                           02630000
      STDIN:=PCBX(X).(8:8);            <<STANDARD INPUT DEV>>           02632000
      TOS:=PCBX(X+3).(2:2);            <<JOB TYPE>>                     02634000
      IF TOS<>1 THEN                                                    02636000
      BEGIN                            <<NOT A SESSION>>                02638000
         CC:=CCL;                                                       02640000
         GOTO FIN;                                                      02642000
      END;                                                              02644000
                                                                        02646000
      IF PLABEL<>0 THEN                                                 02648000
      BEGIN                            <<SET CONTROL Y>>                02650000
         PIN _ PIX/PCBSIZE;                                             02652000
X1:      CC:=TRAPLABEL(18,0,PLABEL,CC,OLDPLABEL);                       02654000
         IF CC=CCL THEN GO FIN;        <<ERROR>>               <<C0.00>>02656000
         TOS:=EXCHANGEDB(LDT);         <<LOGICAL DEV TABE>>             02658000
         LDTABLE(STDIN*LDTSIZE+1).(8:8):=PIN;                           02660000
         EXCHANGEDB(*);                                                 02662000
         IF PLABEL<>0 THEN                                              02664000
         BEGIN                                                          02666000
            IOCONTROL(STDIN,13);                                        02668000
FIN:        STATUS.(6:2):=CC;                                           02670000
            ERROREXIT(ERREX,0,0);                                       02672000
         END ELSE GOTO FIN;                                             02674000
      END ELSE                                                          02676000
      BEGIN                                                             02678000
         PIN:=0;                                                        02680000
         IOCONTROL(STDIN,12);                                           02682000
         GOTO X1;                                                       02684000
      END;                                                              02686000
                                                                        02688000
END;  << X C O N T R A P  >>                                            02690000
$PAGE                                                                   02692000
                                                                        02694000
PROCEDURE RESETCONTROL;                                                 02696000
OPTION PRIVILEGED;                                                      02698000
                                                                        02700000
COMMENT: RESETS PROCESS ENVIRONMENT FROM CY TO NAORMAL.                 02702000
      RETIRNS CCE IF OK                                                 02704000
              CCL IF FAILURE:THE PROCESS WAS NOT RUMNIG IN CY MODE.     02706000
      ;                                                                 02708000
                                                                        02710000
BEGIN                                                                   02712000
INTEGER                                                        <<00.EB>>02714000
   CC,                                                         <<00.EB>>02716000
   INDEX;                                                      <<00.EB>>02718000
                                                               <<00.EB>>02720000
INTEGER ARRAY Q0(*) = Q+0;                                     <<00.EB>>02722000
                                                               <<00.EB>>02724000
POINTER CST = 1;                                               <<00.EB>>02726000
                                                               <<00.EB>>02728000
DEFINE SYSBIT = (11:1) #;                                      <<00.EB>>02730000
                                                               <<00.EB>>02732000
EQUATE STDIN = 3;                                              <<00.EB>>02734000
                                                               <<00.EB>>02736000
LOGICAL SUBROUTINE PXGLOB(INDEX);                              <<00.EB>>02738000
   VALUE INDEX;                                                <<00.EB>>02740000
   INTEGER INDEX;                                              <<00.EB>>02742000
COMMENT     *** WORKS ONLY IF DB AT STACK *** ;                <<00.EB>>02744000
BEGIN                                                          <<00.EB>>02746000
                                                               <<00.EB>>02748000
ASSEMBLE(                                                      <<00.EB>>02750000
PSHR %40;     << DL >>                                         <<00.EB>>02752000
LDXN 1;       << PCBX GLOBE PTR 1 BELOW DL >>                  <<00.EB>>02754000
SUBM S-0,I,X; << OFFSET TO PXGLOB >>                           <<00.EB>>02756000
STAX,ADBX;    << X:= OFFSET + INDEX >>                         <<00.EB>>02758000
LOAD DB+0,X;  << GET VALUE >>                                  <<00.EB>>02760000
STOR S-3;);   << PUT IN RETURN VALUE >>                        <<00.EB>>02762000
END; << PXGLOB >>                                              <<00.EB>>02764000
                                                               <<00.EB>>02766000
ERRORON;                                                       <<00.EB>>02768000
CHEK(55 &LSL(6),0); << DB MUST BE AT STACK >>                  <<00.EB>>02770000
                                                               <<00.EB>>02772000
<< CHECK PCB PSEUDO INT.MODE FOR CTL Y >>                      <<00.EB>>02774000
IF PCBI'(PIX+PIINFONIMPPINWORDNUM).PSIMFIELD=5 THEN            <<01549>>02776000
BEGIN << CTLY OCCURRED >>                                      <<00.EB>>02778000
   PCBI'(X).PSIMFIELD:=7;                                      <<01549>>02780000
   CC := CCE;                                                  <<00.EB>>02782000
   << LOOK BACK IN MARKERS FOR A CTLY MARKER >>                <<00.EB>>02784000
   INDEX := -1; << LOOK AT STATUS WORD IN MARKER >>            <<00.EB>>02786000
   WHILE Q0(INDEX).(8:8) < %300 AND CST(Q0(INDEX).(8:8)&LSL(2) <<00.EB>>02788000
   +1).SYSTEMFLAG                                              <<01549>>02790000
      DO INDEX := INDEX -Q0(INDEX+1);                          <<00.EB>>02792000
   << RESET DELTA P BIT 0 >>                                   <<00.EB>>02794000
   Q0(INDEX-1).(0:1) := 0;                                     <<00.EB>>02796000
                                                               <<00.EB>>02798000
   RESETBREAKBITS(PXGLOB(STDIN).(8:8),0);                      <<00.EB>>02800000
   RESUMESOFTINT;                                              <<03046>>02802000
END                                                            <<00.EB>>02804000
ELSE CC := CCL;                                                <<00.EB>>02806000
                                                               <<00.EB>>02808000
STATUS.(6:2) := CC;                                            <<00.EB>>02810000
ERROREXIT(55 &LSL(6),0,0);                                     <<00.EB>>02812000
                                                               <<00.EB>>02814000
END; << RESETCONTROL >>                                        <<00.EB>>02816000
$PAGE                                                                   02818000
$PAGE                                                                   02822000
                                                               <<B0.02>>02824000
PROCEDURE DEC'SIM'TRAP(TRAPNUM);                               <<B0.07>>02826000
  VALUE TRAPNUM;                                               <<B0.07>>02828000
  INTEGER TRAPNUM;                                             <<B0.07>>02830000
  OPTION PRIVILEGED;                                           <<B0.07>>02832000
                                                               <<B0.07>>02834000
BEGIN                                                          <<B0.07>>02836000
  COMMENT THIS PROCEDURE SIMULATES PROCEDURE TRAPS IN PASSING  <<B0.07>>02838000
    TRAPS FROM THE DECIMAL FIRMWARE SIMULATIONS TO PROCEDURE   <<B0.07>>02840000
    ABORT.  IT ASSUMES THE OPCODE AND SDEC ARE IN CERTAIN      <<B0.07>>02842000
    LOCATIONS Q-RELATIVE TO THE USER STACK MARKER.  THIS IS    <<B0.07>>02844000
    TAKEN ADVANTAGE OF BY POPPING THE TWO TOP STACK MARKERS    <<B0.07>>02846000
    BEFORE ACCESSING THIS DATA.                                <<B0.07>>02848000
    ;                                                          <<B0.07>>02850000
  INTEGER XREG=X,  <<INDEX REGISTER>>                          <<B0.07>>02852000
          DQ=Q+0,  <<DELTA Q>>                                 <<B0.07>>02854000
          PARAM=Q+1,   <<ERROR PARAMETER(OPCODE ON ENTRY)>>    <<B0.07>>02856000
          SDEC=Q+2,  <<SDEC IMPLICITLY PASSED BY FIRMWARESIM>> <<B0.07>>02858000
          TNUM=S-5;                                            <<B0.07>>02860000
  INTEGER ARRAY STACK(*)=Q+0;                                  <<B0.07>>02862000
  EQUATE TYPE=0,MARK=1,MODE=[8/MARK,8/TYPE];                   <<B0.07>>02864000
  TOS:=LOGICALCST(STATUS.CSTFIELD);                            <<B0.07>>02866000
  DEL;                                                         <<B0.07>>02868000
  IF TOS=SYSTEMSL THEN    <<CAME FROM FIRMWARESIM>>            <<B0.07>>02870000
    BEGIN                                                      <<B0.07>>02872000
      XREG:=-(STACK(-DQ)+DQ)-1;<<DISP TO USER SM>>             <<B0.07>>02874000
      TOS:=STACK(XREG);<<USER STATUS>>                         <<B0.07>>02876000
      ASSEMBLE(TBC 2);                                         <<B0.07>>02878000
      IF = THEN <<TRAPS OFF>>                                  <<B0.07>>02880000
        BEGIN                                                  <<B0.07>>02882000
          ASSEMBLE(TSBC 4);<<SET OVERFLOW>>                    <<B0.07>>02884000
          STACK(XREG):=TOS;<<REPLACE USER STATUS>>             <<B0.07>>02886000
          PUSH(Q);                                             <<B0.07>>02888000
          TOS:=TOS+XREG+1;<<RESET SM>>                         <<B0.07>>02890000
          SET(Q);                                              <<B0.07>>02892000
          TOS:=%31400+SDEC;                                    <<B0.07>>02894000
          ASSEMBLE(XEQ 0);                                     <<B0.07>>02896000
        END                                                    <<B0.07>>02898000
      ELSE                                                     <<B0.07>>02900000
        BEGIN    <<TRAPS ON>>                                  <<B0.07>>02902000
          DEL;   <<DELETE USER STATUS>>                        <<B0.07>>02904000
          PUSH(S,Q);                                           <<B0.07>>02906000
          TOS:=XREG+1;                                         <<B0.07>>02908000
          ASSEMBLE(DUP,CAB);                                   <<B0.07>>02910000
          TOS:=TOS+TOS;                                        <<B0.07>>02912000
          SET(Q);                                              <<B0.07>>02914000
          TOS:=TOS+TOS+1;  <<NEW S POINTER>>                   <<B0.07>>02916000
          XREG:=PARAM;                                         <<B0.07>>02918000
          PARAM:=TNUM;                                         <<B0.07>>02920000
          SET(S);                                              <<B0.07>>02922000
          ABORT(MODE,PARAM,0);                                 <<B0.07>>02924000
        END;                                                   <<B0.07>>02926000
    END;                                                       <<B0.07>>02928000
END; <<DEC'SIM'TRAP>>                                          <<B0.07>>02930000
$PAGE                                                                   02932000
                                                               <<B0.07>>02934000
PROCEDURE DEC'SIM'TRAP'(OPCODE,TRAPNUM);                       <<B0.07>>02936000
VALUE OPCODE,TRAPNUM;                                          <<B0.07>>02938000
INTEGER OPCODE,TRAPNUM;                                        <<B0.07>>02940000
OPTION PRIVILEGED;                                             <<B0.07>>02942000
BEGIN                                                          <<B0.07>>02944000
  COMMENT THIS PROCEDURE INTERFACES TRAPS COMING FROM DIVD,    <<B0.07>>02946000
    MPYD AND EDIT WITH THE REGULAR DECIMAL FIRMWARESIM         <<B0.07>>02948000
    TRAP MECHANISM.;                                           <<B0.07>>02950000
  INTEGER ARRAY STACK(*)=Q+0;                                  <<B0.07>>02952000
  INTEGER DQ=Q+0;  <<DELTA Q>>                                 <<B0.07>>02954000
  EQUATE TYPE=0, MARK=1;                                                02956000
  EQUATE SDECDISP=-4;<<DISPLACEMENT FROM USER SM TO SDEC>>     <<B0.07>>02958000
  TOS:=LOGICALCST(STATUS.CSTFIELD);                            <<B0.07>>02960000
  DEL;                                                         <<B0.07>>02962000
  IF TOS = SYSTEMSL THEN <<CAME FROM SYSTEM>>                  <<B0.07>>02964000
    BEGIN                                                      <<B0.07>>02966000
      STACK(-DQ+1):=OPCODE;                                    <<B0.07>>02968000
      STACK(-DQ+2):=STACK(-DQ+SDECDISP)&LSL(1)+1;              <<00.02>>02970000
      DEC'SIM'TRAP(TRAPNUM);                                   <<B0.07>>02972000
    END                                                        <<B0.07>>02974000
END; <<DEC'SIM'TRAP'>>                                         <<B0.07>>02976000
                                                               <<C0.00>>02978000
        <<--------------------->>                              <<C0.00>>02980000
        <<  S T A C K D U M P  >>                              <<C0.00>>02982000
        <<  R O U T I N E S    >>                              <<C0.00>>02984000
        <<--------------------->>                              <<C0.00>>02986000
                                                               <<C0.00>>02988000
                                                               <<C0.00>>02990000
PROCEDURE REGIST(SX,BOUTBUF);                                  <<C0.00>>02992000
                VALUE SX;                                      <<C0.00>>02994000
                INTEGER SX;                                    <<C0.00>>02996000
                BYTE ARRAY BOUTBUF;                            <<C0.00>>02998000
                OPTION PRIVILEGED,UNCALLABLE;                  <<C0.00>>03000000
BEGIN                                                          <<C0.00>>03002000
    COMMENT:                                                   <<C0.00>>03004000
    << GETS S, DL, AND Z REGS FROM MARKER LOCATED AT SX AND    <<C0.00>>03006000
    << FORMATS THEM IN OUTPUT BUFFER BOUTBUF;                  <<C0.00>>03008000
                                                               <<C0.00>>03010000
    MOVE BOUTBUF _ "S=";                                                03012000
    ASCII(SX-4,8,BOUTBUF(2));                                  <<C0.00>>03014000
    MOVE BOUTBUF(12):="DL=";                                   <<C0.00>>03016000
    TOS:=0D;                                                   <<C0.00>>03018000
    PUSH(DL);                                                  <<C0.00>>03020000
    ASCII(*,8,BOUTBUF(15));                                    <<C0.00>>03022000
    MOVE BOUTBUF(25):="Z=";                                    <<C0.00>>03024000
    PUSH(Z);                                                   <<C0.00>>03026000
    ASCII(*,8,BOUTBUF(27));                                    <<C0.00>>03028000
END  <<PROCEDURE REGIST>>;                                     <<C0.00>>03030000
                                                               <<C0.00>>03032000
                                                               <<C0.00>>03034000
<<--------------------------------------------------------------->>     03036000
                                                               <<C0.00>>03038000
                                                               <<C0.00>>03040000
PROCEDURE MARKER(P,BOUTBUF);                                   <<C0.00>>03042000
                VALUE P;                                       <<C0.00>>03044000
                INTEGER P;                                     <<C0.00>>03046000
                BYTE ARRAY BOUTBUF;                            <<C0.00>>03048000
                OPTION PRIVILEGED,UNCALLABLE;                  <<C0.00>>03050000
BEGIN                                                          <<C0.00>>03052000
    COMMENT:                                                   <<C0.00>>03054000
    << EXTRACTS CONTENT OF MARKER POINTED TO BY P AND FORMATS  <<C0.00>>03056000
    << IT IN OUTPUT BUFFER BOUTBUF.                            <<C0.00>>03058000
    <<                                                         <<C0.00>>03060000
    << RETURNS CCL IF CST IS INVALID;                          <<C0.00>>03062000
                                                               <<C0.00>>03064000
  BYTE ARRAY SD(0:12)=PB:="PU1010RL1010";                      <<C0.00>>03066000
  BYTE ARRAY CC(0:12)=PB:="CCGCCLCCE 3 ";                      <<C0.00>>03068000
  ARRAY STACK(*)=DB+0;                                         <<C0.00>>03070000
  INTEGER DQ=Q+0,                                              <<C0.00>>03072000
          X,                                                   <<C0.00>>03074000
          V;                                                   <<C0.00>>03076000
  DOUBLE PROCEDURE LOGICALCST(CST);VALUE CST;INTEGER CST;      <<C0.00>>03078000
                             OPTION EXTERNAL;                  <<C0.00>>03080000
                                                               <<C0.00>>03082000
          <<-------------------->>                             <<C0.00>>03084000
                                                               <<C0.00>>03086000
    MOVE BOUTBUF _ "Q=";                                                03088000
    ASCII(P,8,BOUTBUF(2));                                     <<C0.00>>03090000
    MOVE BOUTBUF(9):="P=";                                     <<C0.00>>03092000
    ASCII(STACK(P-2)-1,8,BOUTBUF(11));      <<P CONVERSION>>   <<C0.00>>03094000
    TOS:=LOGICALCST(STACK(P-1).(8:8));                         <<C0.00>>03096000
    IF < THEN                                                  <<C0.00>>03098000
      BEGIN                                                    <<C0.00>>03100000
        STATUS.CCFLD _ CCL;                                             03102000
        RETURN;                                                <<C0.00>>03104000
      END;                                                     <<C0.00>>03106000
    ASSEMBLE(ZERO,XCH);                                        <<C0.00>>03108000
    TOS:=ASCII(*,8,BOUTBUF(23));                               <<C0.00>>03110000
    ASSEMBLE(DEL);                                             <<C0.00>>03112000
    MOVE BOUTBUF(19):="LCST= ";                                <<C0.00>>03114000
    CASE TOS OF BEGIN                       <<PROPER LIBRARY>> <<C0.00>>03116000
      TOS:="S";                                                <<C0.00>>03118000
      TOS:="P";                                                <<C0.00>>03120000
      TOS:="G";                                                <<C0.00>>03122000
      TOS:=" ";                                                <<C0.00>>03124000
    END;                                                       <<C0.00>>03126000
    BOUTBUF(25):=TOS;                                          <<C0.00>>03128000
                                                               <<C0.00>>03130000
    MOVE BOUTBUF(31):="STAT= , , , , , ,   ";                  <<C0.00>>03132000
    TOS:=STACK(P-1);                                           <<C0.00>>03134000
    V:=-1;                                                     <<C0.00>>03136000
    WHILE (V:=V+1)<=5 DO                                       <<C0.00>>03138000
    BEGIN                                                      <<C0.00>>03140000
      ASSEMBLE(TEST);                                          <<C0.00>>03142000
      X:= IF < THEN 2*V ELSE 2*V+1;                            <<C0.00>>03144000
      MOVE BOUTBUF(36+2*V):=SD(X),(1);                         <<C0.00>>03146000
      TOS:=TOS&LSL(1);                                         <<C0.00>>03148000
    END;                                                       <<C0.00>>03150000
                                                               <<C0.00>>03152000
    V:=TOS&LSR(14);                                            <<C0.00>>03154000
    MOVE BOUTBUF(48):=CC(V*3),(3);                             <<C0.00>>03156000
    MOVE BOUTBUF(54):="X=";                                    <<C0.00>>03158000
    ASCII(STACK(P-3),8,BOUTBUF(56));                           <<C0.00>>03160000
    STATUS.CCFLD _ CCE;                                                 03162000
END  <<PROCEDURE MARKER>>;                                     <<C0.00>>03164000
                                                               <<C0.00>>03166000
                                                               <<C0.00>>03168000
<<--------------------------------------------------------------->>     03170000
                                                               <<C0.00>>03172000
                                                               <<C0.00>>03174000
PROCEDURE STACKDUMP(FILEN,IDNUMBER,FLAG ,SELEC);               <<C0.00>>03176000
                   BYTE ARRAY FILEN;                           <<C0.00>>03178000
                   INTEGER IDNUMBER;                           <<C0.00>>03180000
                   LOGICAL FLAG;                               <<C0.00>>03182000
                   DOUBLE ARRAY SELEC;                         <<C0.00>>03184000
                   OPTION PRIVILEGED,VARIABLE;                 <<C0.00>>03186000
BEGIN                                                          <<C0.00>>03188000
    COMMENT:                                                   <<C0.00>>03190000
    << INTRINSIC #77.                                          <<C0.00>>03192000
    << DUMPS STACK ACCORDING TO SPECS;                         <<C0.00>>03194000
                                                               <<C0.00>>03196000
  ENTRY STACKDUMP';                                            <<C0.00>>03198000
                                                               <<C0.00>>03200000
  EQUATE JSTL=4;               <<JOB $STDLIST IN PCBX>>                 03202000
  ARRAY OUTB(0:128);                                           <<C0.00>>03204000
  BYTE ARRAY BOUTB(*)=OUTB;                                    <<C0.00>>03206000
  INTEGER XREG=X,                                                       03208000
          STAT=Q-1,                                            <<C0.00>>03210000
          FN,                                                  <<C0.00>>03212000
          CC,                                                  <<C0.00>>03214000
          RECSIZE,                                             <<C0.00>>03216000
          ERRCODE:=77;                                         <<C0.00>>03218000
  LOGICAL VAR=Q-4,                                             <<C0.00>>03220000
          PF:=FALSE,                                           <<C0.00>>03222000
          FOPTIONS,                                            <<C0.00>>03224000
          AOPTIONS;                                            <<C0.00>>03226000
  INTEGER ADUM=Q-7,                                            <<C0.00>>03228000
          DUMMY,                                               <<C0.00>>03230000
          SX;                                                  <<C0.00>>03232000
  ARRAY LDT(*)=DB+0,                                           <<C0.00>>03234000
        PCBX(*)=Q+0,                                           <<C0.00>>03236000
        WINT(0:40);                      <<TEMPORARY>>         <<C0.00>>03238000
  LOGICAL FLAGS;                                               <<C0.00>>03240000
  BYTE ARRAY TIT(0:50)=PB:=                                    <<C0.00>>03242000
      "***      STACK  DISPLAY      ***          ID #      ";  <<C0.00>>03244000
  INTEGER ARRAY ST(*)=DB+0;                                    <<C0.00>>03246000
  INTEGER S0=S-0,                                              <<C0.00>>03248000
          S1=S-1,                                              <<C0.00>>03250000
          S2=S-2,                                              <<C0.00>>03252000
          V,                                                   <<C0.00>>03254000
          T,                                                   <<C0.00>>03256000
          W,                                                   <<C0.00>>03258000
          DSTX;                                                <<C0.00>>03260000
  LOGICAL SBF;                                                 <<C0.00>>03262000
  INTEGER QR,                                                  <<C0.00>>03264000
          QIN,                                                 <<02341>>03266000
          SR,                                                  <<C0.00>>03268000
          DBAD,                                                <<C0.00>>03270000
          COUNT,                                               <<C0.00>>03272000
          LBOUND,                                              <<C0.00>>03274000
          UBOUND;                                              <<C0.00>>03276000
  LOGICAL AREAF;                                               <<C0.00>>03278000
  INTEGER ENVIR:=0,                                            <<C0.00>>03280000
          LKOUNT,                                              <<C0.00>>03282000
          PX;                                                  <<C0.00>>03284000
  DOUBLE BOUNDS=LBOUND;                                        <<C0.00>>03286000
  LOGICAL AF:=TRUE;                                            <<C0.00>>03288000
  INTEGER CURSELX:=-1,                                         <<C0.00>>03290000
          LIM,                                                 <<C0.00>>03292000
          WPL,                                                 <<C0.00>>03294000
          L1,                                                  <<C0.00>>03296000
          L2,                                                  <<C0.00>>03298000
          L3;                                                  <<C0.00>>03300000
  ARRAY IS(0:1);                                               <<C0.00>>03302000
  BYTE ARRAY BIS(*)=IS;                                        <<C0.00>>03304000
  INTEGER OT,                                                  <<C0.00>>03306000
          LINES,                                               <<C0.00>>03308000
          CW,                                                  <<C0.00>>03310000
          CL;                                                  <<C0.00>>03312000
  LOGICAL UF;                                                  <<C0.00>>03314000
  BYTE ARRAY MAD(0:20)=PB:="..DB.. ..Q... ..S... ";            <<C0.00>>03316000
  DEFINE CCL= < #,                                             <<C0.00>>03318000
         CCG= > #,                                             <<C0.00>>03320000
         CCE= = #;                                             <<C0.00>>03322000
                                                               <<C0.00>>03324000
          <<-------------------->>                             <<C0.00>>03326000
                                                               <<C0.00>>03328000
  SUBROUTINE FILERR;                                           <<C0.00>>03330000
  BEGIN                                                        <<C0.00>>03332000
    IF PF THEN IDNUMBER:=0                                     <<C0.00>>03334000
      ELSE FCHECK(FN,IDNUMBER);                                <<C0.00>>03336000
    CC:=1;                                                     <<C0.00>>03338000
    GO FINI;                                                   <<C0.00>>03340000
  END  <<SUBROUTINE FILERR>>;                                  <<C0.00>>03342000
                                                               <<C0.00>>03344000
          <<-------------------->>                             <<C0.00>>03346000
                                                               <<C0.00>>03348000
  SUBROUTINE CLEARBUF;                                         <<C0.00>>03350000
  BEGIN                                                        <<C0.00>>03352000
        COMMENT:                                               <<C0.00>>03354000
        << CLEARS THE OUTPUT BUFFER;                           <<C0.00>>03356000
    OUTB:="  ";                                                <<C0.00>>03358000
    MOVE OUTB(1):=OUTB,(RECSIZE&LSR(1));                       <<C0.00>>03360000
  END  <<SUBROUTINE CLEARBUF>>;                                <<C0.00>>03362000
                                                               <<C0.00>>03364000
          <<-------------------->>                             <<C0.00>>03366000
                                                               <<C0.00>>03368000
  SUBROUTINE WRITE(N);                                         <<C0.00>>03370000
                  VALUE N;                                     <<C0.00>>03372000
                  INTEGER N;                                   <<C0.00>>03374000
  BEGIN                                                        <<C0.00>>03376000
        COMMENT:                                               <<C0.00>>03378000
        << WRITES ON OUTPUT FILE N BYTES FROM OUTPUT BUFFER;   <<C0.00>>03380000
    IF PF THEN PRINT(OUTB,-N,0) ELSE FWRITE(FN,OUTB,-N,0);     <<C0.00>>03382000
    IF <> THEN FILERR;                                         <<C0.00>>03384000
    CLEARBUF;                                                  <<C0.00>>03386000
  END  <<SUBROUTINE WRITE>>;                                   <<C0.00>>03388000
                                                               <<C0.00>>03390000
          <<-------------------->>                             <<C0.00>>03392000
                                                               <<C0.00>>03394000
  LOGICAL SUBROUTINE STCHK;                                    <<C0.00>>03396000
  BEGIN                                                        <<C0.00>>03398000
        COMMENT:                                               <<C0.00>>03400000
        << TESTS DBAD AND COUND AGAINST STACK BOUNDS.          <<C0.00>>03402000
        << RETURNS TRUE IF OK;                                 <<C0.00>>03404000
    STCHK:=TRUE;                                               <<C0.00>>03406000
    IF NOT(LBOUND<=DBAD) LOR NOT (DBAD+COUNT<=UBOUND) THEN     <<C0.00>>03408000
      BEGIN                                  <<OUT OF BOUNDS>> <<C0.00>>03410000
        SBF:=FALSE;                                            <<C0.00>>03412000
        IF (DBAD+COUNT<LBOUND) LOR (DBAD>UBOUND) THEN STCHK:=FALSE      03414000
          ELSE BEGIN                                           <<C0.00>>03416000
 AJ:                                                           <<C0.00>>03418000
            IF DBAD+COUNT>UBOUND THEN COUNT:=UBOUND-DBAD;      <<C0.00>>03420000
            IF DBAD<LBOUND THEN                                <<C0.00>>03422000
              BEGIN                                            <<C0.00>>03424000
                DBAD:=LBOUND;                                  <<C0.00>>03426000
                GOTO AJ;                                       <<C0.00>>03428000
              END;                                             <<C0.00>>03430000
          END;                                                 <<C0.00>>03432000
      END;                                                     <<C0.00>>03434000
  END  <<LOGICAL SUBROUTINE STCHK>>;                           <<C0.00>>03436000
                                                               <<C0.00>>03438000
          <<-------------------->>                             <<C0.00>>03440000
                                                               <<C0.00>>03442000
  SUBROUTINE TITLE;                                            <<C0.00>>03444000
  BEGIN                                                        <<C0.00>>03446000
        COMMENT:                                               <<C0.00>>03448000
        << OUTPUTS MAIN TITLE FOR STACKDUMP;                   <<C0.00>>03450000
    IF PF THEN PRINT(OUTB,0,%61) ELSE FWRITE(FN,OUTB,0,%61);   <<C0.00>>03452000
    IF <> THEN FILERR;                                         <<C0.00>>03454000
    SX:=(RECSIZE-53)&LSR(2);                                   <<00867>>03456000
    CLEARBUF;                                                  <<C0.00>>03458000
    MOVE BOUTB(SX):=TIT(0),(50);                               <<C0.00>>03460000
    IF VAR.(13:1) THEN ASCII(IDNUMBER,10,BOUTB(SX+47))         <<C0.00>>03462000
      ELSE MOVE BOUTB(SX+42):="    ";                          <<C0.00>>03464000
    WRITE(53+SX);                                              <<00867>>03466000
    IF PF THEN PRINT(OUTB,0,%202) ELSE FWRITE(FN,OUTB,0,%202); <<C0.00>>03468000
    IF <> THEN FILERR;                                         <<C0.00>>03470000
  END  <<SUBROUTINE TITLE>>;                                   <<C0.00>>03472000
                                                               <<C0.00>>03474000
                                                               <<C0.00>>03476000
          <<-------------------->>                             <<C0.00>>03478000
                                                               <<C0.00>>03480000
SUBROUTINE FORMATDP(ADMODE);                                   <<C0.00>>03482000
                   VALUE ADMODE;                               <<C0.00>>03484000
                   INTEGER ADMODE;                             <<C0.00>>03486000
  BEGIN                                                        <<C0.00>>03488000
        COMMENT:                                               <<C0.00>>03490000
        << ADMODE=0 -- DB                                      <<C0.00>>03492000
        <<        4 -- DS                                      <<C0.00>>03494000
        <<        1 -- Q                                       <<C0.00>>03496000
        <<        2 -- S                                       <<C0.00>>03498000
        << FIGURES OUT FORMATTING OF OUTPUT RECORD USING       <<C0.00>>03500000
        << FOLLOWING RULES:                                    <<C0.00>>03502000
        <<   1) COMPUTES MAXIMUM NUMBER OF WORDS PER LINE (WPL)<<C0.00>>03504000
        <<   2) SETS TAB MARKS FOR ADDRESSINGG, OCTAL AND ASCII<<C0.00>>03506000
        <<      DUMPS, AND NUMBER BLANKS BETWEEN AREADS        <<C0.00>>03508000
        <<   3) PRINTS FIRST LINE OF AREA;                     <<C0.00>>03510000
    T:=IF ADMODE.(14:2)=0 THEN 8                               <<C0.00>>03512000
       ELSE IF ADMODE.(14:2)=1 THEN 15 ELSE 22;                <<C0.00>>03514000
    V := IF FLAGS.(15:1)  THEN 7  ELSE 10;                     <<02341>>03516000
    WPL:=(((RECSIZE-T)/V)&LSR(2))&LSL(2);                      <<C0.00>>03518000
    T:=                                                        <<C0.00>>03520000
       (WPL*7-1) +                                             <<C0.00>>03522000
       (IF NOT FLAGS.(15:1)  THEN WPL*3-1  ELSE 4) +           <<02341>>03524000
       ((ADMODE.(14:2)+1)*7) ;                                 <<C0.00>>03526000
                                                               <<C0.00>>03528000
    IF NOT FLAGS.(15:1)  THEN         <<ASCII>>                <<02341>>03530000
      BEGIN                                                    <<C0.00>>03532000
        V:=(RECSIZE-2-T)&LSR(2);                               <<C0.00>>03534000
        L1:=V;                                                 <<C0.00>>03536000
        L2:=L1+(ADMODE.(14:2)+1)*7+2+V;                        <<C0.00>>03538000
        L3:=L2+WPL*7-1+V;                                      <<C0.00>>03540000
      END                                                      <<C0.00>>03542000
      ELSE BEGIN                                               <<C0.00>>03544000
        V:=(RECSIZE-T-2)/3;                                    <<C0.00>>03546000
        L1:=V;                                                 <<C0.00>>03548000
        L2:=L1+(ADMODE.(14:2)+1)*7+2+V;                        <<C0.00>>03550000
        L3:=0;                                                 <<C0.00>>03552000
      END;                                                     <<C0.00>>03554000
                                                               <<C0.00>>03556000
          <<OUTPUT TITLE FOR THE AREA>>                        <<C0.00>>03558000
                                                               <<C0.00>>03560000
    MOVE BOUTB(L1):=MAD(0),                                    <<C0.00>>03562000
                    ((ADMODE.(14:2)+1)*7);                     <<C0.00>>03564000
    IF ADMODE=4 THEN                                           <<C0.00>>03566000
      BEGIN                                                    <<C0.00>>03568000
        MOVE BOUTB(L1+3):="S.. #";             <<DATA SEGMENT>><<C0.00>>03570000
        ASCII(DSTX,10,BOUTB(L1+10));                           <<C0.00>>03572000
      END;                                                     <<C0.00>>03574000
    MOVE BOUTB(T:=L2+(WPL*7-1)&LSR(1)-3):="OCTAL";             <<C0.00>>03576000
    IF NOT (FLAGS.(15:1)) THEN                                 <<02341>>03578000
    MOVE BOUTB(T:=L3+(WPL*3-1)&LSR(1)-3):="ASCII";             <<C0.00>>03580000
    WRITE(T+6);                  <<WRITE FORMAT TITLE>>        <<C0.00>>03582000
  END  <<SUBROUTINE FORMATDP>>;                                <<C0.00>>03584000
                                                               <<C0.00>>03586000
          <<--------------------->>                            <<C0.00>>03588000
                                                               <<C0.00>>03590000
  SUBROUTINE TRCBCK;                                           <<C0.00>>03592000
  BEGIN                                                        <<C0.00>>03594000
        COMMENT:                                               <<C0.00>>03596000
        << OUTPUTS TRACE BACK OF STACK;                        <<C0.00>>03598000
    SX:=QR;                                                    <<C0.00>>03600000
    UF:= IF ST(SX-1)>0 THEN TRUE ELSE FALSE;                   <<C0.00>>03602000
    WHILE SX > QIN DO                                          <<02341>>03604000
    BEGIN                                                      <<C0.00>>03606000
      IF (ST(SX-1)<0) LAND UF THEN RETURN;                     <<C0.00>>03608000
      MARKER(SX,BOUTB((RECSIZE-60)&LSR(1)));                   <<C0.00>>03610000
      IF CCL  OR  (ST(SX) < 4) THEN GO ER;                     <<02341>>03612000
      WRITE((RECSIZE+2)&LSR(1)+31);          <<OUPUT RECORD>>  <<C0.00>>03616000
      SX := SX - ST(SX);                                       <<02341>>03618000
    END;                                                       <<C0.00>>03620000
    IF PF THEN PRINT(OUTB,0,%203) ELSE FWRITE(FN,OUTB,0,%203); <<C0.00>>03622000
    IF <> THEN FILERR;                                         <<C0.00>>03624000
    RETURN;                                                    <<C0.00>>03626000
                                                               <<C0.00>>03628000
 ER:                                                           <<C0.00>>03630000
    MOVE BOUTB((RECSIZE-60)&LSR(1)):="ILLEGAL MARKER";         <<C0.00>>03632000
    WRITE(RECSIZE&LSR(1)-15);              <<OUTPUT>>          <<C0.00>>03634000
  END  <<SUBROUTINE TRCBCK>>;                                  <<C0.00>>03636000
                                                               <<C0.00>>03638000
          <<-------------------->>                             <<C0.00>>03640000
                                                               <<C0.00>>03642000
  SUBROUTINE CONVERTAD(NUM,INDX);                              <<C0.00>>03644000
                      VALUE NUM,INDX;                          <<C0.00>>03646000
                      INTEGER NUM,INDX;                        <<C0.00>>03648000
  BEGIN                                                        <<C0.00>>03650000
        COMMENT:                                               <<C0.00>>03652000
        << CONVERTS INTO OCTAL AND DEPOSITS NUMBER INTO        <<C0.00>>03654000
        << LOCATION SPECIFIED BY INDX;                         <<C0.00>>03656000
    ASCII(IF NUM>=0 THEN NUM ELSE -NUM,8,BOUTB(INDX));         <<C0.00>>03658000
    BOUTB(INDX):=IF NUM<0 THEN "-" ELSE " ";                   <<C0.00>>03660000
  END  <<SUBROUTINE CONVERTAD>>;                               <<C0.00>>03662000
                                                               <<C0.00>>03664000
          <<-------------------->>                             <<C0.00>>03666000
                                                               <<C0.00>>03668000
  SUBROUTINE DUMPASCII(DBADR,COUNT,BUFX);                      <<C0.00>>03670000
                      VALUE DBADR,COUNT,BUFX;                  <<C0.00>>03672000
                      INTEGER DBADR,COUNT,BUFX;                <<C0.00>>03674000
  BEGIN                                                        <<C0.00>>03676000
        COMMENT:                                               <<C0.00>>03678000
        << DUMP "COUNT" WORDS IN SPECIFIED AREA;               <<C0.00>>03680000
    V:=0;                                                      <<C0.00>>03682000
    WHILE (V:=V+1)<=COUNT DO                                   <<C0.00>>03684000
    BEGIN                                                      <<C0.00>>03686000
      IS(0):=ST(DBADR);                                        <<C0.00>>03688000
                                                               <<C0.00>>03690000
          << NOT PRINTABLE CHARACTERS>>                        <<C0.00>>03692000
                                                               <<C0.00>>03694000
      XREG:=-1;                                                <<C0.00>>03696000
      WHILE (XREG:=XREG+1)<2 DO                                <<C0.00>>03698000
      IF BIS(XREG)<%40 OR BIS(XREG)>%172 THEN BIS(XREG):=".";  <<C0.00>>03700000
      MOVE BOUTB(L3+BUFX):=BIS(0),(2);                         <<C0.00>>03702000
      BOUTB(L3+(BUFX:=BUFX+2)):=" ";         <<SEPARATION>>    <<C0.00>>03704000
      BUFX:=BUFX+1;                                            <<C0.00>>03706000
      DBADR:=DBADR+1;                                          <<C0.00>>03708000
    END;                                                       <<C0.00>>03710000
  END  <<SUBROUTINE DUMPASCII>>;                               <<C0.00>>03712000
                                                               <<C0.00>>03714000
          <<-------------------->>                             <<C0.00>>03716000
                                                               <<C0.00>>03718000
  SUBROUTINE DUMPOCTAL(DBADR,COUNT,BUFX);                      <<C0.00>>03720000
                      VALUE DBADR,COUNT,BUFX;                  <<C0.00>>03722000
                      INTEGER DBADR,COUNT,BUFX;                <<C0.00>>03724000
  BEGIN                                                        <<C0.00>>03726000
        COMMENT:                                               <<C0.00>>03728000
        << DUMPS "COUNT" WORDS LOCATED IN DBADR IN STACK AND   <<C0.00>>03730000
        << PUTS THEM IN OUTPUT BUFFER.  ALL SEPARATED BY       <<C0.00>>03732000
        << BLANKS;                                             <<C0.00>>03734000
    V:=0;                                                      <<C0.00>>03736000
    WHILE (V:=V+1)<=COUNT DO                                   <<C0.00>>03738000
    BEGIN                                                      <<C0.00>>03740000
      ASCII(ST(DBADR),8,BOUTB(L2+BUFX));                       <<C0.00>>03742000
      DBADR:=DBADR+1;                                          <<C0.00>>03744000
      BUFX:=BUFX+7;                                            <<C0.00>>03746000
    END;                                                       <<C0.00>>03748000
                                                               <<C0.00>>03750000
  END;   <<DUMPOCTAL>>                                         <<C0.00>>03752000
                                                               <<C0.00>>03754000
          <<-------------------->>                             <<C0.00>>03756000
                                                               <<C0.00>>03758000
  SUBROUTINE SETAD(ADMODE,DBAD);                               <<C0.00>>03760000
                  VALUE ADMODE,DBAD;                           <<C0.00>>03762000
                  INTEGER ADMODE,DBAD;                         <<C0.00>>03764000
  BEGIN                                                        <<C0.00>>03766000
        COMMENT:                                               <<C0.00>>03768000
        << ADMODE= 0 (DB), 4 (DS), 1 (Q), 2 (S)                <<C0.00>>03770000
        << CONVERTS ADDRESSES AND DEPOSITS THEM IN OUTPUT      <<C0.00>>03772000
        << BUFFER IN L1 AREA;                                  <<C0.00>>03774000
    ADMODE:=ADMODE.(14:2);                 <<DB,Q & S>>        <<C0.00>>03776000
    CONVERTAD(DBAD,L1);                                        <<C0.00>>03778000
    IF ADMODE>=1 THEN CONVERTAD(DBAD-QR,L1+7);                 <<C0.00>>03780000
    IF ADMODE>=2 THEN CONVERTAD(DBAD-SR,L1+14);                <<C0.00>>03782000
  END  <<SUBROUTINE SETAD>>;                                   <<C0.00>>03784000
                                                               <<C0.00>>03786000
          <<-------------------->>                             <<C0.00>>03788000
                                                               <<C0.00>>03790000
  SUBROUTINE DUMP(ADMODE);                                     <<C0.00>>03792000
                 VALUE ADMODE;                                 <<C0.00>>03794000
                 INTEGER ADMODE;                               <<C0.00>>03796000
  BEGIN                                                        <<C0.00>>03798000
    SBF:=TRUE;                                                 <<C0.00>>03800000
    FORMATDP(ADMODE);                                          <<00599>>03802000
    IF ADMODE<4 AND NOT STCHK THEN BEGIN CC:=0;GO ARRET; END;  <<C0.00>>03804000
    IF ADMODE=4 THEN BEGIN PUSH(Q,S);W:=TOS-TOS;END;           <<C0.00>>03806000
                                                               <<C0.00>>03808000
        <<COMPUTE NUMBER OF LINES IN AREA>>                    <<C0.00>>03810000
                                                               <<C0.00>>03812000
    TOS:=IF ADMODE.(14:2)=0 THEN DBAD                          <<C0.00>>03814000
         ELSE IF ADMODE.(14:2)=1 THEN DBAD-QR ELSE DBAD-SR;    <<C0.00>>03816000
    ASSEMBLE(ZERO,XCH);                                        <<C0.00>>03818000
    TOS:=WPL;                                                  <<C0.00>>03820000
    ASSEMBLE(LDIV,DELB);                                       <<C0.00>>03822000
    OT:=TOS;         <<WORD OFFSET IN LINE>>                   <<C0.00>>03824000
                                                               <<C0.00>>03826000
        <<COMPUTE OFFSET IN FIRST LINE>>                       <<C0.00>>03828000
                                                               <<C0.00>>03830000
    TOS:=COUNT;                                                <<C0.00>>03832000
    IF= THEN BEGIN ASSEMBLE(DEL);RETURN;END;<<SKIP>>           <<C0.00>>03834000
    TOS:=WPL;                                                  <<C0.00>>03836000
    ASSEMBLE(DIV,TEST);<<TEST REMAINDER>>                      <<C0.00>>03838000
    IF = THEN                                                  <<C0.00>>03840000
      BEGIN                                                    <<C0.00>>03842000
        ASSEMBLE(DEL);                                         <<C0.00>>03844000
        IF OT<>0 THEN TOS:=TOS+1;  <<MORE LINES>>              <<C0.00>>03846000
      END                                                      <<C0.00>>03848000
      ELSE BEGIN            <<REMAINDER NON 0>>                <<C0.00>>03850000
        S1:=S1+1;  <<INCREASE LINE # BY 1>>                    <<C0.00>>03852000
        IF TOS>WPL-OT THEN TOS:=TOS+1;                         <<C0.00>>03854000
      END;                                                     <<C0.00>>03856000
    LINES:=TOS;                                                <<C0.00>>03858000
    CW:=0;           <<INITIALIZE>>                            <<C0.00>>03860000
    CL:=0;            <<CURRENT LINES>>                        <<C0.00>>03862000
    WHILE (CL:=CL+1)<=LINES DO                                 <<C0.00>>03864000
    BEGIN                                                      <<C0.00>>03866000
      SETAD(ADMODE,DBAD);                                      <<C0.00>>03868000
      IF CL=1 THEN       <<FIRST LINE>>                        <<C0.00>>03870000
      BEGIN                                                    <<C0.00>>03872000
        IF DBAD=0 THEN OT:=0;                                  <<C0.00>>03874000
      END                                                      <<C0.00>>03876000
      ELSE OT:=0;                                              <<C0.00>>03878000
                                                               <<C0.00>>03880000
      <<COMPUTATION OF THE COUNT TO BE OUPT>>                  <<C0.00>>03882000
                                                               <<C0.00>>03884000
      LKOUNT:=IF CL=LINES THEN COUNT-CW ELSE                   <<C0.00>>03886000
      IF CL=1 THEN LKOUNT:=WPL-OT ELSE WPL;                    <<C0.00>>03888000
      IF ADMODE=4 THEN SBF:=NOT DMOVE'(DSTX,DBAD,LKOUNT,@WINT,TRUE,W);  03890000
      DUMPOCTAL(IF ADMODE=4 THEN @WINT ELSE DBAD,LKOUNT,OT*7); <<C0.00>>03892000
      IF NOT FLAGS.(15:1) THEN                                 <<02341>>03894000
          DUMPASCII(IF ADMODE=4 THEN @WINT ELSE DBAD,LKOUNT,OT*3);      03896000
      CW:=CW+LKOUNT;                                           <<C0.00>>03898000
      DBAD:=DBAD+LKOUNT;                                       <<C0.00>>03900000
      WRITE(IF FLAGS.(15:1)  THEN L2+WPL*7  ELSE L3+WPL*3);    <<02341>>03902000
      IF (ADMODE=4 LAND NOT SBF) THEN GO ARRET;                <<C0.00>>03904000
    END;                                                       <<C0.00>>03906000
  ARRET:                                                       <<C0.00>>03908000
    IF NOT SBF THEN                                            <<C0.00>>03910000
      BEGIN                                                    <<C0.00>>03912000
        MOVE BOUTB(L1):="** AREA OUT OF BOUNDS **";WRITE(L1+24);        03914000
        CC:=0;             <<CCG>>                             <<C0.00>>03916000
      END;                                                     <<C0.00>>03918000
    IF PF THEN PRINT(OUTB,0,%203) ELSE FWRITE(FN,OUTB,0,%203); <<C0.00>>03920000
    IF <> THEN FILERR;                                         <<C0.00>>03922000
  END  <<SUBROUTINE DUMP>>;                                    <<C0.00>>03924000
                                                               <<C0.00>>03926000
          <<-------------------->>                             <<C0.00>>03928000
                                                               <<C0.00>>03930000
        <<----------------->>                                  <<C0.00>>03932000
        << BEGIN PROCEDURE >>                                  <<C0.00>>03934000
        <<----------------->>                                  <<C0.00>>03936000
                                                               <<C0.00>>03938000
    ERRORON;                                                   <<C0.00>>03940000
    BOUNDS:=CHEK(ERRCODE&LSL(6)+5,4,DOUBLE(%253),,%17);        <<C0.00>>03942000
    CC:=2;                                 <<CCE>>             <<C0.00>>03944000
    IF NOT VAR&LSR(2) THEN ADUM:=@DUMMY;   <<NO IDNUM>>        <<C0.00>>03946000
    IF NOT(VAR)&LSR(3) THEN                <<NO FILEN>>        <<C0.00>>03948000
      BEGIN                                                    <<C0.00>>03950000
        PF:=TRUE;   AF:=FALSE;                                 <<C0.00>>03952000
        PUSH(Q,DL);   ASSEMBLE(XCH,SUB;DUP,STAX;DECX);         <<C0.00>>03954000
        TOS:=-PCBX(XREG);ASSEMBLE(ADD);   XREG:=TOS+JSTL;      <<C0.00>>03956000
        TOS:=PCBX(XREG).(8:8);       <<$STDLIST LOG DEV # >>   <<C0.00>>03958000
        EXCHANGEDB(14);              <<TO L D T >>             <<C0.00>>03960000
        TOS _ LDT.(8:8);             <<ENTRY SIZE>>                     03962000
        XREG:=TOS*TOS+2;                                       <<C0.00>>03964000
        RECSIZE:=LDT(XREG).(0:8)&LSL(1);       <<RECSIZE IN BYTES>>     03966000
        EXCHANGEDB(0); <<TO STACK>>                            <<C0.00>>03968000
        GO WJX;                                                <<C0.00>>03970000
      END;                                                     <<C0.00>>03972000
    FN:=FOPEN(FILEN,,4);                                       <<C0.00>>03974000
    IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);GO FINI;END;   <<C0.00>>03976000
    GO C;                                                      <<C0.00>>03978000
                                                               <<C0.00>>03980000
STACKDUMP':                                                    <<C0.00>>03982000
    ERRORON;                                                   <<C0.00>>03984000
    BOUNDS:=CHEK(ERRCODE&LSL(6)+5,4,DOUBLE(%253),,%17);        <<C0.00>>03986000
    IF NOT VAR&LSR(2) THEN ADUM:=@DUMMY;   <<NO IDNUM>>        <<C0.00>>03988000
    CC:=2;                                 <<CCE>>             <<C0.00>>03990000
    IF NOT VAR&LSR(3) THEN                 <<NO FILEN>>        <<C0.00>>03992000
      BEGIN                                                    <<C0.00>>03994000
        CC:=1;                                                 <<C0.00>>03996000
        IDNUMBER:=72;                      <<"BAD FILE #">>    <<C0.00>>03998000
        GO FINI;                                               <<C0.00>>04000000
      END;                                                     <<C0.00>>04002000
    FN:= FILEN(0);                         <<GET FILE NUMBER>> <<C0.00>>04004000
    AF:=FALSE;                                                 <<C0.00>>04006000
                                                               <<C0.00>>04008000
C:                                                             <<C0.00>>04010000
    FGETINFO(FN,,FOPTIONS,AOPTIONS,RECSIZE);                   <<C0.00>>04012000
    IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);GO FINI;END;   <<C0.00>>04014000
    RECSIZE:= IF FOPTIONS.(13:1) THEN -RECSIZE                 <<C0.00>>04016000
              ELSE RECSIZE&LSL(1);                             <<C0.00>>04018000
WJX:                                                           <<C0.00>>04020000
    IF RECSIZE>256 OR RECSIZE<32 THEN                          <<C0.00>>04022000
      BEGIN                                                    <<C0.00>>04024000
D:                                                             <<C0.00>>04026000
        CC:=0;   GO FINI;                                      <<C0.00>>04028000
      END;                                                     <<C0.00>>04030000
    PUSH(Q,DL);ASSEMBLE(XCH,SUB;DUP,STAX);TOS:=PCBX(X-2);      <<C0.00>>04032000
    X:=TOS-TOS+12;                                             <<C0.00>>04034000
    QIN := PCBX(X - 9);                                        <<04534>>04038000
     QIN := PCBX(X-9);                                         <<04699>>04040000
    PUSH(Q); V:=IF ENVIR=0 THEN -1 ELSE 0;                     <<C0.00>>04042000
   WHILE ((V:=V+1) <= ENVIR) AND (S0 > QIN) DO                 <<02341>>04044000
    BEGIN                                                      <<C0.00>>04046000
      ASSEMBLE(DUP,DUP);                                       <<C0.00>>04048000
      SR:=TOS-4;                                               <<C0.00>>04050000
      TOS:=TOS-ST(TOS);                                        <<C0.00>>04052000
    END;                                                       <<C0.00>>04054000
    QR:=TOS; UBOUND:=SR;                                       <<C0.00>>04056000
    FLAGS := IF NOT(VAR&LSR(1)) THEN FALSE ELSE FLAG;                   04058000
    IF ENVIR=0 THEN                                            <<C0.00>>04060000
      BEGIN                                                    <<C0.00>>04062000
        TITLE;                                                 <<C0.00>>04064000
        PUSH(Q); PX:=TOS;                                      <<C0.00>>04066000
        REGIST(PX,BOUTB((RECSIZE-32)&LSR(1)));                 <<C0.00>>04068000
        WRITE((RECSIZE+2)&LSR(1)+16);                          <<C0.00>>04070000
        MARKER(PX,BOUTB((RECSIZE-60)&LSR(1)));                 <<C0.00>>04072000
        WRITE((RECSIZE+2)&LSR(1)+31);                          <<C0.00>>04074000
        IF PF THEN PRINT(OUTB,0,%201) ELSE FWRITE(FN,OUTB,0,%201);      04076000
        IF <> THEN FILERR;                                     <<C0.00>>04078000
        IF NOT FLAGS.(14:1) THEN TRCBCK;                       <<02341>>04080000
      END;                                                     <<C0.00>>04082000
    IF NOT VAR THEN GO FINI;      <<ARRAY SELEC MISSING>>      <<C0.00>>04084000
    IF PF THEN PRINT(OUTB,0,%201) ELSE FWRITE(FN,OUTB,0,%201); <<C0.00>>04086000
    IF <> THEN FILERR;                                         <<C0.00>>04088000
    CLEARBUF;                                                  <<C0.00>>04090000
    PUSH(Q); TOS:=@SELEC; TOS:=TOS-TOS;                        <<C0.00>>04092000
    LIM:=(TOS-4)&LSR(1);                                       <<C0.00>>04094000
NEXT:                                                          <<C0.00>>04096000
    CURSELX:=CURSELX+1;                                        <<C0.00>>04098000
    IF CURSELX>LIM THEN GOTO FINI;                             <<C0.00>>04100000
    TOS:=SELEC(CURSELX);                                       <<C0.00>>04102000
    ASSEMBLE(DDUP);                                            <<C0.00>>04104000
    IF TOS=%177777D THEN GOTO FINI;                            <<C0.00>>04106000
                                                               <<C0.00>>04108000
    <<DECODE ENTRY>>                                           <<C0.00>>04110000
                                                               <<C0.00>>04112000
    ASSEMBLE(TEST);                                            <<C0.00>>04114000
    IF >= THEN                                                 <<C0.00>>04116000
      BEGIN                                                    <<C0.00>>04118000
        COUNT:=TOS;                                            <<C0.00>>04120000
        DBAD:=TOS;                                             <<C0.00>>04122000
        DUMP(0);                                               <<C0.00>>04124000
      END                                                      <<C0.00>>04126000
      ELSE BEGIN                                               <<C0.00>>04128000
        ASSEMBLE(DUP);                                         <<C0.00>>04130000
        V:=TOS;                                                <<C0.00>>04132000
        CASE V.(0:3) OF BEGIN                                  <<C0.00>>04134000
          <<EMPTY>>;                                           <<C0.00>>04136000
          <<EMPTY>>;                                           <<C0.00>>04138000
          <<EMPTY>>;                                           <<C0.00>>04140000
          <<EMPTY>>;                                           <<C0.00>>04142000
          BEGIN                                                <<C0.00>>04144000
            CHEK(ERRCODE&LSL(6)+5,%44,,DOUBLE(2));      <<CAP>><<C0.00>>04146000
            ASSEMBLE(XCH); DSTX:=TOS;      <<EXTRA DS>>        <<C0.00>>04148000
            IF (DSTX:=PXDSEG(4,DSTX))=0 THEN                   <<C0.00>>04150000
              BEGIN                                            <<C0.00>>04152000
WS:                                                            <<C0.00>>04154000
                CC:=0;                      <<INVALID>>        <<C0.00>>04156000
                GO FINI;                                       <<C0.00>>04158000
              END;                                             <<C0.00>>04160000
            ASSEMBLE(DUP);                                     <<C0.00>>04162000
            DBAD:=(TOS LAND %17600)&LSL(2);       <<DB ADRESS>><<C0.00>>04164000
            COUNT:=(TOS LAND %177)&LSL(7);        <<COUNT TO BE OUTPUT>>04166000
            DUMP(4);                                           <<C0.00>>04168000
          END;                                                 <<C0.00>>04170000
          BEGIN                                                <<C0.00>>04172000
            <<CHECK CAP: PM CODE OR PROG HAS PM CAP>>          <<00512>>04174000
            IF STATUS.(0:1) <> 1 THEN                          <<00512>>04176000
            CHEK(ERRCODE&LSL(6)+5,%44,,DOUBLE(%100));          <<00512>>04178000
            ASSEMBLE(DUP);                                     <<C0.00>>04180000
            DBAD:=(TOS LAND %17600)&LSL(2);                    <<C0.00>>04182000
            COUNT:=(TOS LAND %177)&LSL(7);                     <<C0.00>>04184000
            DSTX:=TOS;                                         <<C0.00>>04186000
            IF DSTI'(DSTX&LSL(2)).(3:13) = 0 THEN                       04188000
             GOTO WS;       <<INVALID ENTRY>>                           04190000
            DUMP(4);                                           <<C0.00>>04192000
          END;                                                 <<C0.00>>04194000
          BEGIN     << Q >>                                    <<C0.00>>04196000
            COUNT:=TOS.(3:13);                                 <<C0.00>>04198000
            DBAD:=QR+TOS;                                      <<C0.00>>04200000
            DUMP(1);                                           <<C0.00>>04202000
          END;                                                 <<C0.00>>04204000
          BEGIN     << S >>                                    <<C0.00>>04206000
            COUNT:=TOS.(3:13);                                 <<C0.00>>04208000
            DBAD:=SR+TOS;                                      <<C0.00>>04210000
            DUMP(2);                                           <<C0.00>>04212000
          END;                                                 <<C0.00>>04214000
        END  <<CASE>>;                                         <<C0.00>>04216000
      END;                                                     <<C0.00>>04218000
    GO TO NEXT;                                                <<C0.00>>04220000
                                                               <<C0.00>>04222000
FINI:                                                          <<C0.00>>04224000
    IF AF THEN                                                 <<C0.00>>04226000
      BEGIN                                                    <<C0.00>>04228000
        FCLOSE(FN,0,0);                                        <<C0.00>>04230000
        IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);END;       <<C0.00>>04232000
      END;                                                     <<C0.00>>04234000
    STAT.(6:2):=CC;              <<CC IN RETURN>>              <<C0.00>>04236000
    ERROREXIT(ERRCODE&LSL(6)+5,0,0);       <<QUIT SYSTEM>>     <<C0.00>>04238000
END  <<PROCEDURES STACKDUMP & STACKDUMP'>>;                    <<C0.00>>04240000
                                                                        04242000
$CONTROL SEGMENT=MAIN                                                   04244000
                                                               <<B0.07>>04246000
END.  <<ABORTDUMP>>                                            <<00652>>04248000
