$CONTROL MAP,CODE,USLINIT                                               00010000
<< ABORTDUMP -- MODULE 58 >>                                   <<01070>>00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$CONTROL MAIN=ABORTDUMP,SEGMENT=ABORTDUMP                      <<00652>>00060000
$CONTROL PRIVILEGED                                                     00065000
          << >>                                                         00070000
          << A B O R T    APR 15,1976 >>                                00075000
          <<TRAP MECHANISM AND ABORT INTERFACE INTRINSICS>>             00080000
          << >>                                                         00085000
BEGIN                                                                   00090000
$INCLUDE INCLPCB5                                              <<06643>>00095000
EQUATE                                                                  00100000
         DSTB      =2,                                                  00105000
         SYSTEMSL  =0,                                                  00110000
         CCG       =0,                                                  00115000
         CCL       =1,                                                  00120000
         CCE       =2;                                                  00125000
INTEGER S0 = S-0;                                              <<06097>>00130000
INTEGER  STATUS    =Q-1,                                                00135000
         DELTAP    =Q-2,                                       <<06097>>00140000
         X         =X;                                                  00145000
LOGICAL  POINTER DSTL'=DSTB,                                            00150000
                 PCBL'=SYSPCBINDEX;                            <<06643>>00155000
INTEGER POINTER DSTI'=DSTB;                                    <<00652>>00160000
INTEGER POINTER                                                         00165000
   PCBI' = SYSPCBINDEX;                                        <<06643>>00170000
DEFINE   F         =ABSOLUTE#,                                          00175000
         LOG       =LOGICAL#,                                  <<03046>>00180000
         ASMB      =ASSEMBLE#,                                          00185000
         DUPLICATE =ASMB(DUP)#,                                         00190000
         TRIPLICATE=ASMB(DUP,DUP)#,                                     00195000
        PIX       = (CURPRC)#,                                 <<06643>>00200000
         TRAPSOFF  =PUSH(STATUS);TOS.(2:1)_0;SET(STATUS)#,              00205000
         DISABLE   =ASMB(SED 0)#,                                       00210000
         PDISABLE  =ASMB(PSDB)#,                               <<06097>>00215000
         PENABLE   =ASMB(PSEB)#,                               <<06097>>00220000
       SYSTEMFLAG=(6:1)#,                                      <<01549>>00225000
         LBITE     =( 0: 8)#,                                           00230000
         RBITE     =( 8: 8)#,                                           00235000
         TRAPFLD   =( 2: 1)#,                                           00240000
         CCFLD     =( 6: 2)#,                                           00245000
         CSTFIELD  =( 8: 8)#;                                           00250000
DEFINE CCODE = STATUS.CCFLD#;                                  <<06097>>00255000
<<TRAP DEFINITIONS>>                                           <<06097>>00260000
<<LOGICAL MAPPING INFORMATION>>                                <<06097>>00265000
DEFINE LOGICALMAPPING=ABSOLUTE(%1220)#,                        <<06097>>00270000
       MAPFLAG=(1:1)#; <<MAPFLAG IN STACK MARKER>>             <<06097>>00275000
EQUATE PROGSEGTYPE=14; <<SEG TYPE FROM LOGICALCST>>            <<06097>>00280000
$PAGE                                                                   00285000
ARRAY QARRAY(*) = Q+0;                                         <<*7758>>00290000
$INCLUDE INCLPXDL                                              <<*7758>>00295000
$INCLUDE INCLPXGT                                              <<*7758>>00300000
$INCLUDE INCLPXFT                                              <<*7758>>00305000
$INCLUDE INCLLDT5                                              <<07052>>00310000
          << >>                                                         00315000
          <<EXTERNAL PROCEDURES>>                                       00320000
          << >>                                                         00325000
                                                               <<01549>>00330000
INTEGER PROCEDURE CONVEXTLABELTODELTAP(EXTLABEL);              <<01549>>00335000
VALUE EXTLABEL;                                                <<01549>>00340000
INTEGER EXTLABEL;                                              <<01549>>00345000
OPTION EXTERNAL;                                               <<01549>>00350000
                                                               <<01549>>00355000
LOGICAL PROCEDURE RESETBREAKBITS(A,B);                         <<00.EB>>00360000
   VALUE      A,B;                                                      00365000
   INTEGER    A,B;                                                      00370000
   OPTION     EXTERNAL;                                                 00375000
LOGICAL PROCEDURE IOCONTROL(LDEV,FUNC);                                 00380000
   VALUE      LDEV,FUNC;                                                00385000
   INTEGER    LDEV,FUNC;                                                00390000
   OPTION     EXTERNAL;                                                 00395000
INTEGER PROCEDURE CSTCONV(CSTEN,PINX);                         <<06097>>00400000
  VALUE CSTEN,PINX;                                            <<06097>>00405000
  INTEGER CSTEN,PINX;                                          <<06097>>00410000
  OPTION EXTERNAL;                                             <<06097>>00415000
PROCEDURE SET'PSIF(PINX,FLAG);                                          00420000
   VALUE      PINX,FLAG;                                                00425000
   INTEGER    PINX;                                                     00430000
   LOGICAL    FLAG;                                                     00435000
   OPTION     EXTERNAL;                                                 00440000
PROCEDURE CLEAR'PSIF(PINX,FLAG);                                        00445000
   VALUE      PINX,FLAG;                                                00450000
   INTEGER    PINX;                                                     00455000
   LOGICAL    FLAG;                                                     00460000
   OPTION     EXTERNAL;                                                 00465000
PROCEDURE HELP;                                                         00470000
   OPTION     EXTERNAL;                                                 00475000
PROCEDURE FREEZE(EN,TYPE,PINX);                                         00480000
   VALUE      EN,TYPE,PINX;                                             00485000
   INTEGER    EN,TYPE,PINX;                                             00490000
   OPTION     EXTERNAL;                                                 00495000
PROCEDURE UNFREEZE(EN,TYPE,PINX);                                       00500000
   VALUE      EN,TYPE,PINX;                                             00505000
   INTEGER    EN,TYPE,PINX;                                             00510000
  OPTION EXTERNAL;                                                      00515000
          << >>                                                         00520000
PROCEDURE TERMINATE;                                                    00525000
  OPTION EXTERNAL;                                                      00530000
          << >>                                                         00535000
PROCEDURE SUDDENDEATH(N);                                               00540000
  VALUE N;LOGICAL N;OPTION EXTERNAL;                                    00545000
          << >>                                                         00550000
LOGICAL PROCEDURE EXCHANGEDB(IX);                                       00555000
  VALUE IX;LOGICAL IX;OPTION EXTERNAL;                                  00560000
          << >>                                                         00565000
LOGICAL PROCEDURE SETSYSDB;     OPTION EXTERNAL;                        00570000
          << >>                                                         00575000
PROCEDURE RESETDB(IX);                                                  00580000
  VALUE IX;LOGICAL IX;OPTION EXTERNAL;                                  00585000
          << >>                                                         00590000
PROCEDURE RESUMESOFTINT;                                       <<03046>>00595000
   OPTION EXTERNAL;                                            <<03046>>00600000
             << >>                                             <<03046>>00605000
LOGICAL PROCEDURE SETCRITICAL;                                          00610000
  OPTION EXTERNAL;                                                      00615000
          << >>                                                         00620000
PROCEDURE RESETCRITICAL(C);                                             00625000
  VALUE C;LOGICAL C;OPTION EXTERNAL;                                    00630000
          << >>                                                         00635000
PROCEDURE ERRORON;         OPTION EXTERNAL;                             00640000
          << >>                                                         00645000
PROCEDURE ERROREXIT(I,E,P);                                             00650000
  VALUE I,E,P;LOGICAL I,E,P;OPTION EXTERNAL;                            00655000
          << >>                                                         00660000
DOUBLE PROCEDURE CHEK(INT,FL,PARM,CAPM,OVM);                            00665000
  VALUE   INT,FL,PARM,CAPM,OVM;                                         00670000
  LOGICAL INT,FL,OVM;                                                   00675000
  DOUBLE  PARM,CAPM;                                                    00680000
  OPTION EXTERNAL,VARIABLE;                                             00685000
         << >>                                                 <<06097>>00690000
DOUBLE PROCEDURE CHEK'NOABORT(INT,FL,PARM,CAPM,OVM);           <<06097>>00695000
  VALUE INT,FL,PARM,CAPM,OVM;                                  <<06097>>00700000
  LOGICAL INT,FL,OVM;                                          <<06097>>00705000
  DOUBLE PARM,CAPM;                                            <<06097>>00710000
  OPTION EXTERNAL,VARIABLE;                                    <<06097>>00715000
         << >>                                                 <<06097>>00720000
LOGICAL PROCEDURE SYSTEM(PLABEL);                              <<06097>>00725000
  VALUE PLABEL; INTEGER PLABEL;                                <<06097>>00730000
  OPTION EXTERNAL;                                             <<06097>>00735000
          << >>                                                         00740000
LOGICAL PROCEDURE GETJCW;                                      <<U.RAO>>00745000
OPTION EXTERNAL;                                               <<U.RAO>>00750000
          << >>                                                         00755000
PROCEDURE SETJCW(W);                                                    00760000
  VALUE W;LOGICAL W;OPTION EXTERNAL;                                    00765000
          << >>                                                         00770000
PROCEDURE PROCFILE(PIN,B);                                              00775000
  VALUE PIN;LOGICAL PIN;BYTE ARRAY B;OPTION EXTERNAL;                   00780000
          << >>                                                         00785000
DOUBLE PROCEDURE LOGICALCST'(SEG'NR,PINX);                     <<06875>>00790000
  VALUE SEG'NR,PINX;                                           <<06097>>00795000
  INTEGER SEG'NR,PINX;                                         <<06097>>00800000
  OPTION EXTERNAL;                                             <<06097>>00805000
          << >>                                                         00810000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<02.EB>>00815000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<02.EB>>00820000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<02.EB>>00825000
      DST,IOTYPE;                                              <<02.EB>>00830000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<02.EB>>00835000
      DST,IOTYPE;                                              <<02.EB>>00840000
   OPTION VARIABLE,EXTERNAL;                                   <<02.EB>>00845000
PROCEDURE STACKDUMP(FL,ID,FLAGS,SELEC);                        <<C0.00>>00850000
BYTE ARRAY FL;LOGICAL FLAGS;INTEGER ID;DOUBLE ARRAY SELEC;     <<C0.00>>00855000
OPTION FORWARD,VARIABLE;                                       <<00652>>00860000
                                                               <<C0.00>>00865000
PROCEDURE MARKER(P,BOUTB);                                     <<C0.00>>00870000
VALUE P;INTEGER P;BYTE ARRAY BOUTB;                            <<C0.00>>00875000
OPTION FORWARD;                                                <<00652>>00880000
                                                               <<C0.00>>00885000
PROCEDURE REGIST(SX,BOUTB);                                    <<C0.00>>00890000
VALUE SX;INTEGER SX;BYTE ARRAY BOUTB;                          <<C0.00>>00895000
OPTION FORWARD;                                                <<00652>>00900000
                                                               <<C0.00>>00905000
INTEGER PROCEDURE PHYSICALCST(P,S);                            <<C0.00>>00910000
VALUE P,S;INTEGER P,S;    OPTION EXTERNAL;                     <<C0.00>>00915000
INTEGER PROCEDURE MAPPEDCSTTOPHYCST(MAPCST,PINX);              <<06097>>00920000
  VALUE MAPCST,PINX;                                           <<06097>>00925000
  INTEGER MAPCST,PINX;                                         <<06097>>00930000
  OPTION EXTERNAL;                                             <<06097>>00935000
                                                               <<C0.00>>00940000
PROCEDURE DEBUG;    OPTION EXTERNAL;                           <<C0.00>>00945000
LOGICAL PROCEDURE DMOVE'(DS,DI,N,LOC,D,NU);                    <<00652>>00950000
VALUE DS,DI,N,LOC,D,NU;                                        <<00652>>00955000
LOGICAL DS,D; INTEGER DI,N,LOC,NU;                             <<00652>>00960000
OPTION EXTERNAL;                                               <<00652>>00965000
                                                               <<00652>>00970000
LOGICAL PROCEDURE PXDSEG(FUNC,PARM);                           <<00652>>00975000
VALUE FUNC,PARM; LOGICAL FUNC,PARM;                            <<00652>>00980000
OPTION EXTERNAL;                                               <<00652>>00985000
                                                               <<00652>>00990000
INTRINSIC ASCII,FOPEN,FCLOSE,FGETINFO,FWRITE;                  <<00652>>00995000
INTRINSIC FCHECK,FCONTROL,PRINT;                               <<00652>>01000000
                                                               <<00652>>01005000
$PAGE                                                                   01010000
            << >>                                                       01015000
            << ABORT ROUTINE >>                                         01020000
            << >>                                                       01025000
<<MODE.(0:8) = NUMBER OF MARKERS TO BE DELETED.           >>   <<U.RAO>>01030000
<<MODE.(8:8) = TYPE OF ABORT                              >>   <<U.RAO>>01035000
<<   0 = INTERNAL INTERRUPT, HARDWARE OR SIMULATED.       >>   <<U.RAO>>01040000
<<       CODE = TYPE OF INTERNAL INTERRUPT.               >>   <<U.RAO>>01045000
<<          0 = ?                                         >>   <<U.RAO>>01050000
<<          1 = INTEGER OVERFLOW                          >>   <<U.RAO>>01055000
<<          2 = FLOATING POINT OVERFLOW                   >>   <<U.RAO>>01060000
<<          3 = FLOATING POINT UNDERFLOW                  >>   <<U.RAO>>01065000
<<          4 = INTEGER DIVIDE BY ZERO                    >>   <<U.RAO>>01070000
<<          5 = FLOATING POINT DIVIDE BY ZERO             >>   <<U.RAO>>01075000
<<          6 = PRIVILEGED MODE INSTRUCTION TRAP          >>   <<U.RAO>>01080000
<<          7 = UNIMPLEMENTED INSTRUCTION TRAP            >>   <<U.RAO>>01085000
<<          8 = EXTENDED PRECISION OVERFLOW               >>   <<U.RAO>>01090000
<<          9 = EXTENDED PRECISION UNDERFLOW              >>   <<U.RAO>>01095000
<<         10 = EXTENDED PRECISION DIVIDE BY ZERO         >>   <<U.RAO>>01100000
<<         11 = DECIMAL OVERFLOW                          >>   <<U.RAO>>01105000
<<         12 = INVALID ASCII DIGIT IN DECIMAL INSTRUCTION>>   <<U.RAO>>01110000
<<         13 = INVALID DECIMAL DIGIT                     >>   <<U.RAO>>01115000
<<         14 = INVALID SOURCE WORD COUNT                 >>   <<U.RAO>>01120000
<<         15 = INVALID DECIMAL OPERAND LENGTH            >>   <<U.RAO>>01125000
<<         16 = DECIMAL DIVIDE BY ZERO                    >>   <<U.RAO>>01130000
<<         17 = STT UNCALLABLE                            >>   <<U.RAO>>01135000
<<         18 UNUSED                                      >>   <<U.RAO>>01140000
<<         19 UNUSED                                      >>   <<U.RAO>>01145000
<<         20 = STACK OVERFLOW                            >>   <<U.RAO>>01150000
<<         21 UNUSED                                      >>   <<U.RAO>>01155000
<<         22 = BAD STACK MARKER                          >>   <<U.RAO>>01160000
<<         23 = ILLEGAL ADDRESS (NO SUCH MEMORY ADDRESS)  >>   <<U.RAO>>01165000
<<         24 = BOUNDS VIOLATION (TYPICALLY USER ERROR)   >>   <<U.RAO>>01170000
<<         25 = NON-RESPONDING MODULE                     >>   <<U.RAO>>01175000
<<         26 UNUSED                                      >>   <<U.RAO>>01180000
<<         27 UNUSED                                      >>   <<U.RAO>>01185000
<<         28 UNUSED                                      >>   <<U.RAO>>01190000
<<         29 = STACK UNDERFLOW                           >>   <<U.RAO>>01195000
<<         30 = CST VIOLATION                             >>   <<U.RAO>>01200000
<<         31 = STT VIOLATION                             >>   <<U.RAO>>01205000
<<MODE.(8:8) = 1 => INTRINSIC ERROR                           ><<U.RAO>>01210000
<<   CODE = INTRINEXIT, DEFINED AS                            ><<U.RAO>>01215000
<<         10:6 = NUMBER OF PARAMETER WORDS                   ><<U.RAO>>01220000
<<         0:10 = INTRINSIC NUMBER                            ><<U.RAO>>01225000
<<   PARAM = TYPE OF ERROR                                    ><<U.RAO>>01230000
<<         1 = ILLEGAL DB REGISTER (SPLIT STACK NOT ALLOWED   ><<U.RAO>>01235000
<<         2 = ILLEGAL CAPABILITY (INSUFFICIENT CAPABILITY)   ><<U.RAO>>01240000
<<         3 = OMITTED PARAMETER (REQUIRED PARM FOR OPT. VAR.)><<U.RAO>>01245000
<<         4 = INCORRECT S REGISTER (NOT ENOUGH STACK)        ><<U.RAO>>01250000
<<         5 = PARAMETER ADDRESS VIOLATION                    ><<U.RAO>>01255000
<<         6 = PARAMETER END ADDRESS VIOLATION                ><<U.RAO>>01260000
<<         7 = ILLEGAL PARAMETER (?)                          ><<U.RAO>>01265000
<<         8 = PARAMETER VALUE INVALID                        ><<U.RAO>>01270000
<<         9 = INCORRECT Q REGISTER                           ><<U.RAO>>01275000
<<MODE.(8:8) = 2 => QUIT CALL                                 ><<U.RAO>>01280000
<<   CODE = 0                                                 ><<U.RAO>>01285000
<<   PARAM = USER SUPPLIED QUIT NUMBER                        ><<U.RAO>>01290000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 18, PROCESS QUIT>>     <<U.RAO>>01295000
<<MODE.(8:8) = 3 => QUITPROG CALL                             ><<U.RAO>>01300000
<<   CODE = 0                                                 ><<U.RAO>>01305000
<<   PARAM = USER SUPPLIED QUIT NUMBER                        ><<U.RAO>>01310000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 19, PROGRAM QUIT>>     <<U.RAO>>01315000
<<MODE.(8:8) = 4 => STACK OVERFLOW IN DATASEG                 ><<U.RAO>>01320000
<<   CODE & PARAM IGNORED.                                    ><<U.RAO>>01325000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 20, STACK OVERFLOW>>   <<U.RAO>>01330000
<<MODE.(8:8) = 5 => HARD KILL FROM ABORTPROG (:ABORT, ETC.)   ><<U.RAO>>01335000
<<   CODE & PARAM IGNORED.                                    ><<U.RAO>>01340000
<<   MAPPED INTO INTERNAL INTERRUPT MSG 21, PROGRAM KILLED>>   <<U.RAO>>01345000
            << ABORT:PROCESS LOC:LIBRARY LOC:MESSAGE  >>                01350000
            <<  CR  :SYSPROC LOC:LIBRARY LOC:MESSAGE  >>                01355000
            << >>                                                       01360000
PROCEDURE ABORT(MODE,CODE,PARAM);                                       01365000
  VALUE   MODE,CODE,PARAM;                                              01370000
  LOGICAL MODE,CODE,PARAM;                                              01375000
  OPTION  PRIVILEGED,UNCALLABLE;                                        01380000
  BEGIN                                                                 01385000
                                                               <<02.EB>>01390000
          EQUATE                                                        01395000
                     PCBLINK=5,                                         01400000
                     PCBSYS =9 ,                                        01405000
                     SML   =PCBSYS-PCBLINK,                             01410000
                     LIBRX=0,      <<LOC>>                              01415000
                     PROCX=4,                                           01420000
                     PV  =1,                                            01425000
                     CSTL=2,                                            01430000
                     TYPL=3,                                            01435000
                     PROGN=3,                                           01440000
                     STOP ="..",   <<SPEC CHAR>>                        01445000
                     COLON="::",                                        01450000
                     ASTER="**",                                        01455000
                     QUEST="??",                                        01460000
                     PERCENT="%%",                                      01465000
                     PCB2 = 2,                                          01470000
                     BLANK="  ",                               <<02.EB>>01475000
                     MISCSET=3,                                <<02.EB>>01480000
                     PGMERRSET=4,                              <<02.EB>>01485000
                     INTRINSET=5,                              <<02.EB>>01490000
                     RUNTIMESET=6,                             <<02.EB>>01495000
                     FSYSSET=8,                                <<02.EB>>01500000
                     LOADSET=9,                                <<02.EB>>01505000
                     CREATESET=10,                             <<02.EB>>01510000
                     ACTIVATESET=11,                           <<02.EB>>01515000
                     SUSPENDSET=12,                            <<02.EB>>01520000
                     MYCOMMANDSET=13,                          <<02.EB>>01525000
                     LOCKGLORINSET=14,                         <<02.EB>>01530000
                     PARAMSG=15,                               <<02.EB>>01535000
                     FS=FSYSSET,                               <<02.EB>>01540000
                     L=LOADSET,                                <<02.EB>>01545000
                     C=CREATESET,                              <<02.EB>>01550000
                     A=ACTIVATESET,                            <<02.EB>>01555000
                     S=SUSPENDSET,                             <<02.EB>>01560000
                     M=MYCOMMANDSET,                           <<02.EB>>01565000
                     LK=LOCKGLORINSET;                         <<02.EB>>01570000
          DEFINE     SIGNFLD=(0:1)#,                                    01575000
                     IFLD=(0:10)#,     <<PARAMETERS>>                   01580000
                     RSOFLD=(3:1)#,                                     01585000
                     PCBDSTF=(1:10)#,  <<PCB>>                          01590000
                     PCBFTHF=(0:8)#,                                    01595000
                     PCBSYSF=(6:1)# ,                                   01600000
                     PCBSOMF=(6:3)#,                                    01605000
                     PFLD=(2:14)#;     <<SM>>                           01610000
                                                               <<03046>>01615000
          DEFINE     INSTR'TRAP= TYPE=0 AND ((CODE>16 LAND     <<03046>>01620000
                                 CODE<>20) OR CODE = 6 OR      <<03046>>01625000
                                 CODE=7) #,                    <<03046>>01630000
                     ARITH'TRAP= TYPE=0 AND CODE<=16 AND       <<03046>>01635000
                                 CODE<>6 AND CODE <>7 #;       <<03046>>01640000
          BYTE ARRAY LIBR(0:11)=PB_"SYSLPUSLGRSL";                      01645000
          << >>                                                         01650000
          DOUBLE DBVALUE;                                               01655000
         INTEGER PCBPT;                                        <<06643>>01660000
         LOGICAL PROGFLAG,CRITFLAG',DBFIXED;                   <<06643>>01665000
          INTEGER I,J,K,BP,WP,LN,TYPE;                                  01670000
          INTEGER JMIN,PHY,CSTX,PX,T,PPP,LTYP;                          01675000
          INTEGER DBSAVE,PLAB,STATX,XX;                                 01680000
          INTEGER PIN,PINX,CNT,LIBX;                           <<06664>>01685000
INTEGER PXGLOB=T;                                              <<06097>>01690000
          INTEGER ARRAY STAK(*)=DB+0;                                   01695000
          INTEGER ARRAY STACK(*)=Q+0;                                   01700000
          ARRAY QARRAY(*) = Q+0;                               <<06664>>01705000
          LOGICAL PXFIXEDLOC;                                  <<06664>>01710000
          LOGICAL INDEX;                                       <<06664>>01715000
          INTEGER PCBGLOBLOC;                                  <<06664>>01720000
          ARRAY ERROR(0:5)=Q;                                           01725000
          ARRAY LOC(0: 7)=Q;                                            01730000
          ARRAY MSG(0:50)=Q;                                            01735000
          BYTE ARRAY BMSG(*)=MSG;                                       01740000
          BYTE ARRAY NAME(*)=MSG(20);                                   01745000
$PAGE                                                                   01750000
<<VARIABLES FOR USER TRAPS>>                                   <<06097>>01755000
INTEGER STK'POSITION = J;                                      <<06097>>01760000
INTEGER NUM'PARMS = K;                                         <<06097>>01765000
INTEGER CODE' = WP;                                            <<06097>>01770000
                                                               <<06097>>01775000
<<VARIABLES FOR STACK MARKER TRACE>>                           <<06097>>01780000
INTEGER LOC'POSITION = K;                                      <<06097>>01785000
                                                               <<C0.00>>01790000
<<VARIABLE FOR STACK ABORT>>                                   <<C0.00>>01795000
ARRAY PCBX(*)=Q+0;                                             <<C0.00>>01800000
LOGICAL STDF,JOBTYPE=CRITFLAG',RWF=PROGFLAG;                   <<06643>>01805000
INTEGER DBGCST=WP,DBGDP=LN;                                    <<C0.00>>01810000
LOGICAL SYSCST;                                                <<C0.00>>01815000
INTEGER BASE=PIN,QIN=CNT,INX=JMIN;                             <<C0.00>>01820000
DOUBLE ARRAY DUMP(*)=MSG(0);                                   <<C0.00>>01825000
INTEGER BASES;                                                 <<C0.00>>01830000
ARRAY WDUMP(*)=MSG(0);                                         <<C0.00>>01835000
<<VARIABLES FOR ABORT MESSAGE>>                                <<C+.09>>01840000
INTEGER                                                        <<02.EB>>01845000
   PARAM' = I,                                                 <<02.EB>>01850000
   INTRINDEX = J,                                              <<02.EB>>01855000
   TABLENO = K,                                                <<02.EB>>01860000
   MSGNO = BP;                                                 <<02.EB>>01865000
                                                                        01870000
BYTE ARRAY INTRIN(*) = PB :=                                   <<02.EB>>01875000
                                                               <<02.EB>>01880000
<<      0  1  2  3  4  5  6  7  8  9  >>                       <<02.EB>>01885000
                                                               <<02.EB>>01890000
<< 0 >> 0,FS,FS,FS,FS,FS,FS,FS, 0,FS,                          <<02.EB>>01895000
<<10 >>FS,FS,FS,FS,FS,FS,FS,FS,FS,FS,                          <<02.EB>>01900000
<<20 >>FS, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01905000
<<30 >> 0, 0, 0, 0,LK, 0, 0, 0, 0, 0,                          <<02.EB>>01910000
<<40 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01915000
<<50 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01920000
<<60 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01925000
<<70 >> 0, M, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01930000
<<80 >> L, L, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01935000
<<90 >> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01940000
<<100>> C, 0, 0, S, A, 0, 0, 0, 0, 0,                          <<02.EB>>01945000
<<110>> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,                          <<02.EB>>01950000
<<120>> C;                                                     <<02.EB>>01955000
                                                               <<02.EB>>01960000
ARRAY INTRIN'(*) = INTRIN;                                     <<02.EB>>01965000
                                                               <<02.EB>>01970000
                                                               <<06097>>01975000
          << >>                                                         01980000
          <<INIT BUFFER AND BYTE POINTER>>                              01985000
    SUBROUTINE INITBUF;                                                 01990000
      BEGIN                                                             01995000
          MSG _ BLANK;                                                  02000000
          MOVE MSG(1) _ MSG,(40);                                       02005000
          BP_2;                                                         02010000
      END;                                                              02015000
                                                                        02020000
                                                                        02025000
          <<FORMAT SPECIAL CHARACTER>>                                  02030000
    SUBROUTINE CHAR(CH);                                                02035000
      VALUE    CH;                                                      02040000
      LOGICAL  CH;                                                      02045000
      BEGIN                                                             02050000
          BMSG(BP)_CH;                                                  02055000
          BP := BP + 1;                                                 02060000
      END;                                                              02065000
          <<CONVERT/FORMAT OCTAL NUMBER>>                               02070000
    SUBROUTINE FORMOCT(N);                                              02075000
      VALUE    N;                                                       02080000
      INTEGER  N;                                                       02085000
      BEGIN                                                             02090000
          CHAR(PERCENT);                                                02095000
          LN_ASCII(N, 8,BMSG(BP));                                      02100000
          IF LN=0 THEN LN_1;                                            02105000
          MOVE BMSG(BP)_BMSG(BP+6-LN),(6);                              02110000
          BP := BP + LN;                                                02115000
      END;                                                              02120000
          <<FORMAT   (SEG #).(P-PB LOC) >>                              02125000
    SUBROUTINE FORMLOC(IX);                                             02130000
      VALUE    IX;                                                      02135000
      LOGICAL  IX;                                                      02140000
      BEGIN                                                             02145000
<<IF MARKER INFO EXISTS FOR PROGFILE OR>>                      <<06097>>02150000
<<NOT EXECUTING PROGRAM THEN INSERT    >>                      <<06097>>02155000
<<LOG SEG # ELSE ?                     >>                      <<06097>>02160000
<<IF DELTA P INFO EXISTS THEN INSERT IT>>                      <<06097>>02165000
          CHAR(STOP);                                                   02170000
          IF LOC(IX)<>0 OR NOT PROGFLAG                                 02175000
               THEN  FORMOCT(LOC(IX+CSTL))                              02180000
               ELSE  CHAR(QUEST);                                       02185000
          CHAR(STOP);                                                   02190000
          IF LOC(IX)<>0                                                 02195000
               THEN  FORMOCT(LOC(IX+PV)-1)                              02200000
               ELSE  CHAR(QUEST);                                       02205000
      END;                                                              02210000
          <<FORMAT PROCESS LOCATION  :(FILE).(SEG #).(P-PB LOC) >>      02215000
    SUBROUTINE PROCLOC;                                                 02220000
      BEGIN                                                             02225000
<<INSERT PROGFILE NAME, SEG #, AND DELTA P >>                  <<06097>>02230000
          CHAR(COLON);                                                  02235000
          MOVE BMSG(BP) _ NAME,(CNT);                                   02240000
          NAME _ BLANK;                                                 02245000
          MOVE NAME(1) _ NAME,(CNT);                                    02250000
          BP := BP + CNT;                                               02255000
          FORMLOC(PROCX);                                               02260000
      END;                                                              02265000
                                                                        02270000
                                                                        02275000
          <<FORMAT PROCREATED PROCESS  :*XLIB.(SEG #).(P-PB LOC)  >>    02280000
                                                                        02285000
    SUBROUTINE PRCRLOC;                                                 02290000
      BEGIN                                                             02295000
<<INSERT * SL TYPE, SEG #, AND DELTA P>>                       <<06097>>02300000
          CHAR(COLON);                                                  02305000
          CHAR(ASTER);                                                  02310000
          MOVE BMSG(BP)_LIBR(LOC(PROCX+TYPL)&LSL(2)),(4);               02315000
          BP := BP + 4;                                                 02320000
          FORMLOC(PROCX);                                               02325000
      END;                                                              02330000
                                                                        02335000
                                                                        02340000
          <<FORMAT LIBRARY LOCATION  : SLIB.(SEG #).(P-PB LOC) >>       02345000
                                                                        02350000
    SUBROUTINE LIBRLOC;                                                 02355000
      BEGIN                                                             02360000
<<INSERT SL TYPE, SEG #, AND DELTA P>>                         <<06097>>02365000
          IF LOC(LIBRX)=0 THEN RETURN;                                  02370000
          CHAR(COLON);                                                  02375000
          MOVE BMSG(BP)_LIBR(LOC(LIBRX+TYPL)&LSL(2)),(4);               02380000
          BP := BP + 4;                                                 02385000
          FORMLOC(LIBRX);                                               02390000
      END;                                                              02395000
                                                                        02400000
                                                                        02405000
          <<KILL PROGRAM PROCESS STRUCTURE>>                            02410000
                                                                        02415000
   SUBROUTINE KILLPROG;                                                 02420000
     BEGIN                                                              02425000
         IF (INTEGER(PROCSTATE).PTYPEFIELD) = 0 THEN           <<06643>>02430000
          BEGIN                                                         02435000
           TOS := FATHERINFO/PCBSIZE;                          <<06643>>02440000
DADL:      PCBPT := TOS * PCBSIZE;                             <<06643>>02445000
           TOS := FATHERINFO/PCBSIZE;                          <<06643>>02450000
           IF INTEGER(PROCSTATE).PTYPEFIELD <> 1 THEN          <<06643>>02455000
            GOTO DADL;           <<NOT USER SON OF MAIN>>               02460000
           DEL;                                                         02465000
           SET'PSIF(PCBPT,%40);                                <<06643>>02470000
          END;                                                          02475000
    END <<KILLPROG>> ;                                                  02480000
                                                                        02485000
INTEGER SUBROUTINE NEXTSET(SETNO,MSGNO);                       <<02.EB>>02490000
   VALUE SETNO,MSGNO;                                          <<02.EB>>02495000
   INTEGER SETNO,MSGNO;                                        <<02.EB>>02500000
BEGIN << EXTRACTS BYTE FROM INTRIN ARRAY FOR INTRINSICS >>     <<02.EB>>02505000
                                                               <<02.EB>>02510000
NEXTSET := IF SETNO = INTRINSET THEN                           <<02.EB>>02515000
   IF LOGICAL(MSGNO) THEN INTRIN'(MSGNO &LSR(1)).(8:8)         <<02.EB>>02520000
   ELSE INTRIN'(MSGNO &LSR(1)).(0:8) ELSE                      <<02.EB>>02525000
      << GET LEFT OR RIGHT BYTE FROM ARRAY >>                  <<02.EB>>02530000
   IF SETNO = LOADSET THEN FSYSSET ELSE                        <<02.EB>>02535000
   IF SETNO = CREATESET THEN LOADSET ELSE 0;                   <<02.EB>>02540000
                                                               <<02.EB>>02545000
END; << NEXTSET >>                                             <<02.EB>>02550000
                                                                        02555000
$PAGE                                                                   02560000
     << >>                                                     <<06097>>02565000
     TRAPSOFF;                                                 <<06097>>02570000
         PINX := PCBPT := CURPRC;                              <<06643>>02575000
     PINX := PIX;                                              <<06097>>02580000
         IF PROCSTATE.SYSTEMPROCFLAG THEN                      <<06643>>02585000
      SUDDENDEATH(310);     <<SYSTEM PROCESS>>                 <<06097>>02590000
         IF (CRITFLAG' := SETCRITICAL) THEN                    <<06643>>02595000
      SUDDENDEATH(311);     <<CRITICAL ABORT>>                 <<06097>>02600000
                                                               <<06097>>02605000
     DBFIXED := FALSE;                                         <<06097>>02610000
         IF DBXDSINFO.ABSDBFLAG THEN                           <<06643>>02615000
       BEGIN                                                   <<06097>>02620000
         DBFIXED := 1;                                         <<06097>>02625000
         PUSH( DB );   DBVALUE := TOS;                         <<06097>>02630000
         RESETDB(-1);                                          <<06097>>02635000
       END;                                                    <<06097>>02640000
     DBSAVE := EXCHANGEDB( 0 );  << SET DB TO STACK >>         <<06097>>02645000
                                                               <<06097>>02650000
     <<GET PCBX INFO & STACK BOUND>>                           <<06097>>02655000
     PXFIXED;    <<DB RELATIVE PXFIXED>>                       <<06664>>02660000
     TOS := PXFXQREG;               <<INITIAL Q>>              <<06664>>02665000
     PUSH(Q);                                                  <<06097>>02670000
     JMIN := TOS-TOS+8;             <<QI-Q+8>>                 <<06097>>02675000
     <<GET ERROR MESSAGE INDICES>>                             <<06097>>02680000
     ERROR := 0;                                               <<06097>>02685000
     MOVE ERROR(1) := ERROR,(5);                               <<06097>>02690000
     PXFXERRLEVEL:=0;                                          <<06664>>02695000
      INDEX := 0;                                              <<07361>>02700000
      WHILE (INDEX := INDEX+1)<=6 DO                           <<07361>>02705000
       BEGIN                                                   <<06097>>02710000
         TOS:=PXFXINTRERR;                                     <<06664>>02715000
         IF = THEN                                             <<06097>>02720000
           BEGIN                                               <<06097>>02725000
             DEL;                                              <<06097>>02730000
             GO TO PRL;                                        <<06097>>02735000
           END;                                                <<06097>>02740000
         PXFXINTRERR:=0;                                       <<06664>>02745000
          ERROR(INDEX-1):=TOS;                                 <<07361>>02750000
       END;                                                    <<06097>>02755000
PRL:                                                           <<06097>>02760000
    INITBUF;                                                   <<06097>>02765000
    TYPE:=MODE.RBITE;    <<GET TRAP TYPE>>                     <<06097>>02770000
    IF TYPE > 1 THEN GO TO ABORT'PIN;                          <<06097>>02775000
                                                               <<06097>>02780000
    <<TYPE=0 ARITHMETIC TRAP >>                                <<06097>>02785000
    <<TYPE=1 SYSTEM TRAP     >>                                <<06097>>02790000
                                                               <<06097>>02795000
    <<CHECK IF USER TRAP ARMED>>                               <<06097>>02800000
    IF TYPE=1 THEN PLAB:=PXFXSTRPPLBL                          <<06664>>02805000
    ELSE IF ARITH'TRAP THEN PLAB:=PXFXATRPPLBL                 <<06664>>02810000
         ELSE PLAB:=PXFXCODEPLBL;                              <<06664>>02815000
    IF PLAB = 0 THEN GO TO ABORT'PIN;                          <<06097>>02820000
    <<TRAP LABEL EXISTS>>                                      <<06097>>02825000
    CSTX:=LOGICAL(PLAB) LAND %100377; <<MAPFLAG,CST #>>        <<06097>>02830000
    IF TYPE = 0 THEN                                           <<06097>>02835000
      BEGIN << SET UP PARM TO USER TRAP PROCEDURE >>           <<06097>>02840000
        IF INSTR'TRAP THEN CODE':=CODE                         <<06097>>02845000
        ELSE IF ARITH'TRAP THEN                                <<06097>>02850000
               BEGIN << IS CODE ONE OF TRAPS SPECIFIED >>      <<06097>>02855000
                     << IN ARITH. MASK?                >>      <<06097>>02860000
                 IF CODE < 6 THEN                              <<06097>>02865000
                   I:=%40&LSR(CODE)                            <<06097>>02870000
                 ELSE                                          <<06097>>02875000
                   I:=%40&LSL(CODE-8);                         <<06097>>02880000
                 CODE':=LOGICAL(I) LAND                        <<06097>>02885000
                      PXFXATRPMASK;                            <<06664>>02890000
                 IF = THEN GO TO ABORT'PIN;                    <<06097>>02895000
               END                                             <<06097>>02900000
             ELSE GO TO ABORT'PIN;                             <<06097>>02905000
      END;                                                     <<06097>>02910000
                                                               <<06097>>02915000
    <<VALID ARITHMETIC TRAP OR SYSTRAP>>                       <<06097>>02920000
    <<SKIP SPECIFIED NUMBER OF STACK MARKERS>>                 <<06097>>02925000
    STK'POSITION:=I:=0;                                        <<06097>>02930000
    WHILE (I:=I+1) <= INTEGER(MODE.LBITE)                      <<06097>>02935000
      DO STK'POSITION:=STK'POSITION-STACK(STK'POSITION);       <<06097>>02940000
                                                               <<06097>>02945000
    <<CHECK STACK MARKER>>                                     <<06097>>02950000
    K:=STACK(STK'POSITION-1).RBITE; <<CST #>>                  <<06097>>02955000
    K.(0:1):=STACK(STK'POSITION-2).MAPFLAG; <<MAP FLAG>>       <<06097>>02960000
    MAPPEDCSTTOPHYCST(K,PINX);                                 <<06097>>02965000
    IF < THEN GO TO ABORT'PIN; <<INVALID CST #>>               <<06097>>02970000
    IF SYSTEM(K) THEN GO ABORT'PIN; <<TRAP IN SYSTEM SEG>>     <<06097>>02975000
                                                               <<06097>>02980000
    <<TRAP IN NON-SYSTEM SEG>>                                 <<06097>>02985000
                                                               <<06097>>02990000
    <<CHECK IF ARMED TRAP AND TRAPPED SEG >>                   <<06097>>02995000
    <<ARE IN PROPER MODE                  >>                   <<06097>>03000000
    <<INVALID IF TRAPPED SEG IS PRIV AND  >>                   <<06097>>03005000
    <<MODE FLAG IS NORMAL                 >>                   <<06097>>03010000
    IF STACK(STK'POSITION-1) < 0 THEN                          <<06097>>03015000
      BEGIN       <<TRAPPED SEG PRIVILEGED>>                   <<06097>>03020000
        IF TYPE = 1                                            <<06664>>03025000
          THEN TOS:= PXFXSYSTRP                                <<06664>>03030000
          ELSE IF ARITH'TRAP THEN TOS:=PXFXARITHTRP            <<06664>>03035000
          ELSE TOS:=PXFXCODETRP;                               <<06664>>03040000
        IF TOS = 1 THEN GO ABORT'PIN; <<NON-PRIV MODE TRAP>>   <<06097>>03045000
      END;                                                     <<06097>>03050000
                                                               <<06097>>03055000
    <<TRAPPED SEG AND TRAP PROCEDURE IN PROPER MODE>>          <<06097>>03060000
                                                               <<06097>>03065000
    <<MOVE TRAPPED SEG'S STACK MARKER TO MAKE ROOM>>           <<06097>>03070000
    <<FOR PARAMETERS TO BE PASSED TO TRAP PROCEDURE>>          <<06097>>03075000
    IF TYPE = 0                                                <<06097>>03080000
      THEN NUM'PARMS:=1 <<ARI TRAP>>                           <<06097>>03085000
      ELSE NUM'PARMS:=8;<<SYS TRAP>>                           <<06097>>03090000
    I:=0;                                                      <<06097>>03095000
    WHILE (I:=I+1) <= 4 DO                                     <<06097>>03100000
      BEGIN                                                    <<06097>>03105000
        STACK(STK'POSITION+NUM'PARMS):=STACK(STK'POSITION);    <<06097>>03110000
        STK'POSITION:=STK'POSITION-1;                          <<06097>>03115000
      END;                                                     <<06097>>03120000
    <<INSERT PASSED PARAMETERS>>                               <<06097>>03125000
    IF TYPE = 0                                                <<06097>>03130000
      THEN STACK(STK'POSITION+1):=CODE'                        <<06097>>03135000
      ELSE BEGIN                                               <<06097>>03140000
             STACK(STK'POSITION+1):=CODE;                      <<06097>>03145000
             STACK(STK'POSITION+2):=PARAM;                     <<06097>>03150000
             I:=2;                                             <<06097>>03155000
             WHILE (I:=I+1) <= NUM'PARMS                       <<06097>>03160000
               DO STACK(STK'POSITION+I):=ERROR(I-3);           <<06097>>03165000
           END;                                                <<06097>>03170000
                                                               <<06097>>03175000
    <<ADJUST TRAPPED SEG STACK MARKER INFO>>                   <<06097>>03180000
    XX:=STACK(-3);           <<XREG FROM ABORT MARKER>>        <<06097>>03185000
    STK'POSITION:=STK'POSITION+NUM'PARMS+3; <<TO MOVED MARKER>><<06097>>03190000
    TOS:=STACK(STK'POSITION); <<GET STATUS REG>>               <<06097>>03195000
    TOS.CCFLD:=CCL;           <<ADJUST STATUS >>               <<06097>>03200000
    DUPLICATE;                                                 <<06097>>03205000
    STACK(X):=TOS;            <<STORE ADJUSTED STATUS>>        <<06097>>03210000
    TOS.RSOFLD:=0;            <<CONSTRUCT STATUS FOR TRAP SEG>><<06097>>03215000
    TOS.RBITE:=CSTX.RBITE;    << . CLEAR RIGHT STACK OP>>      <<06097>>03220000
    STATX:=TOS;               << . INSERT TRAP SEG CST #>>     <<06097>>03225000
    STACK(X):=STACK(STK'POSITION+1)+NUM'PARMS;<<ADJUST DELTAQ>><<06097>>03230000
    <<ADJUST DELTAQ IN CALL TO ABORT MARKER>>                  <<06097>>03235000
    <<IN CASE WE ABORT BEFORE EXIT MARKER  >>                  <<06097>>03240000
    <<IS CONSTRUCTED BELOW                 >>                  <<06097>>03245000
    STACK(0):=-X;                                              <<06097>>03250000
                                                               <<06097>>03255000
    <<GET DELTA P FOR TRAP PROCEDURE>>                         <<06097>>03260000
         RESETCRITICAL(CRITFLAG');                             <<06643>>03265000
    PX:=CONVEXTLABELTODELTAP(PLAB);                            <<06097>>03270000
    IF LOGICALMAPPING                                          <<06097>>03275000
      THEN PX.MAPFLAG:=CSTX.(0:1); <<INSERT MAP FLAG>>         <<06097>>03280000
                                                               <<06097>>03285000
    <<BUILD EXIT MARKER                                        <<06097>>03290000
    STK'POSITION:=STK'POSITION+2;                              <<06097>>03295000
    STACK(STK'POSITION):=XX;      <<XREG>>                     <<06097>>03300000
    STACK(X:=X+1):=PX;            <<DELTA P>>                  <<06097>>03305000
    STACK(X:=X+1):=STATX;         <<STATUS>>                   <<06097>>03310000
    STACK(X:=X+1):=4;             <<DELTA Q>>                  <<06097>>03315000
    <<ADJUST Q REG>>                                           <<06097>>03320000
    PUSH(Q);                                                   <<06097>>03325000
    TOS:=TOS+X;                                                <<06097>>03330000
    SET(Q);                                                    <<06097>>03335000
                                                               <<06097>>03340000
    <<EXIT INTO USER'S TRAP PROCEDURE>>                        <<06097>>03345000
    ASSEMBLE(EXIT 0);                                          <<06097>>03350000
                                                               <<06097>>03355000
                                                               <<06097>>03360000
ABORT'PIN:                                                     <<06097>>03365000
    <<ABORT THE PIN --- NO TRAP>>                              <<06097>>03370000
                                                               <<06097>>03375000
    CLEAR'PSIF(PINX,%40);                                      <<06097>>03380000
    PXFXERRLEVEL:=1;                                           <<06664>>03385000
    PXFXAIP:=1;                                                <<06664>>03390000
    LIBX:=PXFXINITCST;                                         <<06664>>03395000
    LIBX.(0:1):=PXFXCSTEXPBIT;                                 <<06664>>03400000
    PROGFLAG:=FALSE;          <<INIT FLAG>>                    <<06097>>03405000
    PIN:=PINX/PCBSIZE;                                         <<06097>>03410000
    PROCFILE(PIN,NAME);  <<GET NAME OF PROG BEING EXECUTED>>   <<06097>>03415000
    IF = THEN                                                  <<06097>>03420000
      BEGIN   <<USER PROGRAM FOUND>>                           <<06097>>03425000
        PROGFLAG:=TRUE;                                        <<06097>>03430000
        SCAN NAME UNTIL %6440,1;                               <<06097>>03435000
        CNT:=TOS-@NAME;                                        <<06097>>03440000
        LIBX:=0;  <<INITIAL CST IS IN PROGRAM>>                <<06097>>03445000
      END;                                                     <<06097>>03450000
                                                               <<06097>>03455000
    <<SKIP STACK MARKERS>>                                     <<06097>>03460000
    STK'POSITION:=K:=I:=0;                                     <<06097>>03465000
    WHILE (I:=I+1) <= INTEGER(MODE.LBITE)                      <<06097>>03470000
      DO STK'POSITION:=STK'POSITION-STACK(STK'POSITION);       <<06097>>03475000
                                                               <<06097>>03480000
    K:=STACK(STK'POSITION-1).RBITE;    <<GET CST #>>           <<06097>>03485000
    K.(0:1):=STACK(STK'POSITION-2).MAPFLAG; <<MAP FLAG>>       <<06097>>03490000
    SYSCST:=SYSTEM(K);                 <<GET SYSTEM FLAG>>     <<06097>>03495000
                                                               <<06097>>03500000
    <<GET STACK MARKER INFO FROM 1ST NON-SYSTEM LIB SEG>>      <<06097>>03505000
    <<AND FOR FIRST PROGRAM SEG                        >>      <<06097>>03510000
    CSTX:=PX:=0;                                               <<06097>>03515000
    LOC(LIBRX):=LOC(PROCX):=0;                                 <<06097>>03520000
    LOC'POSITION:=LIBRX;                                       <<06097>>03525000
NEXT:                                                          <<06097>>03530000
    PPP:=STACK(STK'POSITION-2).PFLD;      <<DELTA P>>          <<06097>>03535000
    PHY:=STACK(STK'POSITION-1).RBITE;     <<CST #>>            <<06097>>03540000
    PHY.(0:1):= IF LOGICALMAPPING                              <<06097>>03545000
                  THEN STACK(STK'POSITION-2).MAPFLAG           <<06097>>03550000
                  ELSE 1;                                      <<06097>>03555000
    <<SAVE MARKER INFO IN ARRAY LOC>>                          <<06097>>03560000
    LOC(LOC'POSITION):=STK'POSITION;                           <<06097>>03565000
    LOC(X:=X+1):=PPP;                <<DELTA P>>               <<06097>>03570000
    TOS:=LOGICALCST'(PHY,PINX);                                <<06875>>03575000
    LOC(X:=X+1):=TOS;                <<LOG SEG #>>             <<06097>>03580000
    DUPLICATE;                                                 <<06097>>03585000
    LOC(X:=X+1):=TOS;                <<LIB SOURCE>>            <<06097>>03590000
    LTYP:=TOS;                       <<LIB SLURCE>>            <<06097>>03595000
    IF PHY <> CSTX THEN                                        <<06097>>03600000
      BEGIN                                                    <<06097>>03605000
        <<SAVE PHY AND PPP IF PHY HAS CHANGED SINCE>>          <<06097>>03610000
        <<LAST TRIP THRU THIS CODE                 >>          <<06097>>03615000
        CSTX:=PHY;                                             <<06097>>03620000
        PX:=PPP;                                               <<06097>>03625000
      END;                                                     <<06097>>03630000
    IF TYPE > 3 AND   <<STKOVERFLOW OR HARDKILL TRAP>>         <<06097>>03635000
       SYSTEM(PHY)    <<MARKER IS FOR SYSTEM SEG  >>           <<06097>>03640000
      THEN GO BUMP'STK'POSITION; <<SKIP MARKER>>               <<06097>>03645000
                                                               <<06097>>03650000
    IF PROGFLAG AND   <<PIN EXECUTING PROGRAM>>                <<06097>>03655000
       LTYP = PROGSEGTYPE <<MARKER IS FOR PROG SEG>>           <<06097>>03660000
      THEN GO CONT;   <<STOP SCANNING MARKERS>>                <<06097>>03665000
                                                               <<06097>>03670000
    IF PHY = LIBX     <<MARKER IS SAME AS INITIAL CST>>        <<06097>>03675000
      THEN GO CONT;   <<STOP SCANNING MARKERS>>                <<06097>>03680000
                                                               <<06097>>03685000
    LOC'POSITION:=PROCX; <<ADJUST POSITION IN ARRAY>>          <<06097>>03690000
                                                               <<06097>>03695000
BUMP'STK'POSITION:                                             <<06097>>03700000
    T:=STK'POSITION-STACK(STK'POSITION);                       <<06097>>03705000
    IF T >= STK'POSITION OR                                    <<06097>>03710000
       T < JMIN                                                <<06097>>03715000
      THEN GO TO OUTM;  <<GET OUT IF CURRENT MARKER IS BLOWN>> <<06097>>03720000
    STK'POSITION:=T;                                           <<06097>>03725000
    GO NEXT;                                                   <<06097>>03730000
                                                               <<06097>>03735000
OUTM:                                                          <<06097>>03740000
    <<BLOWN MARKER--USE INFO ALREADY GATHERED>>                <<06097>>03745000
    IF LOC'POSITION = 0   <<DURING SCAN FOR LIB SEG>>          <<06097>>03750000
      THEN LOC(LOC'POSITION+PV):=PX; <<DELTA P>>               <<06097>>03755000
    LOC'POSITION:=PROCX;                                       <<06097>>03760000
    LOC(LOC'POSITION):=0; <<NO PROGFILE INFO>>                 <<06097>>03765000
    IF NOT PROGFLAG THEN                                       <<06097>>03770000
      BEGIN             <<NOT EXECUTING PROGRAM>>              <<06097>>03775000
        <<USE INITIAL CST INFO>>                               <<06097>>03780000
        TOS:=LOGICALCST'(LIBX,PINX);                           <<06875>>03785000
        LOC(X:=X+2):=TOS;          <<LOG SEG #>>               <<06097>>03790000
        LOC(X:=X+1):=TOS;          <<LIB SOURCE>>              <<06097>>03795000
      END;                                                     <<06097>>03800000
    GO PRINTMSG;                                               <<06097>>03805000
    HELP;                                                      <<06097>>03810000
                                                               <<06097>>03815000
CONT:                                                          <<06097>>03820000
    IF LOC'POSITION <> 0                                       <<06097>>03825000
      THEN GO PRINTMSG;  <<FOUND ABORTED SEG>>                 <<06097>>03830000
    <<FOUND PROG SEG MARKER DURING SCAN FOR LIB SEG>>          <<06097>>03835000
    MOVE LOC(PROCX):=LOC(LIBRX),(PROCX);                       <<06097>>03840000
    LOC(LIBRX):=0;       <<NO LIB INFO>>                       <<06097>>03845000
                                                               <<06097>>03850000
PRINTMSG:                                                      <<06097>>03855000
                                                               <<06097>>03860000
<<  BUILD & PRINT ABORT MESSAGE >>                             <<02.EB>>03865000
                                                               <<02.EB>>03870000
MOVE BMSG := "ABORT ";                                         <<02.EB>>03875000
BP := 6;                                                       <<02.EB>>03880000
IF PROGFLAG THEN PROCLOC ELSE PRCRLOC;                         <<02.EB>>03885000
LIBRLOC;                                                       <<02.EB>>03890000
BMSG(BP) := 0;                                                 <<02.EB>>03895000
PRINT(MSG,0,0);                                                <<02.EB>>03900000
GENMSG(-1,@BMSG); << PRINT ABORT: ED.MPE.%0.%0 >>              <<02.EB>>03905000
IF TYPE = 3 THEN KILLPROG;                                     <<02.EB>>03910000
PARAM' := PARAM;                                               <<02.EB>>03915000
INTRINDEX := IF TYPE = 1 THEN 0 ELSE 6;                        <<02.EB>>03920000
TABLENO := IF TYPE = 1 THEN INTRINSET ELSE PGMERRSET;          <<02.EB>>03925000
MSGNO := IF TYPE = 0 THEN CODE ELSE IF TYPE = 1 THEN CODE.     <<02.EB>>03930000
   (0:10) ELSE TYPE +16;                                       <<02.EB>>03935000
IF TYPE=1 THEN  <<INTRINSIC ERROR>>                            <<U.RAO>>03940000
   SETJCW(%140000 LOR LOGICAL(MSGNO+1000))<<LOR INTRINSIC NO.>><<U.RAO>>03945000
ELSE IF TYPE = 0 THEN  <<INTERNAL INT. ERROR>>                 <<U.RAO>>03950000
   SETJCW(%140000 LOR LOGICAL(MSGNO))   <<MASK LOR ERROR NO.>> <<U.RAO>>03955000
ELSE IF TYPE = 5 THEN   <<PROGRAM KILLED, NO NUMBER>>          <<U.RAO>>03960000
   SETJCW(%140000)                                             <<U.RAO>>03965000
ELSE   <<TYPE IS QUIT OR QUITPROG>>                            <<U.RAO>>03970000
   SETJCW(%100000 LOR PARAM);  <<MASK LOR USER PARAM>>         <<U.RAO>>03975000
DO BEGIN                                                       <<02.EB>>03980000
   GENMSG(MISCSET,TABLENO,%10000,MSGNO,,,,,,,,,%100000);       <<02.EB>>03985000
   GENMSG(TABLENO,MSGNO,,,,,,,,,,,IF PARAM' <> 0 THEN          <<02.EB>>03990000
      %100000 ELSE 0);                                         <<02.EB>>03995000
   IF PARAM' <> 0 THEN GENMSG(MISCSET,PARAMSG,%10000,          <<02.EB>>04000000
      PARAM'); << PRINT PARAM = >>                             <<02.EB>>04005000
   TABLENO := NEXTSET(TABLENO,MSGNO);                          <<02.EB>>04010000
   PARAM' := ERROR(INTRINDEX).(0:8); << INTRIN PARAM >>        <<02.EB>>04015000
   MSGNO :=  ERROR(INTRINDEX).(8:8); << NEXT MSGNO >>          <<02.EB>>04020000
   IF MSGNO < 20 THEN TABLENO := RUNTIMESET;                   <<02.EB>>04025000
   INTRINDEX := INTRINDEX +1;                                  <<02.EB>>04030000
END UNTIL (ERROR(INTRINDEX -1) = 0 OR INTRINDEX > 5);          <<02.EB>>04035000
RESETCRITICAL(0);                                              <<02.EB>>04040000
                                                               <<02.EB>>04045000
                                                               <<06097>>04050000
<<  ABORT STACK DUMP MECHANISM  >>                             <<06097>>04055000
                                                               <<06097>>04060000
<<GET FLAGS FROM PXFIXED AREA>>                                <<06097>>04065000
PXFIXED;                                                       <<06664>>04070000
RWF:=NOT PXFXRW;                       <<READ/WRITE ACCESS>>   <<06664>>04075000
QIN:=PXFXQREG;                         <<Q INITIAL>>           <<06664>>04080000
                                                               <<06097>>04085000
<<GET FLAGS FROM PXGLOB AREA>>                                 <<06097>>04090000
PXGLOBAL;                                                      <<06664>>04095000
STDF:=PXG'STKDUMPFLAGS;                <<STACK DUMP FLAGS>>    <<06664>>04100000
JOBTYPE:=PXG'INTERACTIVE;              <<INTERACTIVE FLAG>>    <<06664>>04105000
                                                               <<06097>>04110000
<<DO STACK DUMP ANALYSIS IF --         >>                      <<06097>>04115000
<< .NOT HARD KILL                      >>                      <<06097>>04120000
<< .STACK DUMP ARMED                   >>                      <<06097>>04125000
<< .ABORTING SEG NOT SYSTEM SEG        >>                      <<06097>>04130000
IF (TYPE<=4) LAND STDF.(10:1) LAND NOT SYSCST THEN             <<06097>>04135000
  BEGIN                        <<ARMED>>                       <<06097>>04140000
    <<OUTPUT HEADER=TITLE,REGISTERS,MARKERS>>                  <<06097>>04145000
                                                               <<06097>>04150000
    <<HEADER>>                                                 <<06097>>04155000
    INITBUF;                                                   <<06097>>04160000
    MOVE BMSG:="*** ABORT STACK ANALYSIS ***";                 <<06097>>04165000
    PRINT(MSG,-28,0); INITBUF;                                 <<06097>>04170000
    PRINT(MSG,0,%201);                                         <<06097>>04175000
                                                               <<06097>>04180000
    <<SKIP SPECIFIED # STACK MARKERS>>                         <<06097>>04185000
    PUSH(Q);                                                   <<06097>>04190000
    STK'POSITION:=TOS;                                         <<06097>>04195000
    I:=0;                                                      <<06097>>04200000
    WHILE (I:=I+1) <= INTEGER(MODE.LBITE)                      <<06097>>04205000
      DO STK'POSITION:=STK'POSITION-STAK(STK'POSITION);        <<06097>>04210000
                                                               <<06097>>04215000
                                                               <<06097>>04220000
    BASE:=STK'POSITION; <<STARTING MARKER POSITION>>           <<06097>>04225000
    BASES:=BASE-4;      <<ENDING PARAMETER POSITION>>          <<06097>>04230000
                                                               <<06097>>04235000
    <<REGISTERS>>                                              <<06097>>04240000
    REGIST(STK'POSITION,BMSG);                                 <<06097>>04245000
    PRINT(MSG,-34,0);                                          <<06097>>04250000
    INITBUF;                                                   <<06097>>04255000
                                                               <<06097>>04260000
    <<MARKERS>>                                                <<06097>>04265000
    MARKER(STK'POSITION,BMSG);                                 <<06097>>04270000
    PRINT(MSG,-62,0);                                          <<06097>>04275000
    INITBUF;                                                   <<06097>>04280000
    WHILE (STK'POSITION:=                                      <<06097>>04285000
               STK'POSITION-STAK(STK'POSITION) ) > QIN DO      <<s7913>>04290000
      BEGIN                                                    <<06097>>04295000
        MARKER(STK'POSITION,BMSG);                             <<06097>>04300000
        IF < OR STAK(X)<4 THEN                                 <<06097>>04305000
          BEGIN                                                <<06097>>04310000
            INITBUF;                                           <<06097>>04315000
            MOVE BMSG:="INVALID MARKER";                       <<06097>>04320000
            STK'POSITION:=-1;                                  <<06097>>04325000
          END;                                                 <<06097>>04330000
        PRINT(MSG,-62,0);                                      <<06097>>04335000
        INITBUF;                                               <<06097>>04340000
      END;                                                     <<06097>>04345000
                                                               <<06097>>04350000
    <<CHECK IF FURTHER STACK DUMP ANALYSIS CAN BE DONE>>       <<06097>>04355000
    <<NO -- IF ABORTING SEG IS SYSTEM SEG             >>       <<06097>>04360000
                                                               <<06097>>04365000
    T:=STAK(BASE-1).(8:8);  <<CST #>>                          <<06097>>04370000
    T.(0:1):=STAK(BASE-2).MAPFLAG; <<MAPFLAG>>                 <<06097>>04375000
    TOS:=LOGICALCST'(T,PIX);                                   <<06875>>04380000
    ASSEMBLE(DEL);                                             <<06097>>04385000
    IF TOS=0 THEN GO OUT;        <<SYSTEM SL>>                 <<06097>>04390000
                                                               <<06097>>04395000
    <<CHECK IF DEBUG SHOULD BE CALLED>>                        <<06097>>04400000
    <<YES -- IF HAVE READ/WRITE ACCESS TO PROG FILE>>          <<06097>>04405000
    <<       AND INTERACTIVE                       >>          <<06097>>04410000
    IF RWF LAND JOBTYPE THEN                                   <<06097>>04415000
      BEGIN                        <<OK LET'S GO>>             <<06097>>04420000
        PXFIXED;                                               <<06664>>04425000
        PXFXERRLEVEL:=0;              <<TURN OFF ERROR BIT>>   <<06664>>04430000
        DBGCST:=LOGICAL(@DEBUG) LAND %100377; <<MAPFLAG,CST#>> <<06097>>04435000
        DBGDP _ CONVEXTLABELTODELTAP(@DEBUG);                  <<06097>>04440000
        IF LOGICALMAPPING                                      <<06097>>04445000
          THEN DBGDP.MAPFLAG:=DBGCST.(0:1); <<INSERT MAPFLAG>> <<06097>>04450000
        TOS:=BASE;                                             <<06097>>04455000
        PUSH(Q);                                               <<06097>>04460000
        X:=TOS-TOS;                                            <<06097>>04465000
                                                               <<06097>>04470000
        EXCHANGEDB(DBSAVE);   << RESTORE ENVIRONMENT >>        <<06097>>04475000
        IF DBFIXED THEN                                        <<06097>>04480000
          BEGIN                                                <<06097>>04485000
            SETSYSDB;                                          <<06097>>04490000
            TOS := DBVALUE;                                    <<06097>>04495000
            SET( DB );                                         <<06097>>04500000
          END;                                                 <<06097>>04505000
                                                               <<06097>>04510000
        STACK(X+1):=0;     <<X>>                               <<06097>>04515000
        STACK(X+1):=DBGDP;           <<DELTA P>>               <<06097>>04520000
        STACK(X+1):=%140000+DBGCST.RBITE; <<STATUS>>           <<06097>>04525000
        STACK(X+1):=4;     <<DELTA Q>>                         <<06097>>04530000
                                                               <<06097>>04535000
        DISABLE;                                               <<06097>>04540000
        PUSH( Q );                                             <<06097>>04545000
        TOS := TOS + X;   << OFFSET TO EXIT MARKER >>          <<06097>>04550000
        SET( Q );                                              <<06097>>04555000
        ASSEMBLE( EXIT 0 );                                    <<06097>>04560000
      END;                                                     <<06097>>04565000
                                                               <<06097>>04570000
    <<CHECK IF STACK DATA AREAS SHOULD BE DUMPED>>             <<06097>>04575000
    <<NO -- IF DO NOT HAVE READ/WRITE ACCESS TO >>             <<06097>>04580000
    <<      PROGFILE OR DUMP NOT SPECIFIED      >>             <<06097>>04585000
    PXFIXED;                                                   <<06664>>04590000
    IF NOT RWF THEN GO OUT;                                    <<06097>>04595000
    IF STDF.(13:3)=0 THEN GO OUT;      <<NOTHING TO DUMP>>     <<06097>>04600000
    PXFXSTKDMPENV:=MODE&LSR(8)+1;                              <<06664>>04605000
    <<PREPARE PARAMETERS FOR STACKDUMP>>                       <<06097>>04610000
    J:=2;                                                      <<06097>>04615000
    TOS:=-1;             <<STOPPER>>                           <<06097>>04620000
    TOS:=0;                                                    <<06097>>04625000
    IF STDF.(13:2)<>0 THEN                                     <<06097>>04630000
      BEGIN                                                    <<06097>>04635000
        J:=J+2;                                                <<06097>>04640000
        IF STDF.(14:1) THEN                                    <<06097>>04645000
          BEGIN              <<QIN TO S>>                      <<06097>>04650000
            TOS:=BASES-QIN+1;                                  <<06097>>04655000
            TOS:=QIN;          <<ADDRESS>>                     <<06097>>04660000
          END ELSE                                             <<06097>>04665000
          BEGIN              <<Q-63 TO S>>                     <<06097>>04670000
            TOS:=STAK(BASE-STAK(BASE));                        <<06097>>04675000
            ASSEMBLE(DUP);                                     <<06097>>04680000
            IF TOS>63 THEN                                     <<06097>>04685000
              BEGIN                                            <<06097>>04690000
                ASSEMBLE(DEL);                                 <<06097>>04695000
                TOS:=63;                                       <<06097>>04700000
                TOS:=BASES-X;                                  <<06097>>04705000
                ASSEMBLE(ADD);                                 <<06097>>04710000
                TOS:=X-63;                                     <<06097>>04715000
              END ELSE                                         <<06097>>04720000
              BEGIN                                            <<06097>>04725000
                TOS:=BASES-X;                                  <<06097>>04730000
                ASSEMBLE(ADD);                                 <<06097>>04735000
                TOS:=X-STAK(X);                                <<06097>>04740000
              END;                                             <<06097>>04745000
          END;                                                 <<06097>>04750000
      END;                                                     <<06097>>04755000
                                                               <<06097>>04760000
    IF STDF THEN                                               <<06097>>04765000
      BEGIN              <<DL TO QIN>>                         <<06097>>04770000
        J:=J+2;                                                <<06097>>04775000
        PUSH(DL);                                              <<06097>>04780000
        ASSEMBLE(DUP);                                         <<06097>>04785000
        TOS:=TOS-QIN;                                          <<06097>>04790000
        ASSEMBLE(NEG,XCH);                                     <<06097>>04795000
      END;                                                     <<06097>>04800000
                                                               <<06097>>04805000
    I:=-1;                                                     <<06097>>04810000
    WHILE (I:=I+1)<=J DO WDUMP(I):=TOS;                        <<06097>>04815000
    STDF:=(STDF&LSR(3)) XOR 1;                                 <<S8763>>04820000
    STACKDUMP(,,STDF,DUMP(0));                                 <<06097>>04825000
                                                               <<06097>>04830000
  END;                                                         <<06097>>04835000
                                                               <<06097>>04840000
OUT:                                                           <<06097>>04845000
    TERMINATE;                                                 <<06097>>04850000
                                                               <<06097>>04855000
  END;                                                         <<06097>>04860000
$PAGE                                                                   04865000
            << >>                                                       04870000
<<********************************************************>>            04875000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            04880000
<<********************************************************>>            04885000
            <<USER PROCESS ABORT . (TYPE=2)                             04890000
               NUM = QUIT IDENTIFICATION FOR USER          >>           04895000
<<********************************************************>>            04900000
            << >>                                                       04905000
PROCEDURE QUIT(NUM);                                                    04910000
  VALUE   NUM;                                                          04915000
  INTEGER NUM;                                                          04920000
  OPTION  PRIVILEGED;                                                   04925000
  BEGIN                                                                 04930000
          EQUATE TYPE=2, MARK=1, MODE=[8/MARK,8/TYPE];                  04935000
          << >>                                                         04940000
          ABORT(MODE,0,NUM);                                            04945000
  END;                                                                  04950000
$PAGE                                                                   04955000
            << >>                                                       04960000
<<********************************************************>>            04965000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            04970000
<<********************************************************>>            04975000
            <<USER PROGRAM ABORT . (TYPE=3)                             04980000
               NUM = QUITPROG IDENTIFICATION FOR USER       >>          04985000
<<********************************************************>>            04990000
            << >>                                                       04995000
PROCEDURE QUITPROG(NUM);                                                05000000
  VALUE   NUM;                                                          05005000
  INTEGER NUM;                                                          05010000
  OPTION  PRIVILEGED;                                                   05015000
  BEGIN                                                                 05020000
          EQUATE TYPE=3, MARK=1, MODE=[8/MARK,8/TYPE];                  05025000
          << >>                                                         05030000
          ABORT(MODE,0,NUM);                                            05035000
  END;                                                                  05040000
$PAGE                                                                   05045000
                                                                        05050000
<<********************************************************>>            05055000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            05060000
<<********************************************************>>            05065000
          <<ENABLE/DISABLE HARDWARE ARITHMETIC TRAP INTERNAL            05070000
               INTERRUPT.                                               05075000
                                                                        05080000
               STATE = TRUE  ENABLE TRAPS                               05085000
                     = FALSE DISABLE TRAPS                              05090000
                                                                        05095000
               CODE: CC=0 OK. DISABLED ORIGINALLY                       05100000
                     CC>0 OK. ENABLED ORIGINALLY                        05105000
                     CC<0 (NULL)                           >>           05110000
<<********************************************************>>            05115000
            << >>                                                       05120000
PROCEDURE ARITRAP(STATE);                                               05125000
  VALUE   STATE;                                                        05130000
  LOGICAL STATE;                                                        05135000
  OPTION  PRIVILEGED;                                                   05140000
  BEGIN                                                                 05145000
          EQUATE ERRN=51,EXITN=1;                                       05150000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               05155000
          << >>                                                         05160000
          ERRORON;                                                      05165000
          TOS _ STATUS; DUPLICATE;                                      05170000
          TOS.CCFLD _ TOS.TRAPFLD&LSL(1)+CCE;                           05175000
          TOS.TRAPFLD _ STATE;                                          05180000
          TOS.(4:1) _ 0;               <<OVERFLOW BIT>>                 05185000
          STATUS _ TOS;                                                 05190000
          ERROREXIT(ERREX,0,0);                                         05195000
  END;                                                                  05200000
$PAGE                                                          <<03046>>05205000
Procedure XDSNtrap (Plabel,OldPlabel);                         <<06873>>05210000
                                                               <<06873>>05215000
Comment                                                        <<06873>>05220000
   Set PXFIXED word PXFXDSTRAP with Plabel for DS cleanup use  <<06873>>05225000
   Returns OldPlabel in second parameter                       <<06873>>05230000
   CCE    Trap enabled                                         <<06873>>05235000
   CCG    Trap disabled                                        <<06873>>05240000
   PCAL to cleanup routine takes place in MORGUE               <<06873>>05245000
   ;  <<end comment>>                                          <<06873>>05250000
                                                               <<06873>>05255000
Value Plabel;                                                  <<06873>>05260000
Integer Plabel,OldPlabel;                                      <<06873>>05265000
OPTION PRIVILEGED,UNCALLABLE;                                  <<06873>>05270000
Begin                                                          <<06873>>05275000
Logical pxfixedloc;                                            <<06873>>05280000
Array qarray(*) = Q+0;                                         <<06873>>05285000
Integer Status = Q-1;                                          <<06873>>05290000
Integer S0 = S-0;                                              <<06873>>05295000
                                                               <<06873>>05300000
PXFIXED;  <<point to PXFIXED area>>                            <<06873>>05305000
OldPlabel := PXFXDSTRAP;                                       <<06873>>05310000
TOS := Plabel;                                                 <<06873>>05315000
If <> then                                                     <<06873>>05320000
   Status.CCFLD := CCE      << Trap enabled  >>                <<06873>>05325000
Else                                                           <<06873>>05330000
   Status.CCFLD := CCG;     << Trap disabled >>                <<06873>>05335000
PXFXDSTRAP := TOS;                                             <<06873>>05340000
End;                                                           <<06873>>05345000
LOGICAL PROCEDURE CHECKTRAPLABEL(PLABEL,USERSTACKMARKER);      <<03046>>05350000
VALUE PLABEL,USERSTACKMARKER;                                           05355000
                                                                        05360000
<<FUNCTION                                                              05365000
  CHECKS THAT THE USER'S LABEL MEETS ALL THE RULES FOR PLABELS.         05370000
  INTERRUPT PROCEDURE RULES.                                            05375000
                                                                        05380000
  CALLER'S CODE DOMAIN     INTERRUPT PROCEDURE REQUIREMENTS             05385000
  --------------------     --------------------------------             05390000
  NONPRIV PROGRAM SEG      NONPRIV; PROG, GROUP SL, ACCT SL             05395000
                                                                        05400000
  PRIV; PROG, GROUP SL     PRIV OR NONPRIV; PROG, GROUP SL,             05405000
  ACCT SL                  ACCT SL                                      05410000
                                                                        05415000
  PRIV OR NONPRIV,         PRIV OR NONPRIV; IN ANY NON-MPE              05420000
  NON-MPE SYSTEM SL        SYSTEM SL>>                                  05425000
                                                                        05430000
<<INPUT>>                                                               05435000
  INTEGER                                                               05440000
    PLABEL,              <<USER TRAP PROCEDURE'S PLABEL>>               05445000
    USERSTACKMARKER;     <<# WORDS FROM CALLER'S STACK MARKER TO        05450000
                           THE USER'S STACK MARKER.  THIS STACK         05455000
                           MARKER IS USED TO DETERMINE THE              05460000
                           PERMISSIBLE RANGE OF THE PLABEL.>>           05465000
                                                                        05470000
<<OUTPUT                                                                05475000
   CHECKTRAPLABEL         THE TRAP PROCEDURE MODE.                      05480000
                                  0 - PROCEDURE MAY EXECUTE IN          05485000
                                      PRIVILEGED MODE.                  05490000
                                  1 - PROCEDURE MAY ONLY EXECUTE        05495000
                                      IN USER MODE.                     05500000
    CONDITIONCODE          CCE - VALID PLABEL                           05505000
                           CCL - ILLEGAL PLABEL                         05510000
                           CCG - NOT RETURNED.>>                        05515000
                                                                        05520000
OPTION PRIVILEGED,UNCALLABLE;                                           05525000
                                                                        05530000
BEGIN                                                                   05535000
LOGICAL                                                                 05540000
  STATUS=Q-1;                                                           05545000
DEFINE                                                                  05550000
  RETURNCONDCODE     = STATUS.(6:2)#;                                   05555000
EQUATE                                                                  05560000
  SYSTEMSL           = 0,                                               05565000
  PROGRAMSEG         = 3,                                               05570000
  CCE                = 2,                                               05575000
  CCL                = 1;                                               05580000
INTEGER ARRAY                                                           05585000
  STACKMARKER(*)=Q+0;                                                   05590000
INTEGER                                                                 05595000
  CALLERSTATUS,CALLERTYPE,PROCEDURETYPE,CALLERCSTN,PROCEDURECSTN,       05600000
  PCBPT,PIN,TRAPLOGICALCST,SEGID;                                       05605000
INTEGER CALLERMAP,TRAPMAP;                                     <<06097>>05610000
                                                                        05615000
SUBROUTINE CHECKEXIT(CONDITIONCODE);                                    05620000
VALUE CONDITIONCODE;                                                    05625000
INTEGER CONDITIONCODE;                                                  05630000
  BEGIN                                                                 05635000
  RETURNCONDCODE:=CONDITIONCODE;                                        05640000
  ASSEMBLE(EXIT 2);                                                     05645000
  END;  <<CHECKEXIT>>                                                   05650000
<<INITIALIZATION>>                                                      05655000
PIN := (PCBPT := CURPRC)/PCBSIZE;                              <<06643>>05660000
CALLERSTATUS:=STACKMARKER(-STACKMARKER-USERSTACKMARKER-1);              05665000
CALLERMAP:=STACKMARKER(X-1).(1:1);                             <<06097>>05670000
CALLERCSTN:=CALLERSTATUS.(8:8);                                <<06097>>05675000
CALLERCSTN.(0:1):=IF LOGICALMAPPING THEN CALLERMAP ELSE 1;     <<06097>>05680000
TOS:=LOGICALCST'(CALLERCSTN,0);                                <<06875>>05685000
DEL; CALLERTYPE:=TOS;                                                   05690000
TOS:=LOGICALCST'(PLABEL,0);                                    <<06875>>05695000
IF < THEN CHECKEXIT(CCL);                                      <<*8529>>05700000
PROCEDURECSTN:=PLABEL;                                         <<06097>>05705000
TRAPLOGICALCST:=TOS;                                                    05710000
PROCEDURETYPE:=TOS;                                                     05715000
CHECKTRAPLABEL:=1;                                             <<06097>>05720000
<<CHECK LABEL VALIDITY>>                                                05725000
IF CALLERTYPE = PROGRAMSEG THEN                                         05730000
   BEGIN  <<PROGRAM>>                                                   05735000
   TRAPLOGICALCST.(0:4):=PROCEDURETYPE;                        <<06097>>05740000
   PHYSICALCST(PIN,TRAPLOGICALCST);                                     05745000
   IF <> THEN CHECKEXIT(CCL);                                           05750000
   END                                                                  05755000
ELSE IF CALLERTYPE = SYSTEMSL THEN                                      05760000
   BEGIN  <<SYSTEM SL>>                                                 05765000
   IF NOT SYSTEM(CALLERCSTN) AND SYSTEM(PROCEDURECSTN) THEN             05770000
      CHECKEXIT(CCL);                                                   05775000
   CHECKTRAPLABEL:=0;                                          <<06097>>05780000
   END                                                                  05785000
ELSE                                                                    05790000
   BEGIN  <<USER-PROG, GSL, PSL>>                                       05795000
   IF PROCEDURETYPE = SYSTEMSL THEN CHECKEXIT(CCL);                     05800000
   IF CALLERSTATUS < 0 THEN                                             05805000
      CHECKTRAPLABEL:=0                                        <<06097>>05810000
   ELSE                                                                 05815000
      BEGIN  <<CALLER IS NONPRIV, THEREFORE TRAP PROC MUST BE NONPRIV>> 05820000
      IF LOG(DSTL'(CSTCONV(PROCEDURECSTN,0)).(1:1)) THEN       <<06097>>05825000
        CHECKEXIT(CCL);  <<MODE ERROR>>                                 05830000
      CHECKTRAPLABEL := 1;                                     <<06097>>05835000
      END;                                                              05840000
   END;                                                                 05845000
                                                                        05850000
CHECKEXIT(CCE);                                                         05855000
END;  <<CHECKTRAPLABEL>>                                                05860000
$PAGE                                                          <<03046>>05865000
LOGICAL PROCEDURE TRAPLABEL(N,MASK,PLAB,XMASK,XPLAB,MODE);     <<06097>>05870000
   VALUE N,PLAB,MASK;                                          <<06097>>05875000
   INTEGER N,PLAB,MASK,XMASK,XPLAB,MODE;                       <<06097>>05880000
   OPTION PRIVILEGED,UNCALLABLE;                               <<06097>>05885000
                                                               <<06097>>05890000
<<********************************************************>>   <<06097>>05895000
<< SET UP TRAP MECHANISM :                                >>   <<06097>>05900000
<<                                                        >>   <<06097>>05905000
<<   - CHECK THE VALIDITY OF PLABEL.                      >>   <<06097>>05910000
<<   - PUT PLABEL AND MASK IN PCBX.                       >>   <<06097>>05915000
<<   - CHECK TRAP PROCEDURE EXECUTING MODE AND PUT THE    >>   <<06097>>05920000
<<     MODE IN PCBX(6).                                   >>   <<06097>>05925000
<<   - RETURN THE OLD TRAP LABEL AND MASK WORD.           >>   <<06097>>05930000
<<                                                        >>   <<06097>>05935000
<< INPUT :                                                >>   <<06097>>05940000
<<                                                        >>   <<06097>>05945000
<<   N     : TRAP TYPE.   15 = ARITH TRAP.                >>   <<06097>>05950000
<<                        16 = LIB TRAP.                  >>   <<06097>>05955000
<<                        17 = SYS TRAP.                  >>   <<06097>>05960000
<<                        18 = CTL-Y TRAP.                >>   <<06097>>05965000
<<                        22 = Insert Horizon cleanup plab>>   <<06874>>05970000
<<                        63 = CODE TRAP.                 >>   <<06097>>05975000
<<   MASK  : MASK WORD FOR ARITH TRAP.                    >>   <<06097>>05980000
<<   PLAB  : TRAP PROCEDURE LABEL.                        >>   <<06097>>05985000
<<             =  0 -- DISARM TRAP.                       >>   <<06097>>05990000
<<             <> 0 -- ARM TRAP.                          >>   <<06097>>05995000
<<                                                        >>   <<06097>>06000000
<< OUTPUT :                                               >>   <<06097>>06005000
<<                                                        >>   <<06097>>06010000
<<   XMASK : OLD MASK WORD EXTRACTED FROM PCBX.           >>   <<06097>>06015000
<<   XPLAB : OLD TRAP PROCEDURE LABEL EXTRACTED FROM PCBX.>>   <<06097>>06020000
<<   MODE  : NON-PRIV/PRIV MODE OF TRAP PROCEDURE         >>   <<06097>>06025000
<<   CONDCODE : CCE = TRAP ARMED.                         >>   <<06097>>06030000
<<              CCG = TRAP DISARMED.                      >>   <<06097>>06035000
<<              CCL = ILLEGAL PLABEL.                     >>   <<06097>>06040000
<<                                                        >>   <<06097>>06045000
<< SPECIAL NOTE :                                         >>   <<06097>>06050000
<<     DEBUG CALLS THIS ROUTINE WITH N=19 MAINLY FOR      >>   <<06097>>06055000
<<     CHECKING THE VALIDITY OF PLABEL. IF N=19 IS TRUE   >>   <<06097>>06060000
<<     THEN PCBX UPDATING CODE SHOULD BE BYPASSED.        >>   <<06097>>06065000
<<********************************************************>>   <<06097>>06070000
                                                               <<06097>>06075000
BEGIN                                                          <<06097>>06080000
                                                               <<06097>>06085000
   EQUATE  DEBUGLAB   = -1;                                    <<06664>>06090000
   LOGICAL PXFIXEDLOC;                                         <<06664>>06095000
   INTEGER ARRAY STAK(*) = Q+0;                                <<06664>>06100000
   LOGICAL ARRAY QARRAY(*) = Q+0;                              <<06664>>06105000
   INTEGER POINTER P;                                          <<06097>>06110000
   INTEGER CALLSTATUS,                                         <<06097>>06115000
           CALLPLABEL,                                         <<06097>>06120000
           CALLLCST,                                           <<06097>>06125000
           CALLTYPE,                                           <<06097>>06130000
           TRAPLCST,                                           <<06097>>06135000
           TRAPTYPE,                                           <<06097>>06140000
           CALLMAP,                                            <<06097>>06145000
           CCERR,                                              <<06097>>06150000
           INDEX;                                              <<06097>>06155000
                                                               <<06097>>06160000
   <<*****************************************>>               <<06097>>06165000
   << GET CALLER PLABEL                       >>               <<06097>>06170000
   <<*****************************************>>               <<06097>>06175000
                                                               <<06097>>06180000
   CCERR:=CCE;                                                 <<06097>>06185000
   CALLSTATUS:=STAK(-STAK(0)-1);                               <<06097>>06190000
   IF LOGICALMAPPING THEN                                      <<06097>>06195000
      CALLMAP:=STAK(-STAK(0)-2).MAPFLAG                        <<06097>>06200000
   ELSE                                                        <<06097>>06205000
      CALLMAP:=1;  <<SIGN BIT IS 1 FOR EXTERNAL LABEL>>        <<06097>>06210000
   CALLPLABEL:=CALLSTATUS.RBITE;                               <<06097>>06215000
   CALLPLABEL.(0:1):=CALLMAP;                                  <<06097>>06220000
                                                               <<06097>>06225000
   <<*********************************************>>           <<06097>>06230000
   << PROCESS ARM/DISARM TRAPS                    >>           <<06097>>06235000
   <<*********************************************>>           <<06097>>06240000
                                                               <<06097>>06245000
   IF N=PXAPLAB AND MASK=0 OR PLAB=0 THEN   << DISARM TRAP >>  <<06664>>06250000
      BEGIN                                                    <<06097>>06255000
         CCERR:=CCG;                                           <<06097>>06260000
         MASK:=0;                                              <<06097>>06265000
      END                                                      <<06097>>06270000
   ELSE                                       << ARM TRAP    >><<06097>>06275000
      BEGIN                                                    <<06097>>06280000
         <<***************************************>>           <<06097>>06285000
         << GET CALLER SEGMENT INFO               >>           <<06097>>06290000
         <<***************************************>>           <<06097>>06295000
                                                               <<06097>>06300000
         TOS:=LOGICALCST'(CALLPLABEL,PIX);                     <<06875>>06305000
         IF < THEN                                             <<06097>>06310000
            BEGIN                                              <<06097>>06315000
ERR:                                                           <<06097>>06320000
               CCERR:=CCL;                                     <<06097>>06325000
               GO TO FIN;                                      <<06097>>06330000
            END;                                               <<06097>>06335000
         CALLLCST:=TOS;                                        <<06097>>06340000
         CALLTYPE:=TOS;                                        <<06097>>06345000
                                                               <<06097>>06350000
         <<********************************************>>      <<06097>>06355000
         << GET TRAP SEGMENT INFO                      >>      <<06097>>06360000
         <<********************************************>>      <<06097>>06365000
                                                               <<06097>>06370000
         TOS:=LOGICALCST'(LOGICAL(PLAB) LAND %100377,PIX);     <<06875>>06375000
         IF < THEN                                             <<06097>>06380000
            GO TO ERR;                                         <<06097>>06385000
         TRAPLCST:=TOS;                                        <<06097>>06390000
         TRAPTYPE:=TOS;                                        <<06097>>06395000
                                                               <<06097>>06400000
         <<********************************************>>      <<06097>>06405000
         << IF CALLER SEG IS IN SYSTEM SL THEN         >>      <<06097>>06410000
         <<  - MPE SEG CAN TRAP TO ANY SYS SL SEG      >>      <<06097>>06415000
         <<  - NON-MPE SEG CAN TRAP TO NON-MPE SEG ONLY>>      <<06097>>06420000
         <<********************************************>>      <<06097>>06425000
                                                               <<06097>>06430000
         MODE:=1;                   <<SET TRAP NONPRIV >>      <<06097>>06435000
         IF CALLTYPE = 0 THEN          <<SYS SL SEG    >>      <<06097>>06440000
            IF SYSTEM(CALLPLABEL) THEN <<MPE SEG       >>      <<06097>>06445000
               MODE:=0                 <<SET TRAP PRIV >>      <<06097>>06450000
            ELSE                       <<NON-MPE SEG   >>      <<06097>>06455000
               IF SYSTEM(PLAB) THEN    <<NON-MPE TO MPE>>      <<06097>>06460000
                  GO ERR                                       <<06097>>06465000
               ELSE                    <<OK            >>      <<06097>>06470000
         ELSE                          <<PROG/GSL/PSL  >>      <<06097>>06475000
            IF TRAPTYPE=0 THEN         <<TRAP TO SYS SL>>      <<06097>>06480000
               GO ERR                                          <<06097>>06485000
            ELSE                                               <<06097>>06490000
               IF CALLSTATUS < 0 THEN  <<CALLER PRIVED >>      <<06097>>06495000
                  MODE:=0              <<SET TRAP PRIV >>      <<06097>>06500000
               ELSE                    <<CALLER NONPRIV>>      <<06097>>06505000
                  BEGIN                                        <<06097>>06510000
                     INDEX:=CSTCONV(PLAB,PIX);                 <<06097>>06515000
                     IF INDEX = 0 THEN                         <<06097>>06520000
                        GO ERR;        <<BAD PLABEL    >>      <<06097>>06525000
                     IF DSTL'(INDEX).(1:1) THEN                <<06097>>06530000
                        GO ERR;        <<TRAP TO PRIV  >>      <<06097>>06535000
                  END;                                         <<06097>>06540000
      END;                                                     <<06097>>06545000
                                                               <<06097>>06550000
   <<**********************************>>                      <<06097>>06555000
   << UPDATE PCBX                      >>                      <<06097>>06560000
   <<**********************************>>                      <<06097>>06565000
                                                               <<06097>>06570000
   IF N=DEBUGLAB THEN                                          <<06097>>06575000
      GO FIN;                                                  <<06097>>06580000
                                                               <<06097>>06585000
   PXFIXED;                                                    <<06664>>06590000
   IF N = PXHPLAB THEN                                         <<06874>>06595000
      BEGIN    << Insert Horizon cleanup plabel >>             <<06874>>06600000
      XPLAB := PXFXHORZPLBL;                                   <<06874>>06605000
      PXFXHORZPLBL := PLAB;                                    <<06874>>06610000
      GO FIN;                                                  <<06874>>06615000
      END;                                                     <<06874>>06620000
                                                               <<06874>>06625000
                                                               <<06097>>06630000
   CASE N-15 OF                                                <<06664>>06635000
      BEGIN                                                    <<06664>>06640000
         <<0>>  BEGIN                                          <<06664>>06645000
                   PXFXARITHTRP:=MODE;                         <<06664>>06650000
                   XPLAB:=PXFXATRPPLBL;                        <<06664>>06655000
                   PXFXATRPPLBL:=PLAB;                         <<06664>>06660000
                   XMASK:=PXFXATRPMASK;                        <<06664>>06665000
                   PXFXATRPMASK := MASK;                       <<07306>>06670000
                END;                                           <<06664>>06675000
                                                               <<06664>>06680000
         <<1>>  BEGIN                                          <<06664>>06685000
                   PXFXLIBTRP:=MODE;                           <<06664>>06690000
                   XPLAB:=PXFXLTRPPLBL;                        <<06664>>06695000
                   PXFXLTRPPLBL:=PLAB;                         <<06664>>06700000
                END;                                           <<06664>>06705000
                                                               <<06664>>06710000
         <<2>>  BEGIN                                          <<06664>>06715000
                   PXFXSYSTRP:=MODE;                           <<06664>>06720000
                   XPLAB:=PXFXSTRPPLBL;                        <<06664>>06725000
                   PXFXSTRPPLBL:=PLAB;                         <<06664>>06730000
                END;                                           <<06664>>06735000
                                                               <<06664>>06740000
         <<3>>  BEGIN                                          <<06664>>06745000
                   PXFXCTLYTRP:=MODE;                          <<06664>>06750000
                   XPLAB:=PXFXCTLYPLBL;                        <<06664>>06755000
                   PXFXCTLYPLBL:=PLAB;                         <<06664>>06760000
                END;                                           <<06664>>06765000
                                                               <<06664>>06770000
         <<4>>  BEGIN                                          <<06664>>06775000
                   PXFXCODETRP:=MODE;                          <<06664>>06780000
                   XPLAB:=PXFXCODEPLBL;                        <<06664>>06785000
                   PXFXCODEPLBL:=PLAB;                         <<06664>>06790000
                END;                                           <<06664>>06795000
      END;                                                     <<06664>>06800000
FIN:                                                           <<06097>>06805000
   TRAPLABEL:=CCERR;                                           <<06097>>06810000
END;                                                           <<06097>>06815000
$PAGE                                                                   06820000
$PAGE                                                          <<06874>>06825000
PROCEDURE XHTRAP(PLABEL,OLDPLABEL);                            <<06874>>06830000
   VALUE PLABEL;                                               <<06874>>06835000
   INTEGER PLABEL,OLDPLABEL;                                   <<06874>>06840000
   OPTION PRIVILEGED,UNCALLABLE;                               <<06874>>06845000
BEGIN                                                          <<06874>>06850000
                                                               <<06874>>06855000
<< Will enable/disable the Horizon cleanup procedure upon    >><<06874>>06860000
<< process termination.                                      >><<06874>>06865000
<<                                                           >><<06874>>06870000
<< ENTRY:                                                    >><<06874>>06875000
<<   PLABEL <> 0 External plabel                             >><<06874>>06880000
<<   PLABEL  = 0 Clear the plabel field.                     >><<06874>>06885000
<<                                                           >><<06874>>06890000
<< EXIT:                                                     >><<06874>>06895000
<<   OLDPLABEL - Previous plabel returned.                   >><<06874>>06900000
<<                                                           >><<06874>>06905000
<< CONDITION CODE:                                           >><<06874>>06910000
<<   CCE  - Request granted. Cleanup procedure set.          >><<06874>>06915000
<<   CCG  - Request granted. Cleanup procedure disabled.     >><<06874>>06920000
<<   CCL  - Request denied because of illegal plabel, or DB  >><<06874>>06925000
<<          not at stack.                                    >><<06874>>06930000
                                                               <<06874>>06935000
EQUATE                                                         <<06874>>06940000
   CCL            =   1,                                       <<06874>>06945000
   INTRIN'NUM     =  0,    <<                                >><<06874>>06950000
   NUM'PARMS      =  2,    <<                                >><<06874>>06955000
   EXIT'NUM       = NUM'PARMS, <<                            >><<06874>>06960000
                                                               <<06874>>06965000
   PARM'CHECKING  = %10,       << Check addr of plabel parm. >><<06874>>06970000
   INTRIN'EXIT    = [10/INTRIN'NUM,6/EXIT'NUM];                <<06874>>06975000
                                                               <<06874>>06980000
INTEGER                                                        <<06874>>06985000
   DUMMY;                   <<                               >><<06874>>06990000
                                                               <<06874>>06995000
                                                               <<06874>>07000000
ERRORON;                                                       <<06874>>07005000
CHEK(INTRIN'EXIT,NUM'PARMS,DOUBLE(PARM'CHECKING));             <<06874>>07010000
IF CARRY THEN                                                  <<06874>>07015000
   BEGIN      << Opps...DB not at stack >>                     <<06874>>07020000
   STATUS.CCFLD := CCL;                                        <<06874>>07025000
   ERROREXIT(INTRIN'EXIT,0,0);                                 <<06874>>07030000
   END;                                                        <<06874>>07035000
                                                               <<06874>>07040000
STATUS.CCFLD := TRAPLABEL(PXHPLAB,DUMMY,PLABEL,DUMMY,          <<06874>>07045000
                          OLDPLABEL,DUMMY);                    <<06874>>07050000
ERROREXIT(INTRIN'EXIT,0,0);                                    <<06874>>07055000
END;           << Procedure XHTRAP >>                          <<06874>>07060000
$PAGE                                                          <<06874>>07065000
            << >>                                                       07070000
<<********************************************************>>            07075000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            07080000
<<********************************************************>>            07085000
            <<ARM/DISARM ARITHMETIC TRAP MECHANISM WITH SELECTIVE       07090000
               MASK AND EXTERNAL LABEL. RETURNS THE ORIGINAL            07095000
               MASK AND EXTERNAL LABEL.                                 07100000
                                                                        07105000
               MASK  = BIT MASK FOR ARM(=1)/DISARM(=0)                  07110000
                             BIT 15 - FLT PT DIVIDE BY 0                07115000
                             BIT 14 - INTEGER DIVIDE BY 0               07120000
                             BIT 13 - FLT PT UNDERFLOW                  07125000
                             BIT 12 - INTEGER UNDERFLOW                 07130000
                             BIT 11 - INTEGER OVERFLOW                  07135000
                             BIT 10 - DBL. PREC. OVERFLOW      <<B0.01  07140000
                             BIT  9 - DBL. PREC. UNDERFLOW     <<B0.01  07145000
                             BIT  8 - DBL. PREC. DIV. BY ZERO  <<B0.01  07150000
                             BIT  7 - DECIMAL OVERFLOW         <<B0.07  07155000
                             BIT  6 - INVALID ASCII DIGIT      <<B0.07  07160000
                             BIT  5 - INVALID SOURCE WORD COUNT<<B0.07  07165000
                             BIT  4 - INVALID DECIMAL DIGIT    <<B0.07  07170000
                             BIT  3 - INVALID DECIMAL OPERAND  <<B0.07  07175000
                                      LENGTH                   <<B0.07  07180000
                             BIT  2 - DECIMAL DIV ZERO         <<B0.07  07185000
               PLAB  <> 0 EXTERNAL LABEL                                07190000
                     =  0 DISARM MECHANISM                              07195000
                                                                        07200000
               CODE: CC=0 OK. ARMED                                     07205000
                     CC>0 OK. DISARMED                                  07210000
                     CC<0 NO. ILLEGAL PLAB                 >>           07215000
<<********************************************************>>            07220000
            << >>                                                       07225000
PROCEDURE XARITRAP(MASK,PLAB,XMASK,XPLAB);                              07230000
  VALUE   MASK,PLAB;                                                    07235000
  INTEGER MASK,PLAB,XMASK,XPLAB;                                        07240000
  OPTION  PRIVILEGED;                                                   07245000
  BEGIN                                                                 07250000
    INTEGER MODE;                                              <<06097>>07255000
          EQUATE ERRN=50,EXITN=4;                                       07260000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               07265000
          << >>                                                         07270000
          ERRORON;                                                      07275000
          CHEK(ERREX,%4,%240D);                                         07280000
          CCODE:=TRAPLABEL(PXAPLAB,MASK,PLAB,XMASK,XPLAB,MODE);<<06097>>07285000
          ERROREXIT(ERREX,0,0);                                         07290000
  END;                                                                  07295000
$PAGE                                                                   07300000
            << >>                                                       07305000
<<********************************************************>>            07310000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            07315000
<<********************************************************>>            07320000
            <<ARM/DISARM LIBRARY TRAP MECHANISM WITH EXTERNAL           07325000
               LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.              07330000
                                                                        07335000
               PLAB  <> 0 EXTERNAL LABEL                                07340000
                     =  0 DISARM MECHANISM                              07345000
                                                                        07350000
               CODE: CC=0 OK. ARMED                                     07355000
                     CC>0 OK. DISARMED                                  07360000
                     CC<0 NO. ILLEGAL PLAB                 >>           07365000
<<********************************************************>>            07370000
            << >>                                                       07375000
PROCEDURE XLIBTRAP(PLAB,XPLAB);                                         07380000
  VALUE   PLAB;                                                         07385000
  INTEGER PLAB,XPLAB;                                                   07390000
  OPTION  PRIVILEGED;                                                   07395000
  BEGIN                                                                 07400000
    INTEGER MODE;                                              <<06097>>07405000
          EQUATE ERRN=52,EXITN=2;                                       07410000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               07415000
          INTEGER DUM;                                                  07420000
          << >>                                                         07425000
          ERRORON;                                                      07430000
          CHEK(ERREX,%2,%10D);                                          07435000
          CCODE:=TRAPLABEL(PXLPLAB,0,PLAB,DUM,XPLAB,MODE);     <<06097>>07440000
          ERROREXIT(ERREX,0,0);                                         07445000
  END;                                                                  07450000
$PAGE                                                                   07455000
            << >>                                                       07460000
<<********************************************************>>            07465000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            07470000
<<********************************************************>>            07475000
            <<ARM/DISARM SYSTEM TRAP MECHANISM WITH EXTERNAL            07480000
               LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.              07485000
                                                                        07490000
               PLAB  <> 0 EXTERNAL LABEL                                07495000
                     =  0 DISARM MECHANISM                              07500000
                                                                        07505000
               CODE: CC=0 OK. ARMED                                     07510000
                     CC>0 OK. DISARMED                                  07515000
                     CC<0 NO. ILLEGAL PLAB                 >>           07520000
<<********************************************************>>            07525000
            << >>                                                       07530000
PROCEDURE XSYSTRAP(PLAB,XPLAB);                                         07535000
  VALUE   PLAB;                                                         07540000
  INTEGER PLAB,XPLAB;                                                   07545000
  OPTION  PRIVILEGED;                                                   07550000
  BEGIN                                                                 07555000
    INTEGER MODE;                                              <<06097>>07560000
          EQUATE ERRN=53,EXITN=2;                                       07565000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               07570000
          INTEGER DUM;                                                  07575000
          << >>                                                         07580000
          ERRORON;                                                      07585000
          CHEK(ERREX,%2,%10D);                                          07590000
          CCODE:=TRAPLABEL(PXSPLAB,0,PLAB,DUM,XPLAB,MODE);     <<06097>>07595000
          ERROREXIT(ERREX,0,0);                                         07600000
  END;                                                                  07605000
LOGICAL PROCEDURE CTLYTRAP'LEGAL(STDIN);                       <<06097>>07610000
  <<RETURN TRUE IF PROCESS CAN LEGALLY SET CTL-Y TRAP>>        <<06097>>07615000
  <<RETURN STANDARD INPUT DEVICE                     >>        <<06097>>07620000
  INTEGER STDIN;                                               <<06097>>07625000
  OPTION PRIVILEGED,UNCALLABLE;                                <<*7857>>07630000
  BEGIN                                                        <<06097>>07635000
    EQUATE STINX=3;                                            <<06097>>07640000
    INTEGER PCBGLOBLOC;                                        <<06664>>07645000
    ARRAY QARRAY(*)=Q+0;                                       <<06664>>07650000
    CTLYTRAP'LEGAL:=FALSE;  <<INITIALIZE>>                     <<06097>>07655000
    PXGLOBAL;                                                  <<06664>>07660000
    STDIN:=PXG'INPUTLDEV;        <<STD INPUT DEVICE>>          <<06664>>07665000
    TOS:=PXG'JOBTYPE;            <<JOB TYPE>>                  <<06664>>07670000
    IF TOS = 1 THEN CTLYTRAP'LEGAL:=TRUE; <<SESSION>>          <<06097>>07675000
  END;                                                         <<06097>>07680000
            << >>                                              <<03046>>07685000
<<********************************************************>>   <<03046>>07690000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>   <<03046>>07695000
<<********************************************************>>   <<03046>>07700000
<<          ARM/DISARM CODE TRAP MECHANISM WITH EXTERNAL  >>   <<03046>>07705000
<<          LABEL. RETURNS THE ORIGINAL EXTERNAL LABEL.   >>   <<03046>>07710000
<<          THE TRAPS HANDLED BY THIS MECHANISM ARE:      >>   <<03046>>07715000
<<             PRIVILEGED MODE INSTR.                     >>   <<03046>>07720000
<<             UNIMPLEMEMTED INSTR.                       >>   <<03046>>07725000
<<             STT UNCALLABLE                             >>   <<03046>>07730000
<<             BAD STACK MARKER                           >>   <<03046>>07735000
<<             ILLEGAL ADDRESS                            >>   <<03046>>07740000
<<             BOUNDS VIOLATION                           >>   <<03046>>07745000
<<             NON-RESPONDING MODULE                      >>   <<03046>>07750000
<<             STACK UNDERFLOW                            >>   <<03046>>07755000
<<             CST VIOLATION                              >>   <<03046>>07760000
<<             STT VIOLATION                              >>   <<03046>>07765000
<<                                                        >>   <<03046>>07770000
<<             PLAB  <> 0 EXTERNAL LABEL                  >>   <<03046>>07775000
<<                   =  0 DISARM MECHANISM                >>   <<03046>>07780000
<<                                                        >>   <<03046>>07785000
<<             CODE: CC=0 OK. ARMED                       >>   <<03046>>07790000
<<                   CC>0 OK. DISARMED                    >>   <<03046>>07795000
<<                   CC<0 NO. ILLEGAL PLAB                >>   <<03046>>07800000
<<********************************************************>>   <<03046>>07805000
            << >>                                              <<03046>>07810000
PROCEDURE XCODETRAP(PLAB,XPLAB);                               <<03046>>07815000
  VALUE   PLAB;                                                <<03046>>07820000
  INTEGER PLAB,XPLAB;                                          <<03046>>07825000
  OPTION  PRIVILEGED;                                          <<03046>>07830000
  BEGIN                                                        <<03046>>07835000
    INTEGER MODE;                                              <<06097>>07840000
          EQUATE ERRN=57,EXITN=2;                              <<03046>>07845000
          EQUATE ERREX=[10/ERRN,6/EXITN];                      <<03046>>07850000
          INTEGER DUM;                                         <<03046>>07855000
          << >>                                                <<03046>>07860000
          ERRORON;                                             <<03046>>07865000
          CHEK(ERREX,%2,%10D);                                 <<03046>>07870000
          CCODE:=TRAPLABEL(PXCPLAB,0,PLAB,DUM,XPLAB,MODE);     <<06097>>07875000
          ERROREXIT(ERREX,0,0);                                <<03046>>07880000
  END;                                                         <<03046>>07885000
$PAGE                                                                   07890000
            << >>                                                       07895000
<<********************************************************>>            07900000
<<******  CALLABLE - CAPABILITY 0 -   TRAPS       ********>>            07905000
<<********************************************************>>            07910000
            <<ARM/DISARM "CONTROL Y" MECHANISM WITH EXTERNAL            07915000
               LABEL.RETURNS THE ORIGINAL EXTERNAL LABEL.               07920000
                                                                        07925000
               PLAB  <> 0 EXTERNAL LABEL                                07930000
                     =  0 DISARM MECHANISM                              07935000
                                                                        07940000
               CODE: CC=0 OK. ARMED                                     07945000
                     CC>0 OK. DISARMED                                  07950000
                     CC<0 NO. ILLEGAL PLAB                 >>           07955000
<<********************************************************>>            07960000
            << >>                                                       07965000
                                                                        07970000
                                                                        07975000
PROCEDURE XCONTRAP(PLABEL,OLDPLABEL);                                   07980000
VALUE PLABEL;                                                           07985000
INTEGER PLABEL,OLDPLABEL;                                               07990000
OPTION PRIVILEGED;                                                      07995000
                                                                        08000000
COMMENT: SETS UP THE CONTROL Y MECANISM FOR THE CALLER PROCESS.         08005000
         RETIRNS:                                                       08010000
            CC=CCE   OK CONTROL Y ARMED                                 08015000
            CC=CCG   OK CONTROL Y DISARMED                              08020000
            CC=CCL   FAILURE                                            08025000
                        1.NOT A SESSION                                 08030000
                        2.ILLEGAL PLABEL(NOT EXTERNAL/SYSTEM LABEL...)  08035000
                                                                        08040000
            OLDPLABEL IS AN EXTERNAL LABEL.                             08045000
      ;                                                                 08050000
                                                                        08055000
BEGIN                                                                   08060000
          EQUATE ERRN=54,EXITN=2;                                       08065000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               08070000
    INTEGER MODE,DUM;                                          <<06097>>08075000
      INTEGER LDT'INDEX;                                       <<07052>>08080000
      INTEGER STDIN,CC,PIN;                                             08085000
      ARRAY LDT(*) = DB+0;                                     <<07052>>08090000
                                                                        08095000
                                                                        08100000
    ERRORON;                                                   <<06097>>08105000
    CHEK(ERREX,%2,%10D);                                       <<06097>>08110000
    STATUS.CCFLD:=CCL;                                         <<06097>>08115000
    IF CTLYTRAP'LEGAL(STDIN) THEN                              <<06097>>08120000
      BEGIN               <<PIN CAN SET CTL-Y TRAP>>           <<06097>>08125000
        IF PLABEL <> 0 THEN                                    <<06097>>08130000
          BEGIN           <<ARM TRAP>>                         <<06097>>08135000
            PIN:=PIX/PCBSIZE;                                  <<06097>>08140000
SETTRAP:                                                       <<06097>>08145000
      CCODE:=TRAPLABEL(18,PXCYPLAB,PLABEL,DUM,OLDPLABEL,MODE); <<06664>>08150000
                  IF  CCODE = CCL THEN GO FINISH; <<ERROR>>    <<06097>>08155000
            TOS := EXCHANGEDB(LDT'DST);                        <<07052>>08160000
            LDT'INDEX := STDIN * SIZE'OF'LDT'ENTRY;            <<07052>>08165000
            LDT'CONTROL'Y'PIN := PIN;                          <<07052>>08170000
            EXCHANGEDB(*);                                     <<06097>>08175000
            IF PLABEL <> 0 THEN IOCONTROL(STDIN,13);           <<06097>>08180000
          END                                                  <<06097>>08185000
         ELSE                                                  <<06097>>08190000
          BEGIN           <<DIS ARM TRAP>>                     <<06097>>08195000
            PIN:=0;                                            <<06097>>08200000
            IOCONTROL(STDIN,12);                               <<06097>>08205000
            GO SETTRAP;                                        <<06097>>08210000
          END;                                                 <<06097>>08215000
      END;                                                     <<06097>>08220000
FINISH:                                                        <<06097>>08225000
    ERROREXIT(ERREX,0,0);                                      <<06097>>08230000
END;  << X C O N T R A P  >>                                            08235000
$PAGE                                                                   08240000
                                                                        08245000
PROCEDURE RESETCONTROL;                                                 08250000
OPTION PRIVILEGED;                                                      08255000
                                                                        08260000
COMMENT: RESETS PROCESS ENVIRONMENT FROM CY TO NAORMAL.                 08265000
      RETIRNS CCE IF OK                                                 08270000
              CCL IF FAILURE:THE PROCESS WAS NOT RUMNIG IN CY MODE.     08275000
      ;                                                                 08280000
                                                                        08285000
BEGIN                                                                   08290000
INTEGER                                                        <<00.EB>>08295000
   CC,                                                         <<00.EB>>08300000
   INDEX;                                                      <<00.EB>>08305000
                                                               <<00.EB>>08310000
INTEGER PLABEL;                                                <<06097>>08315000
INTEGER PCBPT;                                                 <<06643>>08320000
ARRAY QARRAY(*) = Q+0;                                         <<06664>>08325000
INTEGER PCBGLOBLOC;                                            <<06664>>08330000
INTEGER ARRAY Q0(*) = Q+0;                                     <<06664>>08335000
                                                               <<00.EB>>08340000
POINTER CST = 1;                                               <<00.EB>>08345000
                                                               <<00.EB>>08350000
DEFINE SYSBIT = (11:1) #;                                      <<00.EB>>08355000
                                                               <<00.EB>>08360000
EQUATE STDIN = 3;                                              <<00.EB>>08365000
                                                               <<00.EB>>08370000
LOGICAL SUBROUTINE PXGLOB(INDEX);                              <<00.EB>>08375000
   VALUE INDEX;                                                <<00.EB>>08380000
   INTEGER INDEX;                                              <<00.EB>>08385000
COMMENT     *** WORKS ONLY IF DB AT STACK *** ;                <<00.EB>>08390000
BEGIN                                                          <<00.EB>>08395000
                                                               <<00.EB>>08400000
ASSEMBLE(                                                      <<00.EB>>08405000
PSHR %40;     << DL >>                                         <<00.EB>>08410000
LDXN 1;       << PCBX GLOBE PTR 1 BELOW DL >>                  <<00.EB>>08415000
SUBM S-0,I,X; << OFFSET TO PXGLOB >>                           <<00.EB>>08420000
STAX,ADBX;    << X:= OFFSET + INDEX >>                         <<00.EB>>08425000
LOAD DB+0,X;  << GET VALUE >>                                  <<00.EB>>08430000
STOR S-3;);   << PUT IN RETURN VALUE >>                        <<00.EB>>08435000
END; << PXGLOB >>                                              <<00.EB>>08440000
PCBPT := CURPRC;                                               <<06643>>08445000
ERRORON;                                                       <<00.EB>>08450000
CHEK(55 &LSL(6),0); << DB MUST BE AT STACK >>                  <<00.EB>>08455000
                                                               <<00.EB>>08460000
<< CHECK PCB PSEUDO INT.MODE FOR CTL Y >>                      <<00.EB>>08465000
IF INTEGER(PIINFO).PSIMFIELD = 5 THEN                          <<06643>>08470000
BEGIN << CTLY OCCURRED >>                                      <<00.EB>>08475000
   PIINFO.PSIMFIELD := 7;                                      <<06643>>08480000
   CC := CCE;                                                  <<00.EB>>08485000
   << LOOK BACK IN MARKERS FOR A CTLY MARKER >>                <<00.EB>>08490000
   INDEX := -1; << LOOK AT STATUS WORD IN MARKER >>            <<00.EB>>08495000
   PLABEL:=Q0(INDEX).(8:8);     <<CST #>>                      <<06097>>08500000
   PLABEL.(0:1):=IF LOGICALMAPPING THEN Q0(INDEX-1).MAPFLAG    <<06097>>08505000
                                   ELSE 1;                     <<06097>>08510000
   WHILE SYSTEM(PLABEL) DO                                     <<06097>>08515000
     BEGIN   <<MARKER FOR SYSTEM SEG. SKIP TO NEXT MARKER>>    <<06097>>08520000
       INDEX:=INDEX-Q0(INDEX+1);                               <<06097>>08525000
       PLABEL:=Q0(INDEX).(8:8);       <<CST #>>                <<06097>>08530000
       PLABEL.(0:1):=IF LOGICALMAPPING THEN Q0(INDEX-1).MAPFLAG<<06097>>08535000
                                       ELSE 1;                 <<06097>>08540000
     END; <<WHILE>>                                            <<06097>>08545000
   << RESET DELTA P BIT 0 >>                                   <<00.EB>>08550000
   Q0(INDEX-1).(0:1) := 0;                                     <<00.EB>>08555000
                                                               <<00.EB>>08560000
   PXGLOBAL;                                                   <<06664>>08565000
   RESETBREAKBITS(INTEGER(PXG'INPUTLDEV),0);                   <<06664>>08570000
   RESUMESOFTINT;                                              <<03046>>08575000
END                                                            <<00.EB>>08580000
ELSE CC := CCL;                                                <<00.EB>>08585000
                                                               <<00.EB>>08590000
STATUS.(6:2) := CC;                                            <<00.EB>>08595000
ERROREXIT(55 &LSL(6),0,0);                                     <<00.EB>>08600000
                                                               <<00.EB>>08605000
END; << RESETCONTROL >>                                        <<00.EB>>08610000
$PAGE                                                                   08615000
PROCEDURE SETUSERTRAP(ERROR,OPTION'NUMS,OPTIONS);              <<06097>>08620000
  <<THIS IS AN EXTENSION OF ALL THE USER TRAP >>               <<06097>>08625000
  <<PROCEDURES.  IT ALLOWS TRAPS TO BE CALLED >>               <<06097>>08630000
  <<BY PHYSICALLY MAPPED AS WELL AS LOGICALLY >>               <<06097>>08635000
  <<MAPPED PROCEDURES.                        >>               <<06097>>08640000
  <<CONDITION CODE RETURNED--                 >>               <<06097>>08645000
  <<  . CCE = OK ARMED                        >>               <<06097>>08650000
  <<  . CCG = OK UNARMED                      >>               <<06097>>08655000
  <<  . CCL = ERROR                           >>               <<06097>>08660000
  <<                                          >>               <<06097>>08665000
  INTEGER ERROR;           <<ERROR RETURN>>                    <<06097>>08670000
  INTEGER ARRAY OPTION'NUMS;<<OPTION NUMBERS>>                 <<06097>>08675000
  LOGICAL ARRAY OPTIONS;    <<CORRESPONDING OPTIONS>>          <<06097>>08680000
  OPTION PRIVILEGED;                                           <<06097>>08685000
  BEGIN                                                        <<06097>>08690000
    DOUBLE STK'LIMS;                                           <<06097>>08695000
    INTEGER STK'LOLIM=STK'LIMS,STK'HILIM=STK'LIMS+1;           <<06097>>08700000
    INTEGER TRAPTYPE,PLABEL,MASK,MODE,TEMP,PIN,STDIN;          <<06097>>08705000
    INTEGER POINTER OLD'PLABEL,OLD'MASK,OLD'MODE;              <<06097>>08710000
    LOGICAL ENDOFLIST;                                         <<06097>>08715000
    INTEGER SAVEDST;                                           <<06097>>08720000
    ARRAY LDT(*) = DB+0;                                       <<07052>>08725000
    EQUATE INTRIN'DATA  = [10/86,6/3],                         <<06097>>08730000
           CHK'FLAG     = [8/0,2/0,1/0,5/3],                   <<06097>>08735000
           CHK'PARM     = [10/0,2/2,2/2,2/2],                  <<06097>>08740000
           ERREX        = [10/86,6/3];                         <<06097>>08745000
    EQUATE MAXOPTS=6,                                          <<06097>>08750000
           ARITRAP=15,                                         <<06097>>08755000
           CTLY   =18;                                         <<06097>>08760000
    INTEGER LDT'INDEX;                                         <<07052>>08765000
                                                               <<07052>>08770000
    EQUATE ERR1 = 1,  <<INVALID OPTION>>                       <<06097>>08775000
           ERR2 = 2,  <<INVALID TRAPTYPE>>                     <<06097>>08780000
           ERR3 = 3,  <<INVALID OLD'PLABEL ADDRESS>>           <<06097>>08785000
           ERR4 = 4,  <<INVALID OLD'MODE ADDRESS>>             <<06097>>08790000
           ERR5 = 5,  <<INVALID OLD'MASK ADDRESS>>             <<06097>>08795000
           ERR6 = 6,  <<INVALID MODE VALUE>>                   <<06097>>08800000
           ERR7 = 7,  <<INVALID TRAPLABEL>>                    <<06097>>08805000
           ERR8 = 8;  <<REQUIRED PARAMETER MISSING>>           <<06097>>08810000
                                                               <<06097>>08815000
    SUBROUTINE ADJUST'LDT;                                     <<06097>>08820000
      <<INSERT PIN INTO LDT>>                                  <<06097>>08825000
      BEGIN                                                    <<06097>>08830000
        SAVEDST := EXCHANGEDB(LDT'DST);                        <<07052>>08835000
        LDT'INDEX := STDIN * SIZE'OF'LDT'ENTRY;                <<07052>>08840000
        LDT'CONTROL'Y'PIN := PIN;                              <<07052>>08845000
        SAVEDST:=EXCHANGEDB(SAVEDST);                          <<06097>>08850000
      END; <<ADJUST'LDT>>                                      <<06097>>08855000
                                                               <<06097>>08860000
    LOGICAL SUBROUTINE SETTRAP;                                <<06097>>08865000
      <<CALL TRAPLABEL TO SET TRAP>>                           <<06097>>08870000
      BEGIN                                                    <<06097>>08875000
        SETTRAP:=TRUE;      <<INITIALIZE>>                     <<06097>>08880000
        CCODE:=TRAPLABEL(TRAPTYPE,MASK,PLABEL,OLD'MASK,        <<06097>>08885000
                    OLD'PLABEL,MODE);                          <<06097>>08890000
        IF CCODE=CCL THEN                                      <<06097>>08895000
          BEGIN         <<INVALID TRAP>>                       <<06097>>08900000
            ERROR:=ERR7;                                       <<06097>>08905000
            SETTRAP:=FALSE;                                    <<06097>>08910000
          END;                                                 <<06097>>08915000
      END; <<SETTRAP>>                                         <<06097>>08920000
                                                               <<06097>>08925000
    SUBROUTINE FIGURE'OPTIONS;                                 <<06097>>08930000
      <<FIGURE VALUES PASSED>>                                 <<06097>>08935000
      BEGIN                                                    <<06097>>08940000
        <<SET UP DEFAULT VALUES>>                              <<06097>>08945000
        TRAPTYPE:=-1;                                          <<06097>>08950000
        MASK:=-1;                                              <<06097>>08955000
        PLABEL:=-1;                                            <<06097>>08960000
        MODE:=-1;                                              <<06097>>08965000
        @OLD'PLABEL:=-1;                                       <<06097>>08970000
        @OLD'MASK:=-1;                                         <<06097>>08975000
        ENDOFLIST:=FALSE;                                      <<06097>>08980000
        <<CHECK VALUES PASSED>>                                <<06097>>08985000
        TEMP:=0;                                               <<06097>>08990000
        WHILE TEMP <= MAXOPTS AND                              <<06097>>08995000
              NOT ENDOFLIST DO                                 <<06097>>09000000
          BEGIN                                                <<06097>>09005000
            IF NOT (0<=OPTION'NUMS(TEMP)<=MAXOPTS) THEN        <<06097>>09010000
              BEGIN  <<INVALID OPTION NUMBER>>                 <<06097>>09015000
                ENDOFLIST:=TRUE;                               <<06097>>09020000
              END                                              <<06097>>09025000
             ELSE                                              <<06097>>09030000
              BEGIN  <<VALID OPTION NUMBER>>                   <<06097>>09035000
                CASE *OPTION'NUMS(TEMP) OF                     <<06097>>09040000
                 BEGIN                                         <<06097>>09045000
                 <<0>> ENDOFLIST:=TRUE;                        <<06097>>09050000
                 <<1>> IF TRAPTYPE = -1 THEN                   <<06097>>09055000
                         BEGIN <<1ST OCCURRENCE>>              <<06097>>09060000
                           TRAPTYPE:=OPTIONS(TEMP);            <<06097>>09065000
                           <<CHECK VALIDITY>>                  <<06097>>09070000
                           IF NOT (1<=TRAPTYPE<=4) THEN        <<06097>>09075000
                             BEGIN <<INVALID>>                 <<06097>>09080000
                               ERROR:=ERR2;                    <<06097>>09085000
                               GO RETURNERROR;                 <<06097>>09090000
                             END;                              <<06097>>09095000
                           TRAPTYPE:=TRAPTYPE+14; <<ADJUST>>   <<06097>>09100000
                         END                                   <<06097>>09105000
                        ELSE ENDOFLIST:=TRUE; <<2ND OCCURRENCE><<06097>>09110000
                 <<2>> IF MASK = -1                            <<06097>>09115000
                         THEN MASK:=OPTIONS(TEMP) <<1ST TIME>> <<06097>>09120000
                         ELSE ENDOFLIST:=TRUE;    <<2ND TIME>> <<06097>>09125000
                 <<3>> IF PLABEL = -1                          <<06097>>09130000
                         THEN PLABEL:=OPTIONS(TEMP)<<1ST TIME>><<06097>>09135000
                         ELSE ENDOFLIST:=TRUE;     <<2ND TIME>><<06097>>09140000
                 <<4>> IF MODE = -1 THEN                       <<06097>>09145000
                         BEGIN                     <<1ST TIME>><<06097>>09150000
                           MODE:=OPTIONS(TEMP);                <<06097>>09155000
                           <<CHECK VALIDITY>>                  <<06097>>09160000
                           IF MODE = 0 THEN                    <<06097>>09165000
                             BEGIN <<ORIGINAL CALL>>           <<06097>>09170000
                               MODE:= IF LOGICALMAPPING        <<06097>>09175000
                                        THEN 0                 <<06097>>09180000
                                        ELSE 1;                <<06097>>09185000
                             END                               <<06097>>09190000
                            ELSE                               <<06097>>09195000
                             BEGIN <<USING ENCODED MODE>>      <<06097>>09200000
                               IF MODE.(0:3) = 5 THEN          <<06097>>09205000
                                 BEGIN <<VALID ENCODED VALUE>> <<06097>>09210000
                                   MODE:=MODE.(15:1);          <<06097>>09215000
                                 END                           <<06097>>09220000
                                ELSE                           <<06097>>09225000
                                 BEGIN <<INVALID VALUE>>       <<06097>>09230000
                                   ERROR:=ERR6;                <<06097>>09235000
                                   GO RETURNERROR;             <<06097>>09240000
                                 END;                          <<06097>>09245000
                             END;                              <<06097>>09250000
                         END                                   <<06097>>09255000
                        ELSE ENDOFLIST:=TRUE;      <<2ND TIME>><<06097>>09260000
                 <<5>> IF @OLD'PLABEL = -1 THEN                <<06097>>09265000
                         BEGIN                     <<1ST TIME>><<06097>>09270000
                           @OLD'PLABEL:=OPTIONS(TEMP);         <<06097>>09275000
                           <<CHECK VALIDITY>>                  <<06097>>09280000
                           IF NOT (STK'LOLIM<=@OLD'PLABEL      <<06097>>09285000
                                            <=STK'HILIM) THEN  <<06097>>09290000
                             BEGIN <<INVALID ADDRESS>>         <<06097>>09295000
                               ERROR:=ERR3;                    <<06097>>09300000
                               GO RETURNERROR;                 <<06097>>09305000
                             END;                              <<06097>>09310000
                         END                                   <<06097>>09315000
                        ELSE ENDOFLIST:=TRUE;      <<2ND TIME>><<06097>>09320000
                 <<6>> IF @OLD'MASK = -1 THEN                  <<06097>>09325000
                         BEGIN                     <<1ST TIME>><<06097>>09330000
                           @OLD'MASK:=OPTIONS(TEMP);           <<06097>>09335000
                           <<CHECK VALIDITY>>                  <<06097>>09340000
                           IF NOT (STK'LOLIM<=@OLD'MASK        <<06097>>09345000
                                            <=STK'HILIM) THEN  <<06097>>09350000
                             BEGIN <<INVALID ADDRESS>>         <<06097>>09355000
                               ERROR:=ERR5;                    <<06097>>09360000
                               GO RETURNERROR;                 <<06097>>09365000
                             END;                              <<06097>>09370000
                         END                                   <<06097>>09375000
                        ELSE ENDOFLIST:=TRUE;      <<2ND TIME>><<06097>>09380000
                 END; <<CASES>>                                <<06097>>09385000
              END;                                             <<06097>>09390000
            TEMP:=TEMP+1;                                      <<06097>>09395000
          END; <<WHILE>>                                       <<06097>>09400000
        IF OPTION'NUMS(TEMP-1) <> 0 THEN                       <<06097>>09405000
          BEGIN <<INVALID OPTION>>                             <<06097>>09410000
            ERROR:=ERR1;                                       <<06097>>09415000
            GO RETURNERROR;                                    <<06097>>09420000
          END;                                                 <<06097>>09425000
        <<VERIFY REQUIRED PARAMETERS ARE PRESENT>>             <<06097>>09430000
        IF TRAPTYPE = -1 OR                                    <<06097>>09435000
           PLABEL   = -1 OR                                    <<06097>>09440000
           MODE     = -1 OR                                    <<06097>>09445000
           @OLD'PLABEL=-1 THEN                                 <<06097>>09450000
          BEGIN  <<PARAMETER MISSING>>                         <<06097>>09455000
            ERROR:=ERR8;                                       <<06097>>09460000
            GO RETURNERROR;                                    <<06097>>09465000
          END;                                                 <<06097>>09470000
        IF TRAPTYPE = ARITRAP AND                              <<06097>>09475000
           (MASK = -1 OR @OLD'MASK = -1) THEN                  <<06097>>09480000
          BEGIN  <<PARAMETER MISSING>>                         <<06097>>09485000
            ERROR:=ERR8;                                       <<06097>>09490000
            GO RETURNERROR;                                    <<06097>>09495000
          END;                                                 <<06097>>09500000
      END; <<FIGURE'OPTIONS>>                                  <<06097>>09505000
                                                               <<06097>>09510000
                                                               <<06097>>09515000
    ERRORON;                                                   <<06097>>09520000
    STK'LIMS:=CHEK'NOABORT(INTRIN'DATA,CHK'FLAG,               <<06097>>09525000
                               DOUBLE(CHK'PARM));              <<06097>>09530000
    FIGURE'OPTIONS;                                            <<06097>>09535000
    ERROR:=0;      <<INITIALIZE>>                              <<06097>>09540000
    STATUS.CCFLD:=CCE;                                         <<06097>>09545000
    IF TRAPTYPE <> CTLY THEN                                   <<06097>>09550000
      BEGIN        <<ARI/LIB/SYS TRAP>>                        <<06097>>09555000
        SETTRAP;                                               <<06097>>09560000
      END                                                      <<06097>>09565000
     ELSE                                                      <<06097>>09570000
      BEGIN        <<CTLY TRAP>>                               <<06097>>09575000
        IF CTLYTRAP'LEGAL(STDIN) THEN                          <<06097>>09580000
          BEGIN    <<PIN CAN SET CTLY TRAP>>                   <<06097>>09585000
            IF PLABEL <> 0 THEN                                <<06097>>09590000
              BEGIN <<ARMING TRAP>>                            <<06097>>09595000
                PIN:=PIX/PCBSIZE;                              <<06097>>09600000
                IF SETTRAP THEN                                <<06097>>09605000
                  BEGIN <<VALID TRAP>>                         <<06097>>09610000
                    ADJUST'LDT; <<PUT PIN IN LDT>>             <<06097>>09615000
                    IOCONTROL(STDIN,13);                       <<06097>>09620000
                  END;                                         <<06097>>09625000
              END                                              <<06097>>09630000
             ELSE                                              <<06097>>09635000
              BEGIN <<UNARMING TRAP>>                          <<06097>>09640000
                IOCONTROL(STDIN,12);                           <<06097>>09645000
                IF SETTRAP THEN ADJUST'LDT;                    <<06097>>09650000
              END;                                             <<06097>>09655000
          END                                                  <<06097>>09660000
         ELSE                                                  <<06097>>09665000
          BEGIN     <<PIN CANNOT SET CTLY TRAP>>               <<06097>>09670000
            ERROR:=ERR7                                        <<06097>>09675000
          END;                                                 <<06097>>09680000
      END;                                                     <<06097>>09685000
RETURNERROR:                                                   <<06097>>09690000
    IF ERROR <> 0 THEN STATUS.CCFLD:=CCL;                      <<06097>>09695000
    ERROREXIT(ERREX,0,0);                                      <<06097>>09700000
  END;                                                         <<06097>>09705000
$PAGE                                                                   09710000
                                                               <<B0.02>>09715000
PROCEDURE DEC'SIM'TRAP(TRAPNUM);                               <<B0.07>>09720000
  VALUE TRAPNUM;                                               <<B0.07>>09725000
  INTEGER TRAPNUM;                                             <<B0.07>>09730000
  OPTION PRIVILEGED;                                           <<B0.07>>09735000
                                                               <<B0.07>>09740000
BEGIN                                                          <<B0.07>>09745000
  COMMENT THIS PROCEDURE SIMULATES PROCEDURE TRAPS IN PASSING  <<B0.07>>09750000
    TRAPS FROM THE DECIMAL FIRMWARE SIMULATIONS TO PROCEDURE   <<B0.07>>09755000
    ABORT.  IT ASSUMES THE OPCODE AND SDEC ARE IN CERTAIN      <<B0.07>>09760000
    LOCATIONS Q-RELATIVE TO THE USER STACK MARKER.  THIS IS    <<B0.07>>09765000
    TAKEN ADVANTAGE OF BY POPPING THE TWO TOP STACK MARKERS    <<B0.07>>09770000
    BEFORE ACCESSING THIS DATA.                                <<B0.07>>09775000
    ;                                                          <<B0.07>>09780000
  INTEGER XREG=X,  <<INDEX REGISTER>>                          <<B0.07>>09785000
          DQ=Q+0,  <<DELTA Q>>                                 <<B0.07>>09790000
          PARAM=Q+1,   <<ERROR PARAMETER(OPCODE ON ENTRY)>>    <<B0.07>>09795000
          SDEC=Q+2,  <<SDEC IMPLICITLY PASSED BY FIRMWARESIM>> <<B0.07>>09800000
          TNUM=S-5;                                            <<B0.07>>09805000
  INTEGER ARRAY STACK(*)=Q+0;                                  <<B0.07>>09810000
  EQUATE TYPE=0,MARK=1,MODE=[8/MARK,8/TYPE];                   <<B0.07>>09815000
    TOS:=0D;  <<LOGICALCST RETURN>>                            <<06097>>09820000
    TOS:=STATUS.CSTFIELD;     <<CST #>>                        <<06097>>09825000
    TOS.(0:1):=IF LOGICALMAPPING THEN DELTAP.MAPFLAG ELSE 1;   <<06097>>09830000
    TOS:=LOGICALCST'(*,PIX);                                   <<06875>>09835000
  DEL;                                                         <<B0.07>>09840000
  IF TOS=SYSTEMSL THEN    <<CAME FROM FIRMWARESIM>>            <<B0.07>>09845000
    BEGIN                                                      <<B0.07>>09850000
      XREG:=-(STACK(-DQ)+DQ)-1;<<DISP TO USER SM>>             <<B0.07>>09855000
      TOS:=STACK(XREG);<<USER STATUS>>                         <<B0.07>>09860000
      ASSEMBLE(TBC 2);                                         <<B0.07>>09865000
      IF = THEN <<TRAPS OFF>>                                  <<B0.07>>09870000
        BEGIN                                                  <<B0.07>>09875000
          ASSEMBLE(TSBC 4);<<SET OVERFLOW>>                    <<B0.07>>09880000
          STACK(XREG):=TOS;<<REPLACE USER STATUS>>             <<B0.07>>09885000
          PUSH(Q);                                             <<B0.07>>09890000
          TOS:=TOS+XREG+1;<<RESET SM>>                         <<B0.07>>09895000
          SET(Q);                                              <<B0.07>>09900000
          TOS:=%31400+SDEC;                                    <<B0.07>>09905000
          ASSEMBLE(XEQ 0);                                     <<B0.07>>09910000
        END                                                    <<B0.07>>09915000
      ELSE                                                     <<B0.07>>09920000
        BEGIN    <<TRAPS ON>>                                  <<B0.07>>09925000
          DEL;   <<DELETE USER STATUS>>                        <<B0.07>>09930000
          PUSH(S,Q);                                           <<B0.07>>09935000
          TOS:=XREG+1;                                         <<B0.07>>09940000
          ASSEMBLE(DUP,CAB);                                   <<B0.07>>09945000
          TOS:=TOS+TOS;                                        <<B0.07>>09950000
          SET(Q);                                              <<B0.07>>09955000
          TOS:=TOS+TOS+1;  <<NEW S POINTER>>                   <<B0.07>>09960000
          XREG:=PARAM;                                         <<B0.07>>09965000
          PARAM:=TNUM;                                         <<B0.07>>09970000
          SET(S);                                              <<B0.07>>09975000
          ABORT(MODE,PARAM,0);                                 <<B0.07>>09980000
        END;                                                   <<B0.07>>09985000
    END;                                                       <<B0.07>>09990000
END; <<DEC'SIM'TRAP>>                                          <<B0.07>>09995000
$PAGE                                                                   10000000
                                                               <<B0.07>>10005000
PROCEDURE DEC'SIM'TRAP'(OPCODE,TRAPNUM);                       <<B0.07>>10010000
VALUE OPCODE,TRAPNUM;                                          <<B0.07>>10015000
INTEGER OPCODE,TRAPNUM;                                        <<B0.07>>10020000
OPTION PRIVILEGED;                                             <<B0.07>>10025000
BEGIN                                                          <<B0.07>>10030000
  COMMENT THIS PROCEDURE INTERFACES TRAPS COMING FROM DIVD,    <<B0.07>>10035000
    MPYD AND EDIT WITH THE REGULAR DECIMAL FIRMWARESIM         <<B0.07>>10040000
    TRAP MECHANISM.;                                           <<B0.07>>10045000
  INTEGER ARRAY STACK(*)=Q+0;                                  <<B0.07>>10050000
  INTEGER DQ=Q+0;  <<DELTA Q>>                                 <<B0.07>>10055000
  EQUATE TYPE=0, MARK=1;                                                10060000
  EQUATE SDECDISP=-4;<<DISPLACEMENT FROM USER SM TO SDEC>>     <<B0.07>>10065000
    TOS:=0D;  <<LOGICALCST RETURN>>                            <<06097>>10070000
    TOS:=STATUS.CSTFIELD;     <<CST #>>                        <<06097>>10075000
    TOS.(0:1):=IF LOGICALMAPPING THEN DELTAP.MAPFLAG ELSE 1;   <<06097>>10080000
    TOS:=LOGICALCST'(*,PIX);                                   <<06875>>10085000
  DEL;                                                         <<B0.07>>10090000
  IF TOS = SYSTEMSL THEN <<CAME FROM SYSTEM>>                  <<B0.07>>10095000
    BEGIN                                                      <<B0.07>>10100000
      STACK(-DQ+1):=OPCODE;                                    <<B0.07>>10105000
      STACK(-DQ+2):=STACK(-DQ+SDECDISP)&LSL(1)+1;              <<00.02>>10110000
      DEC'SIM'TRAP(TRAPNUM);                                   <<B0.07>>10115000
    END                                                        <<B0.07>>10120000
END; <<DEC'SIM'TRAP'>>                                         <<B0.07>>10125000
                                                               <<C0.00>>10130000
        <<--------------------->>                              <<C0.00>>10135000
        <<  S T A C K D U M P  >>                              <<C0.00>>10140000
        <<  R O U T I N E S    >>                              <<C0.00>>10145000
        <<--------------------->>                              <<C0.00>>10150000
                                                               <<C0.00>>10155000
                                                               <<C0.00>>10160000
PROCEDURE REGIST(SX,BOUTBUF);                                  <<C0.00>>10165000
                VALUE SX;                                      <<C0.00>>10170000
                INTEGER SX;                                    <<C0.00>>10175000
                BYTE ARRAY BOUTBUF;                            <<C0.00>>10180000
                OPTION PRIVILEGED,UNCALLABLE;                  <<C0.00>>10185000
BEGIN                                                          <<C0.00>>10190000
    COMMENT:                                                   <<C0.00>>10195000
    << GETS S, DL, AND Z REGS FROM MARKER LOCATED AT SX AND    <<C0.00>>10200000
    << FORMATS THEM IN OUTPUT BUFFER BOUTBUF;                  <<C0.00>>10205000
                                                               <<C0.00>>10210000
    MOVE BOUTBUF _ "S=";                                                10215000
    ASCII(SX-4,8,BOUTBUF(2));                                  <<C0.00>>10220000
    MOVE BOUTBUF(12):="DL=";                                   <<C0.00>>10225000
    TOS:=0D;                                                   <<C0.00>>10230000
    PUSH(DL);                                                  <<C0.00>>10235000
    ASCII(*,8,BOUTBUF(15));                                    <<C0.00>>10240000
    MOVE BOUTBUF(25):="Z=";                                    <<C0.00>>10245000
    PUSH(Z);                                                   <<C0.00>>10250000
    ASCII(*,8,BOUTBUF(27));                                    <<C0.00>>10255000
END  <<PROCEDURE REGIST>>;                                     <<C0.00>>10260000
                                                               <<C0.00>>10265000
                                                               <<C0.00>>10270000
<<--------------------------------------------------------------->>     10275000
                                                               <<C0.00>>10280000
                                                               <<C0.00>>10285000
PROCEDURE MARKER(P,BOUTBUF);                                   <<C0.00>>10290000
                VALUE P;                                       <<C0.00>>10295000
                INTEGER P;                                     <<C0.00>>10300000
                BYTE ARRAY BOUTBUF;                            <<C0.00>>10305000
                OPTION PRIVILEGED,UNCALLABLE;                  <<C0.00>>10310000
BEGIN                                                          <<C0.00>>10315000
    COMMENT:                                                   <<C0.00>>10320000
    << EXTRACTS CONTENT OF MARKER POINTED TO BY P AND FORMATS  <<C0.00>>10325000
    << IT IN OUTPUT BUFFER BOUTBUF.                            <<C0.00>>10330000
    <<                                                         <<C0.00>>10335000
    << RETURNS CCL IF CST IS INVALID;                          <<C0.00>>10340000
                                                               <<C0.00>>10345000
  BYTE ARRAY SD(0:12)=PB:="PU1010RL1010";                      <<C0.00>>10350000
  BYTE ARRAY CC(0:12)=PB:="CCGCCLCCE 3 ";                      <<C0.00>>10355000
  ARRAY STACK(*)=DB+0;                                         <<C0.00>>10360000
  INTEGER DQ=Q+0,                                              <<C0.00>>10365000
          X,                                                   <<C0.00>>10370000
          V;                                                   <<C0.00>>10375000
                                                               <<C0.00>>10380000
          <<-------------------->>                             <<C0.00>>10385000
                                                               <<C0.00>>10390000
    MOVE BOUTBUF _ "Q=";                                                10395000
    ASCII(P,8,BOUTBUF(2));                                     <<C0.00>>10400000
    MOVE BOUTBUF(9):="P=";                                     <<C0.00>>10405000
    ASCII(STACK(P-2).(2:14)-1,8,BOUTBUF(11));                  <<06097>>10410000
    TOS:=0D;       <<LOGICALCST RETURN>>                       <<06097>>10415000
    TOS:=STACK(P-1).(8:8);  <<CST #>>                          <<06097>>10420000
   TOS.(0:1):=IF LOGICALMAPPING THEN STACK(P-2).MAPFLAG ELSE 1;<<06097>>10425000
    TOS:=LOGICALCST'(*,PIX);                                   <<06875>>10430000
    IF < THEN                                                  <<C0.00>>10435000
      BEGIN                                                    <<C0.00>>10440000
        STATUS.CCFLD _ CCL;                                             10445000
        RETURN;                                                <<C0.00>>10450000
      END;                                                     <<C0.00>>10455000
    ASSEMBLE(ZERO,XCH);                                        <<C0.00>>10460000
    TOS:=ASCII(*,8,BOUTBUF(23));                               <<C0.00>>10465000
    ASSEMBLE(DEL);                                             <<C0.00>>10470000
    MOVE BOUTBUF(19):="LCST= ";                                <<C0.00>>10475000
    IF S0 = PROGSEGTYPE THEN                                   <<06097>>10480000
      BEGIN        <<LIB SOURCE = PROG FILE>>                  <<06097>>10485000
        ASSEMBLE(DEL);                                         <<06097>>10490000
        TOS:=" ";                                              <<06097>>10495000
      END                                                      <<06097>>10500000
     ELSE                                                      <<06097>>10505000
      BEGIN        <<LIB SOURCE = SL>>                         <<06097>>10510000
        CASE TOS OF                                            <<06097>>10515000
          BEGIN                                                <<06097>>10520000
            <<0>> TOS:="S";                                    <<06097>>10525000
            <<1>> TOS:="P";                                    <<06097>>10530000
            <<2>> TOS:="G";                                    <<06097>>10535000
          END;                                                 <<06097>>10540000
      END;                                                     <<06097>>10545000
    BOUTBUF(25):=TOS;                                          <<C0.00>>10550000
                                                               <<C0.00>>10555000
    MOVE BOUTBUF(31):="STAT= , , , , , ,   ";                  <<C0.00>>10560000
    TOS:=STACK(P-1);                                           <<C0.00>>10565000
    V:=-1;                                                     <<C0.00>>10570000
    WHILE (V:=V+1)<=5 DO                                       <<C0.00>>10575000
    BEGIN                                                      <<C0.00>>10580000
      ASSEMBLE(TEST);                                          <<C0.00>>10585000
      X:= IF < THEN 2*V ELSE 2*V+1;                            <<C0.00>>10590000
      MOVE BOUTBUF(36+2*V):=SD(X),(1);                         <<C0.00>>10595000
      TOS:=TOS&LSL(1);                                         <<C0.00>>10600000
    END;                                                       <<C0.00>>10605000
                                                               <<C0.00>>10610000
    V:=TOS&LSR(14);                                            <<C0.00>>10615000
    MOVE BOUTBUF(48):=CC(V*3),(3);                             <<C0.00>>10620000
    MOVE BOUTBUF(54):="X=";                                    <<C0.00>>10625000
    ASCII(STACK(P-3),8,BOUTBUF(56));                           <<C0.00>>10630000
    STATUS.CCFLD _ CCE;                                                 10635000
END  <<PROCEDURE MARKER>>;                                     <<C0.00>>10640000
                                                               <<C0.00>>10645000
                                                               <<C0.00>>10650000
<<--------------------------------------------------------------->>     10655000
                                                               <<C0.00>>10660000
                                                               <<C0.00>>10665000
PROCEDURE STACKDUMP(FILEN,IDNUMBER,FLAG ,SELEC);               <<C0.00>>10670000
                   BYTE ARRAY FILEN;                           <<C0.00>>10675000
                   INTEGER IDNUMBER;                           <<C0.00>>10680000
                   LOGICAL FLAG;                               <<C0.00>>10685000
                   DOUBLE ARRAY SELEC;                         <<C0.00>>10690000
                   OPTION PRIVILEGED,VARIABLE;                 <<C0.00>>10695000
BEGIN                                                          <<C0.00>>10700000
    COMMENT:                                                   <<C0.00>>10705000
    << INTRINSIC #77.                                          <<C0.00>>10710000
    << DUMPS STACK ACCORDING TO SPECS;                         <<C0.00>>10715000
                                                               <<C0.00>>10720000
  ENTRY STACKDUMP';                                            <<C0.00>>10725000
                                                               <<C0.00>>10730000
  EQUATE JSTL=4;               <<JOB $STDLIST IN PCBX>>                 10735000
  ARRAY OUTB(0:128);                                           <<C0.00>>10740000
  BYTE ARRAY BOUTB(*)=OUTB;                                    <<C0.00>>10745000
  INTEGER XREG=X,                                                       10750000
          STAT=Q-1,                                            <<C0.00>>10755000
          FN,                                                  <<C0.00>>10760000
          CC,                                                  <<C0.00>>10765000
          RECSIZE,                                             <<C0.00>>10770000
          PCBGLOBLOC,                                          <<06664>>10775000
          ERRCODE:=77;                                         <<C0.00>>10780000
  LOGICAL VAR=Q-4,                                             <<C0.00>>10785000
          PF:=FALSE,                                           <<C0.00>>10790000
          PXFIXEDLOC,                                          <<06664>>10795000
          FOPTIONS,                                            <<C0.00>>10800000
          AOPTIONS;                                            <<C0.00>>10805000
  INTEGER ADUM=Q-7,                                            <<C0.00>>10810000
          DUMMY,                                               <<C0.00>>10815000
          LDT'INDEX,                                           <<07052>>10820000
          SX;                                                  <<C0.00>>10825000
  ARRAY LDT(*)=DB+0,                                           <<C0.00>>10830000
        QARRAY(*)=Q+0,                                         <<06664>>10835000
        WINT(0:40);                      <<TEMPORARY>>         <<C0.00>>10840000
  LOGICAL FLAGS;                                               <<C0.00>>10845000
  BYTE ARRAY TIT(0:50)=PB:=                                    <<C0.00>>10850000
      "***      STACK  DISPLAY      ***          ID #      ";  <<C0.00>>10855000
  INTEGER ARRAY ST(*)=DB+0;                                    <<C0.00>>10860000
  INTEGER S0=S-0,                                              <<C0.00>>10865000
          S1=S-1,                                              <<C0.00>>10870000
          S2=S-2,                                              <<C0.00>>10875000
          V,                                                   <<C0.00>>10880000
          T,                                                   <<C0.00>>10885000
          W,                                                   <<C0.00>>10890000
          DSTX;                                                <<C0.00>>10895000
  LOGICAL SBF;                                                 <<C0.00>>10900000
  INTEGER QR,                                                  <<C0.00>>10905000
          QIN,                                                 <<02341>>10910000
          SR,                                                  <<C0.00>>10915000
          DBAD,                                                <<C0.00>>10920000
          COUNT,                                               <<C0.00>>10925000
          LBOUND,                                              <<C0.00>>10930000
          UBOUND;                                              <<C0.00>>10935000
  LOGICAL AREAF;                                               <<C0.00>>10940000
  INTEGER ENVIR:=0,                                            <<C0.00>>10945000
          LKOUNT,                                              <<C0.00>>10950000
          PX;                                                  <<C0.00>>10955000
  DOUBLE BOUNDS=LBOUND;                                        <<C0.00>>10960000
  LOGICAL AF:=TRUE;                                            <<C0.00>>10965000
  INTEGER CURSELX:=-1,                                         <<C0.00>>10970000
          LIM,                                                 <<C0.00>>10975000
          WPL,                                                 <<C0.00>>10980000
          L1,                                                  <<C0.00>>10985000
          L2,                                                  <<C0.00>>10990000
          L3;                                                  <<C0.00>>10995000
  ARRAY IS(0:1);                                               <<C0.00>>11000000
  BYTE ARRAY BIS(*)=IS;                                        <<C0.00>>11005000
  INTEGER OT,                                                  <<C0.00>>11010000
          LINES,                                               <<C0.00>>11015000
          CW,                                                  <<C0.00>>11020000
          CL;                                                  <<C0.00>>11025000
  LOGICAL UF;                                                  <<C0.00>>11030000
  BYTE ARRAY MAD(0:20)=PB:="..DB.. ..Q... ..S... ";            <<C0.00>>11035000
  DEFINE CCL= < #,                                             <<C0.00>>11040000
         CCG= > #,                                             <<C0.00>>11045000
         CCE= = #;                                             <<C0.00>>11050000
                                                               <<C0.00>>11055000
          <<-------------------->>                             <<C0.00>>11060000
                                                               <<C0.00>>11065000
  SUBROUTINE FILERR;                                           <<C0.00>>11070000
  BEGIN                                                        <<C0.00>>11075000
    IF PF THEN IDNUMBER:=0                                     <<C0.00>>11080000
      ELSE FCHECK(FN,IDNUMBER);                                <<C0.00>>11085000
    CC:=1;                                                     <<C0.00>>11090000
    GO FINI;                                                   <<C0.00>>11095000
  END  <<SUBROUTINE FILERR>>;                                  <<C0.00>>11100000
                                                               <<C0.00>>11105000
          <<-------------------->>                             <<C0.00>>11110000
                                                               <<C0.00>>11115000
  SUBROUTINE CLEARBUF;                                         <<C0.00>>11120000
  BEGIN                                                        <<C0.00>>11125000
        COMMENT:                                               <<C0.00>>11130000
        << CLEARS THE OUTPUT BUFFER;                           <<C0.00>>11135000
    OUTB:="  ";                                                <<C0.00>>11140000
    MOVE OUTB(1):=OUTB,(RECSIZE&LSR(1));                       <<C0.00>>11145000
  END  <<SUBROUTINE CLEARBUF>>;                                <<C0.00>>11150000
                                                               <<C0.00>>11155000
          <<-------------------->>                             <<C0.00>>11160000
                                                               <<C0.00>>11165000
  SUBROUTINE WRITE(N);                                         <<C0.00>>11170000
                  VALUE N;                                     <<C0.00>>11175000
                  INTEGER N;                                   <<C0.00>>11180000
  BEGIN                                                        <<C0.00>>11185000
        COMMENT:                                               <<C0.00>>11190000
        << WRITES ON OUTPUT FILE N BYTES FROM OUTPUT BUFFER;   <<C0.00>>11195000
    IF PF THEN PRINT(OUTB,-N,0) ELSE FWRITE(FN,OUTB,-N,0);     <<C0.00>>11200000
    IF <> THEN FILERR;                                         <<C0.00>>11205000
    CLEARBUF;                                                  <<C0.00>>11210000
  END  <<SUBROUTINE WRITE>>;                                   <<C0.00>>11215000
                                                               <<C0.00>>11220000
          <<-------------------->>                             <<C0.00>>11225000
                                                               <<C0.00>>11230000
  LOGICAL SUBROUTINE STCHK;                                    <<C0.00>>11235000
  BEGIN                                                        <<C0.00>>11240000
        COMMENT:                                               <<C0.00>>11245000
        << TESTS DBAD AND COUND AGAINST STACK BOUNDS.          <<C0.00>>11250000
        << RETURNS TRUE IF OK;                                 <<C0.00>>11255000
    STCHK:=TRUE;                                               <<C0.00>>11260000
    IF NOT(LBOUND<=DBAD) LOR NOT (DBAD+COUNT<=UBOUND) THEN     <<C0.00>>11265000
      BEGIN                                  <<OUT OF BOUNDS>> <<C0.00>>11270000
        SBF:=FALSE;                                            <<C0.00>>11275000
        IF (DBAD+COUNT<LBOUND) LOR (DBAD>UBOUND) THEN STCHK:=FALSE      11280000
          ELSE BEGIN                                           <<C0.00>>11285000
 AJ:                                                           <<C0.00>>11290000
            IF DBAD+COUNT>UBOUND THEN COUNT:=UBOUND-DBAD;      <<C0.00>>11295000
            IF DBAD<LBOUND THEN                                <<C0.00>>11300000
              BEGIN                                            <<C0.00>>11305000
                DBAD:=LBOUND;                                  <<C0.00>>11310000
                GOTO AJ;                                       <<C0.00>>11315000
              END;                                             <<C0.00>>11320000
          END;                                                 <<C0.00>>11325000
      END;                                                     <<C0.00>>11330000
  END  <<LOGICAL SUBROUTINE STCHK>>;                           <<C0.00>>11335000
                                                               <<C0.00>>11340000
          <<-------------------->>                             <<C0.00>>11345000
                                                               <<C0.00>>11350000
  SUBROUTINE TITLE;                                            <<C0.00>>11355000
  BEGIN                                                        <<C0.00>>11360000
        COMMENT:                                               <<C0.00>>11365000
        << OUTPUTS MAIN TITLE FOR STACKDUMP;                   <<C0.00>>11370000
    IF PF THEN PRINT(OUTB,0,%61) ELSE FWRITE(FN,OUTB,0,%61);   <<C0.00>>11375000
    IF <> THEN FILERR;                                         <<C0.00>>11380000
    SX:=(RECSIZE-53)&LSR(2);                                   <<00867>>11385000
    CLEARBUF;                                                  <<C0.00>>11390000
    MOVE BOUTB(SX):=TIT(0),(50);                               <<C0.00>>11395000
    IF VAR.(13:1) THEN ASCII(IDNUMBER,10,BOUTB(SX+47))         <<C0.00>>11400000
      ELSE MOVE BOUTB(SX+42):="    ";                          <<C0.00>>11405000
    WRITE(53+SX);                                              <<00867>>11410000
    IF PF THEN PRINT(OUTB,0,%202) ELSE FWRITE(FN,OUTB,0,%202); <<C0.00>>11415000
    IF <> THEN FILERR;                                         <<C0.00>>11420000
  END  <<SUBROUTINE TITLE>>;                                   <<C0.00>>11425000
                                                               <<C0.00>>11430000
                                                               <<C0.00>>11435000
          <<-------------------->>                             <<C0.00>>11440000
                                                               <<C0.00>>11445000
SUBROUTINE FORMATDP(ADMODE);                                   <<C0.00>>11450000
                   VALUE ADMODE;                               <<C0.00>>11455000
                   INTEGER ADMODE;                             <<C0.00>>11460000
  BEGIN                                                        <<C0.00>>11465000
        COMMENT:                                               <<C0.00>>11470000
        << ADMODE=0 -- DB                                      <<C0.00>>11475000
        <<        4 -- DS                                      <<C0.00>>11480000
        <<        1 -- Q                                       <<C0.00>>11485000
        <<        2 -- S                                       <<C0.00>>11490000
        << FIGURES OUT FORMATTING OF OUTPUT RECORD USING       <<C0.00>>11495000
        << FOLLOWING RULES:                                    <<C0.00>>11500000
        <<   1) COMPUTES MAXIMUM NUMBER OF WORDS PER LINE (WPL)<<C0.00>>11505000
        <<   2) SETS TAB MARKS FOR ADDRESSINGG, OCTAL AND ASCII<<C0.00>>11510000
        <<      DUMPS, AND NUMBER BLANKS BETWEEN AREADS        <<C0.00>>11515000
        <<   3) PRINTS FIRST LINE OF AREA;                     <<C0.00>>11520000
    T:=IF ADMODE.(14:2)=0 THEN 8                               <<C0.00>>11525000
       ELSE IF ADMODE.(14:2)=1 THEN 15 ELSE 22;                <<C0.00>>11530000
    V := IF FLAGS.(15:1)  THEN 7  ELSE 10;                     <<02341>>11535000
    WPL:=(((RECSIZE-T)/V)&LSR(2))&LSL(2);                      <<C0.00>>11540000
    T:=                                                        <<C0.00>>11545000
       (WPL*7-1) +                                             <<C0.00>>11550000
       (IF NOT FLAGS.(15:1)  THEN WPL*3-1  ELSE 4) +           <<02341>>11555000
       ((ADMODE.(14:2)+1)*7) ;                                 <<C0.00>>11560000
                                                               <<C0.00>>11565000
    IF NOT FLAGS.(15:1)  THEN         <<ASCII>>                <<02341>>11570000
      BEGIN                                                    <<C0.00>>11575000
        V:=(RECSIZE-2-T)&LSR(2);                               <<C0.00>>11580000
        L1:=V;                                                 <<C0.00>>11585000
        L2:=L1+(ADMODE.(14:2)+1)*7+2+V;                        <<C0.00>>11590000
        L3:=L2+WPL*7-1+V;                                      <<C0.00>>11595000
      END                                                      <<C0.00>>11600000
      ELSE BEGIN                                               <<C0.00>>11605000
        V:=(RECSIZE-T-2)/3;                                    <<C0.00>>11610000
        L1:=V;                                                 <<C0.00>>11615000
        L2:=L1+(ADMODE.(14:2)+1)*7+2+V;                        <<C0.00>>11620000
        L3:=0;                                                 <<C0.00>>11625000
      END;                                                     <<C0.00>>11630000
                                                               <<C0.00>>11635000
          <<OUTPUT TITLE FOR THE AREA>>                        <<C0.00>>11640000
                                                               <<C0.00>>11645000
    MOVE BOUTB(L1):=MAD(0),                                    <<C0.00>>11650000
                    ((ADMODE.(14:2)+1)*7);                     <<C0.00>>11655000
    IF ADMODE=4 THEN                                           <<C0.00>>11660000
      BEGIN                                                    <<C0.00>>11665000
        MOVE BOUTB(L1+3):="S.. #";             <<DATA SEGMENT>><<C0.00>>11670000
        ASCII(DSTX,10,BOUTB(L1+10));                           <<C0.00>>11675000
      END;                                                     <<C0.00>>11680000
    MOVE BOUTB(T:=L2+(WPL*7-1)&LSR(1)-3):="OCTAL";             <<C0.00>>11685000
    IF NOT (FLAGS.(15:1)) THEN                                 <<02341>>11690000
    MOVE BOUTB(T:=L3+(WPL*3-1)&LSR(1)-3):="ASCII";             <<C0.00>>11695000
    WRITE(T+6);                  <<WRITE FORMAT TITLE>>        <<C0.00>>11700000
  END  <<SUBROUTINE FORMATDP>>;                                <<C0.00>>11705000
                                                               <<C0.00>>11710000
          <<--------------------->>                            <<C0.00>>11715000
                                                               <<C0.00>>11720000
  SUBROUTINE TRCBCK;                                           <<C0.00>>11725000
  BEGIN                                                        <<C0.00>>11730000
        COMMENT:                                               <<C0.00>>11735000
        << OUTPUTS TRACE BACK OF STACK;                        <<C0.00>>11740000
    SX:=QR;                                                    <<C0.00>>11745000
    UF:= IF ST(SX-1)>0 THEN TRUE ELSE FALSE;                   <<C0.00>>11750000
    WHILE SX > QIN DO                                          <<02341>>11755000
    BEGIN                                                      <<C0.00>>11760000
      IF (ST(SX-1)<0) LAND UF THEN RETURN;                     <<C0.00>>11765000
      MARKER(SX,BOUTB((RECSIZE-60)&LSR(1)));                   <<C0.00>>11770000
      IF CCL  OR  (ST(SX) < 4) THEN GO ER;                     <<02341>>11775000
      WRITE((RECSIZE+2)&LSR(1)+31);          <<OUPUT RECORD>>  <<C0.00>>11780000
      SX := SX - ST(SX);                                       <<02341>>11785000
    END;                                                       <<C0.00>>11790000
    IF PF THEN PRINT(OUTB,0,%203) ELSE FWRITE(FN,OUTB,0,%203); <<C0.00>>11795000
    IF <> THEN FILERR;                                         <<C0.00>>11800000
    RETURN;                                                    <<C0.00>>11805000
                                                               <<C0.00>>11810000
 ER:                                                           <<C0.00>>11815000
    MOVE BOUTB((RECSIZE-60)&LSR(1)):="ILLEGAL MARKER";         <<C0.00>>11820000
    WRITE(RECSIZE&LSR(1)-15);              <<OUTPUT>>          <<C0.00>>11825000
  END  <<SUBROUTINE TRCBCK>>;                                  <<C0.00>>11830000
                                                               <<C0.00>>11835000
          <<-------------------->>                             <<C0.00>>11840000
                                                               <<C0.00>>11845000
  SUBROUTINE CONVERTAD(NUM,INDX);                              <<C0.00>>11850000
                      VALUE NUM,INDX;                          <<C0.00>>11855000
                      INTEGER NUM,INDX;                        <<C0.00>>11860000
  BEGIN                                                        <<C0.00>>11865000
        COMMENT:                                               <<C0.00>>11870000
        << CONVERTS INTO OCTAL AND DEPOSITS NUMBER INTO        <<C0.00>>11875000
        << LOCATION SPECIFIED BY INDX;                         <<C0.00>>11880000
    ASCII(IF NUM>=0 THEN NUM ELSE -NUM,8,BOUTB(INDX));         <<C0.00>>11885000
    BOUTB(INDX):=IF NUM<0 THEN "-" ELSE " ";                   <<C0.00>>11890000
  END  <<SUBROUTINE CONVERTAD>>;                               <<C0.00>>11895000
                                                               <<C0.00>>11900000
          <<-------------------->>                             <<C0.00>>11905000
                                                               <<C0.00>>11910000
  SUBROUTINE DUMPASCII(DBADR,COUNT,BUFX);                      <<C0.00>>11915000
                      VALUE DBADR,COUNT,BUFX;                  <<C0.00>>11920000
                      INTEGER DBADR,COUNT,BUFX;                <<C0.00>>11925000
  BEGIN                                                        <<C0.00>>11930000
        COMMENT:                                               <<C0.00>>11935000
        << DUMP "COUNT" WORDS IN SPECIFIED AREA;               <<C0.00>>11940000
    V:=0;                                                      <<C0.00>>11945000
    WHILE (V:=V+1)<=COUNT DO                                   <<C0.00>>11950000
    BEGIN                                                      <<C0.00>>11955000
      IS(0):=ST(DBADR);                                        <<C0.00>>11960000
                                                               <<C0.00>>11965000
          << NOT PRINTABLE CHARACTERS>>                        <<C0.00>>11970000
                                                               <<C0.00>>11975000
      XREG:=-1;                                                <<C0.00>>11980000
      WHILE (XREG:=XREG+1)<2 DO                                <<C0.00>>11985000
      IF BIS(XREG)<%40 OR BIS(XREG)>%172 THEN BIS(XREG):=".";  <<C0.00>>11990000
      MOVE BOUTB(L3+BUFX):=BIS(0),(2);                         <<C0.00>>11995000
      BOUTB(L3+(BUFX:=BUFX+2)):=" ";         <<SEPARATION>>    <<C0.00>>12000000
      BUFX:=BUFX+1;                                            <<C0.00>>12005000
      DBADR:=DBADR+1;                                          <<C0.00>>12010000
    END;                                                       <<C0.00>>12015000
  END  <<SUBROUTINE DUMPASCII>>;                               <<C0.00>>12020000
                                                               <<C0.00>>12025000
          <<-------------------->>                             <<C0.00>>12030000
                                                               <<C0.00>>12035000
  SUBROUTINE DUMPOCTAL(DBADR,COUNT,BUFX);                      <<C0.00>>12040000
                      VALUE DBADR,COUNT,BUFX;                  <<C0.00>>12045000
                      INTEGER DBADR,COUNT,BUFX;                <<C0.00>>12050000
  BEGIN                                                        <<C0.00>>12055000
        COMMENT:                                               <<C0.00>>12060000
        << DUMPS "COUNT" WORDS LOCATED IN DBADR IN STACK AND   <<C0.00>>12065000
        << PUTS THEM IN OUTPUT BUFFER.  ALL SEPARATED BY       <<C0.00>>12070000
        << BLANKS;                                             <<C0.00>>12075000
    V:=0;                                                      <<C0.00>>12080000
    WHILE (V:=V+1)<=COUNT DO                                   <<C0.00>>12085000
    BEGIN                                                      <<C0.00>>12090000
      ASCII(ST(DBADR),8,BOUTB(L2+BUFX));                       <<C0.00>>12095000
      DBADR:=DBADR+1;                                          <<C0.00>>12100000
      BUFX:=BUFX+7;                                            <<C0.00>>12105000
    END;                                                       <<C0.00>>12110000
                                                               <<C0.00>>12115000
  END;   <<DUMPOCTAL>>                                         <<C0.00>>12120000
                                                               <<C0.00>>12125000
          <<-------------------->>                             <<C0.00>>12130000
                                                               <<C0.00>>12135000
  SUBROUTINE SETAD(ADMODE,DBAD);                               <<C0.00>>12140000
                  VALUE ADMODE,DBAD;                           <<C0.00>>12145000
                  INTEGER ADMODE,DBAD;                         <<C0.00>>12150000
  BEGIN                                                        <<C0.00>>12155000
        COMMENT:                                               <<C0.00>>12160000
        << ADMODE= 0 (DB), 4 (DS), 1 (Q), 2 (S)                <<C0.00>>12165000
        << CONVERTS ADDRESSES AND DEPOSITS THEM IN OUTPUT      <<C0.00>>12170000
        << BUFFER IN L1 AREA;                                  <<C0.00>>12175000
    ADMODE:=ADMODE.(14:2);                 <<DB,Q & S>>        <<C0.00>>12180000
    CONVERTAD(DBAD,L1);                                        <<C0.00>>12185000
    IF ADMODE>=1 THEN CONVERTAD(DBAD-QR,L1+7);                 <<C0.00>>12190000
    IF ADMODE>=2 THEN CONVERTAD(DBAD-SR,L1+14);                <<C0.00>>12195000
  END  <<SUBROUTINE SETAD>>;                                   <<C0.00>>12200000
                                                               <<C0.00>>12205000
          <<-------------------->>                             <<C0.00>>12210000
                                                               <<C0.00>>12215000
  SUBROUTINE DUMP(ADMODE);                                     <<C0.00>>12220000
                 VALUE ADMODE;                                 <<C0.00>>12225000
                 INTEGER ADMODE;                               <<C0.00>>12230000
  BEGIN                                                        <<C0.00>>12235000
    SBF:=TRUE;                                                 <<C0.00>>12240000
    FORMATDP(ADMODE);                                          <<00599>>12245000
    IF ADMODE<4 AND NOT STCHK THEN BEGIN CC:=0;GO ARRET; END;  <<C0.00>>12250000
    IF ADMODE=4 THEN BEGIN PUSH(Q,S);W:=TOS-TOS;END;           <<C0.00>>12255000
                                                               <<C0.00>>12260000
        <<COMPUTE NUMBER OF LINES IN AREA>>                    <<C0.00>>12265000
                                                               <<C0.00>>12270000
    TOS:=IF ADMODE.(14:2)=0 THEN DBAD                          <<C0.00>>12275000
         ELSE IF ADMODE.(14:2)=1 THEN DBAD-QR ELSE DBAD-SR;    <<C0.00>>12280000
    ASSEMBLE(ZERO,XCH);                                        <<C0.00>>12285000
    TOS:=WPL;                                                  <<C0.00>>12290000
    ASSEMBLE(LDIV,DELB);                                       <<C0.00>>12295000
    OT:=TOS;         <<WORD OFFSET IN LINE>>                   <<C0.00>>12300000
                                                               <<C0.00>>12305000
        <<COMPUTE OFFSET IN FIRST LINE>>                       <<C0.00>>12310000
                                                               <<C0.00>>12315000
    TOS:=COUNT;                                                <<C0.00>>12320000
    IF= THEN BEGIN ASSEMBLE(DEL);RETURN;END;<<SKIP>>           <<C0.00>>12325000
    TOS:=WPL;                                                  <<C0.00>>12330000
    ASSEMBLE(DIV,TEST);<<TEST REMAINDER>>                      <<C0.00>>12335000
    IF = THEN                                                  <<C0.00>>12340000
      BEGIN                                                    <<C0.00>>12345000
        ASSEMBLE(DEL);                                         <<C0.00>>12350000
        IF OT<>0 THEN TOS:=TOS+1;  <<MORE LINES>>              <<C0.00>>12355000
      END                                                      <<C0.00>>12360000
      ELSE BEGIN            <<REMAINDER NON 0>>                <<C0.00>>12365000
        S1:=S1+1;  <<INCREASE LINE # BY 1>>                    <<C0.00>>12370000
        IF TOS>WPL-OT THEN TOS:=TOS+1;                         <<C0.00>>12375000
      END;                                                     <<C0.00>>12380000
    LINES:=TOS;                                                <<C0.00>>12385000
    CW:=0;           <<INITIALIZE>>                            <<C0.00>>12390000
    CL:=0;            <<CURRENT LINES>>                        <<C0.00>>12395000
    WHILE (CL:=CL+1)<=LINES DO                                 <<C0.00>>12400000
    BEGIN                                                      <<C0.00>>12405000
      SETAD(ADMODE,DBAD);                                      <<C0.00>>12410000
      IF CL=1 THEN       <<FIRST LINE>>                        <<C0.00>>12415000
      BEGIN                                                    <<C0.00>>12420000
        IF DBAD=0 THEN OT:=0;                                  <<C0.00>>12425000
      END                                                      <<C0.00>>12430000
      ELSE OT:=0;                                              <<C0.00>>12435000
                                                               <<C0.00>>12440000
      <<COMPUTATION OF THE COUNT TO BE OUPT>>                  <<C0.00>>12445000
                                                               <<C0.00>>12450000
      LKOUNT:=IF CL=LINES THEN COUNT-CW ELSE                   <<C0.00>>12455000
      IF CL=1 THEN LKOUNT:=WPL-OT ELSE WPL;                    <<C0.00>>12460000
      IF ADMODE=4 THEN SBF:=NOT DMOVE'(DSTX,DBAD,LKOUNT,@WINT,TRUE,W);  12465000
      DUMPOCTAL(IF ADMODE=4 THEN @WINT ELSE DBAD,LKOUNT,OT*7); <<C0.00>>12470000
      IF NOT FLAGS.(15:1) THEN                                 <<02341>>12475000
          DUMPASCII(IF ADMODE=4 THEN @WINT ELSE DBAD,LKOUNT,OT*3);      12480000
      CW:=CW+LKOUNT;                                           <<C0.00>>12485000
      DBAD:=DBAD+LKOUNT;                                       <<C0.00>>12490000
      WRITE(IF FLAGS.(15:1)  THEN L2+WPL*7  ELSE L3+WPL*3);    <<02341>>12495000
      IF (ADMODE=4 LAND NOT SBF) THEN GO ARRET;                <<C0.00>>12500000
    END;                                                       <<C0.00>>12505000
  ARRET:                                                       <<C0.00>>12510000
    IF NOT SBF THEN                                            <<C0.00>>12515000
      BEGIN                                                    <<C0.00>>12520000
        MOVE BOUTB(L1):="** AREA OUT OF BOUNDS **";WRITE(L1+24);        12525000
        CC:=0;             <<CCG>>                             <<C0.00>>12530000
      END;                                                     <<C0.00>>12535000
    IF PF THEN PRINT(OUTB,0,%203) ELSE FWRITE(FN,OUTB,0,%203); <<C0.00>>12540000
    IF <> THEN FILERR;                                         <<C0.00>>12545000
  END  <<SUBROUTINE DUMP>>;                                    <<C0.00>>12550000
                                                               <<C0.00>>12555000
          <<-------------------->>                             <<C0.00>>12560000
                                                               <<C0.00>>12565000
        <<----------------->>                                  <<C0.00>>12570000
        << BEGIN PROCEDURE >>                                  <<C0.00>>12575000
        <<----------------->>                                  <<C0.00>>12580000
                                                               <<C0.00>>12585000
    ERRORON;                                                   <<C0.00>>12590000
    BOUNDS:=CHEK(ERRCODE&LSL(6)+5,4,DOUBLE(%253),,%17);        <<C0.00>>12595000
    CC:=2;                                 <<CCE>>             <<C0.00>>12600000
    IF NOT VAR&LSR(2) THEN ADUM:=@DUMMY;   <<NO IDNUM>>        <<C0.00>>12605000
    IF NOT(VAR)&LSR(3) THEN                <<NO FILEN>>        <<C0.00>>12610000
      BEGIN                                                    <<C0.00>>12615000
        PF:=TRUE;   AF:=FALSE;                                 <<C0.00>>12620000
        PXGLOBAL;                                              <<06664>>12625000
        LDT'INDEX := PXG'OUTPUTLDEV * SIZE'OF'LDT'ENTRY;       <<07052>>12630000
        EXCHANGEDB(LDT'DST);                                   <<07052>>12635000
        RECSIZE := LDT'RECORD'WIDTH & LSL(1); << Bytes >>      <<07052>>12640000
        EXCHANGEDB(0); <<TO STACK>>                            <<C0.00>>12645000
        GO WJX;                                                <<C0.00>>12650000
      END;                                                     <<C0.00>>12655000
    FN:=FOPEN(FILEN,,4);                                       <<C0.00>>12660000
    IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);GO FINI;END;   <<C0.00>>12665000
    GO C;                                                      <<C0.00>>12670000
                                                               <<C0.00>>12675000
STACKDUMP':                                                    <<C0.00>>12680000
    ERRORON;                                                   <<C0.00>>12685000
    BOUNDS:=CHEK(ERRCODE&LSL(6)+5,4,DOUBLE(%253),,%17);        <<C0.00>>12690000
    IF NOT VAR&LSR(2) THEN ADUM:=@DUMMY;   <<NO IDNUM>>        <<C0.00>>12695000
    CC:=2;                                 <<CCE>>             <<C0.00>>12700000
    IF NOT VAR&LSR(3) THEN                 <<NO FILEN>>        <<C0.00>>12705000
      BEGIN                                                    <<C0.00>>12710000
        CC:=1;                                                 <<C0.00>>12715000
        IDNUMBER:=72;                      <<"BAD FILE #">>    <<C0.00>>12720000
        GO FINI;                                               <<C0.00>>12725000
      END;                                                     <<C0.00>>12730000
    FN:= FILEN(0);                         <<GET FILE NUMBER>> <<C0.00>>12735000
    AF:=FALSE;                                                 <<C0.00>>12740000
                                                               <<C0.00>>12745000
C:                                                             <<C0.00>>12750000
    FGETINFO(FN,,FOPTIONS,AOPTIONS,RECSIZE);                   <<C0.00>>12755000
    IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);GO FINI;END;   <<C0.00>>12760000
    RECSIZE:= IF FOPTIONS.(13:1) THEN -RECSIZE                 <<C0.00>>12765000
              ELSE RECSIZE&LSL(1);                             <<C0.00>>12770000
WJX:                                                           <<C0.00>>12775000
    IF RECSIZE>256 OR RECSIZE<32 THEN                          <<C0.00>>12780000
      BEGIN                                                    <<C0.00>>12785000
D:                                                             <<C0.00>>12790000
        CC:=0;   GO FINI;                                      <<C0.00>>12795000
      END;                                                     <<C0.00>>12800000
    PXFIXED;                                                   <<06664>>12805000
    ENVIR:=PXFXSTKDMPENV;                                      <<06664>>12810000
     QIN := PXFXQREG;                                          <<06664>>12815000
    PUSH(Q); V:=IF ENVIR=0 THEN -1 ELSE 0;                     <<C0.00>>12820000
   WHILE ((V:=V+1) <= ENVIR) AND (S0 > QIN) DO                 <<02341>>12825000
    BEGIN                                                      <<C0.00>>12830000
      ASSEMBLE(DUP,DUP);                                       <<C0.00>>12835000
      SR:=TOS-4;                                               <<C0.00>>12840000
      TOS:=TOS-ST(TOS);                                        <<C0.00>>12845000
    END;                                                       <<C0.00>>12850000
    QR:=TOS; UBOUND:=SR;                                       <<C0.00>>12855000
    FLAGS := IF NOT(VAR&LSR(1)) THEN FALSE ELSE FLAG;                   12860000
    IF ENVIR=0 THEN                                            <<C0.00>>12865000
      BEGIN                                                    <<C0.00>>12870000
        TITLE;                                                 <<C0.00>>12875000
        PUSH(Q); PX:=TOS;                                      <<C0.00>>12880000
        REGIST(PX,BOUTB((RECSIZE-32)&LSR(1)));                 <<C0.00>>12885000
        WRITE((RECSIZE+2)&LSR(1)+16);                          <<C0.00>>12890000
        MARKER(PX,BOUTB((RECSIZE-60)&LSR(1)));                 <<C0.00>>12895000
        WRITE((RECSIZE+2)&LSR(1)+31);                          <<C0.00>>12900000
        IF PF THEN PRINT(OUTB,0,%201) ELSE FWRITE(FN,OUTB,0,%201);      12905000
        IF <> THEN FILERR;                                     <<C0.00>>12910000
        IF NOT FLAGS.(14:1) THEN TRCBCK;                       <<02341>>12915000
      END;                                                     <<C0.00>>12920000
    IF NOT VAR THEN GO FINI;      <<ARRAY SELEC MISSING>>      <<C0.00>>12925000
    IF PF THEN PRINT(OUTB,0,%201) ELSE FWRITE(FN,OUTB,0,%201); <<C0.00>>12930000
    IF <> THEN FILERR;                                         <<C0.00>>12935000
    CLEARBUF;                                                  <<C0.00>>12940000
    PUSH(Q); TOS:=@SELEC; TOS:=TOS-TOS;                        <<C0.00>>12945000
    LIM:=(TOS-4)&LSR(1);                                       <<C0.00>>12950000
NEXT:                                                          <<C0.00>>12955000
    CURSELX:=CURSELX+1;                                        <<C0.00>>12960000
    IF CURSELX>LIM THEN GOTO FINI;                             <<C0.00>>12965000
    TOS:=SELEC(CURSELX);                                       <<C0.00>>12970000
    ASSEMBLE(DDUP);                                            <<C0.00>>12975000
    IF TOS=%177777D THEN GOTO FINI;                            <<C0.00>>12980000
                                                               <<C0.00>>12985000
    <<DECODE ENTRY>>                                           <<C0.00>>12990000
                                                               <<C0.00>>12995000
    ASSEMBLE(TEST);                                            <<C0.00>>13000000
    IF >= THEN                                                 <<C0.00>>13005000
      BEGIN                                                    <<C0.00>>13010000
        COUNT:=TOS;                                            <<C0.00>>13015000
        DBAD:=TOS;                                             <<C0.00>>13020000
        DUMP(0);                                               <<C0.00>>13025000
      END                                                      <<C0.00>>13030000
      ELSE BEGIN                                               <<C0.00>>13035000
        ASSEMBLE(DUP);                                         <<C0.00>>13040000
        V:=TOS;                                                <<C0.00>>13045000
        CASE V.(0:3) OF BEGIN                                  <<C0.00>>13050000
          <<EMPTY>>;                                           <<C0.00>>13055000
          <<EMPTY>>;                                           <<C0.00>>13060000
          <<EMPTY>>;                                           <<C0.00>>13065000
          <<EMPTY>>;                                           <<C0.00>>13070000
          BEGIN                                                <<C0.00>>13075000
            CHEK(ERRCODE&LSL(6)+5,%44,,DOUBLE(2));      <<CAP>><<C0.00>>13080000
            ASSEMBLE(XCH); DSTX:=TOS;      <<EXTRA DS>>        <<C0.00>>13085000
            IF (DSTX:=PXDSEG(4,DSTX))=0 THEN                   <<C0.00>>13090000
              BEGIN                                            <<C0.00>>13095000
WS:                                                            <<C0.00>>13100000
                CC:=0;                      <<INVALID>>        <<C0.00>>13105000
                GO FINI;                                       <<C0.00>>13110000
              END;                                             <<C0.00>>13115000
            ASSEMBLE(DUP);                                     <<C0.00>>13120000
            DBAD:=(TOS LAND %17600)&LSL(2);       <<DB ADRESS>><<C0.00>>13125000
            COUNT:=(TOS LAND %177)&LSL(7);        <<COUNT TO BE OUTPUT>>13130000
            DUMP(4);                                           <<C0.00>>13135000
          END;                                                 <<C0.00>>13140000
          BEGIN                                                <<C0.00>>13145000
            <<CHECK CAP: PM CODE OR PROG HAS PM CAP>>          <<00512>>13150000
            IF STATUS.(0:1) <> 1 THEN                          <<00512>>13155000
            CHEK(ERRCODE&LSL(6)+5,%44,,DOUBLE(%100));          <<00512>>13160000
            ASSEMBLE(DUP);                                     <<C0.00>>13165000
            DBAD:=(TOS LAND %17600)&LSL(2);                    <<C0.00>>13170000
            COUNT:=(TOS LAND %177)&LSL(7);                     <<C0.00>>13175000
            DSTX:=TOS;                                         <<C0.00>>13180000
            IF DSTI'(DSTX&LSL(2)).(3:13) = 0 THEN                       13185000
             GOTO WS;       <<INVALID ENTRY>>                           13190000
            DUMP(4);                                           <<C0.00>>13195000
          END;                                                 <<C0.00>>13200000
          BEGIN     << Q >>                                    <<C0.00>>13205000
            COUNT:=TOS.(3:13);                                 <<C0.00>>13210000
            DBAD:=QR+TOS;                                      <<C0.00>>13215000
            DUMP(1);                                           <<C0.00>>13220000
          END;                                                 <<C0.00>>13225000
          BEGIN     << S >>                                    <<C0.00>>13230000
            COUNT:=TOS.(3:13);                                 <<C0.00>>13235000
            DBAD:=SR+TOS;                                      <<C0.00>>13240000
            DUMP(2);                                           <<C0.00>>13245000
          END;                                                 <<C0.00>>13250000
        END  <<CASE>>;                                         <<C0.00>>13255000
      END;                                                     <<C0.00>>13260000
    GO TO NEXT;                                                <<C0.00>>13265000
                                                               <<C0.00>>13270000
FINI:                                                          <<C0.00>>13275000
    IF AF THEN                                                 <<C0.00>>13280000
      BEGIN                                                    <<C0.00>>13285000
        FCLOSE(FN,0,0);                                        <<C0.00>>13290000
        IF CCL THEN BEGIN CC:=1;FCHECK(FN,IDNUMBER);END;       <<C0.00>>13295000
      END;                                                     <<C0.00>>13300000
    STAT.(6:2):=CC;              <<CC IN RETURN>>              <<C0.00>>13305000
    ERROREXIT(ERRCODE&LSL(6)+5,0,0);       <<QUIT SYSTEM>>     <<C0.00>>13310000
END  <<PROCEDURES STACKDUMP & STACKDUMP'>>;                    <<C0.00>>13315000
                                                                        13320000
$CONTROL SEGMENT=MAIN                                                   13325000
                                                               <<B0.07>>13330000
END.  <<ABORTDUMP>>                                            <<00652>>13335000
