$CONTROL USLINIT, MAP, CODE, MAIN = IDAT                       <<84228>>00005000
                                                                        00010000
COMMENT                                                                 00015000
MODULE IDAT                                                             00020000
                                                                        00025000
Product Information                                                     00030000
   Product name, mnemonic, project number                               00035000
      IDAT is unsupported, but STARS will accept service requests for it00040000
   Project abstract                                                     00045000
      IDAT is an interactive dump analysis tool with a debug-like syntax00050000
   Project personnel                                                    00055000
      IDAT belongs to the KSE group and was originally written by       00060000
         Bob Mead                                                       00065000
      It has since been maintained at CSY by                            00070000
         Janet Garcia                                                   00075000
         Kathy Leach                                                    00080000
         Dan Buckler                                                    00085000
         Steve Follmer                                                  00090000
         Lou Petrella                                                   00095000
         Marie Weston                                                   00100000
         Larry Byler                                           <<84228>>00105000
         Bill O'Shaughnessy                                    <<84627>>00110000
                                                                        00115000
General Design Overview                                                 00120000
The following files are needed to use IDAT:                             00125000
   IDAT      Actual program                                             00130000
   IDATS     SPL source for IDAT                                        00135000
   IDATHCAT  Raw help file                                              00140000
   IDATHELP  Help file used by IDAT (Run makecat on IDATHCAT)           00145000
   IDATUG    TDP users guide                                            00150000
   DOCENVIR  Environment file for epocing IDATUG                        00155000
                                                                        00160000
   Design approach                                                      00165000
   Major modules                                                        00170000
   Major data structures                                                00175000
   Overall flow of data and control                                     00180000
   Performance considerations                                           00185000
                                                                        00190000
Module Implementation                                                   00195000
   (for each module)                                                    00200000
   Module name                                                          00205000
      brief description                                                 00210000
                                                                        00215000
Global Data Structure Implementation                                    00220000
   Overall data structure relations                                     00225000
      Narrative                                                         00230000
      Maps of linkages                                                  00235000
                                                                        00240000
   (for each data structure)                                            00245000
   Data structure name                                                  00250000
      Purpose                                                           00255000
      Creation and dispostion                                           00260000
      Access methods                                                    00265000
      Users                                                             00270000
      Data layout and description                                       00275000
      Storage management                                                00280000
      Subordinate data structures                                       00285000
                                                                        00290000
Fix History                                                             00295000
    29oct82   Format current stack correctly                            00300000
              Enforce use of CORE to ensure clean COREBUF               00305000
    30dec82   Change welcome message                                    00310000
              Permit 'HELP' instead of just 'H'                         00315000
              Install this template                                     00320000
    31jan83   Fix "SAME AS ABOVE" message                               00325000
              Check stacks for delta Q = 0                              00330000
              Handle series 2/3 dumps properly                          00335000
              Use procinfo to look for IDATHELP file                    00340000
              Released to field                                         00345000
    18mar83   Fix make all commands invariant of spaces                 00350000
    20apr83   Negative offset register addressing fixed.                00355000
              Precedence of arithmetic operators redefined.             00360000
              Leading blank suppression code removed from CI.           00365000
              "INCOMPLETE DUMP" message is now used correctly.          00370000
              IDATHELP can be found from other groups/accounts.         00375000
    06may83   Addressing the top half of a bank works correctly.        00380000
    28feb84   Duplicate lines on octal/integer/ASCII displays  <<84228>>00385000
              are now handled correctly.                       <<84228>>00390000
              Null commands are not errors any more.           <<84228>>00395000
              STKDST assignment in PRT'STK now uses MPEV/E     <<84228>>00400000
              subfield [(2:14), was (1:10)].                   <<84228>>00405000
    01mar84   Saved almost 2048 words of code in FMTSIR by     <<84301>>00410000
              changing initialization of IMPDRS and HLDRS'IMPD.<<84301>>00415000
              Streamlined similar code in several other areas. <<84301>>00420000
              Fixed statements in CHK'FOR'DEADLOCKS and FMTSIR <<84301>>00425000
              which obtained LOCSIR (assumed that SIR DST      <<84301>>00430000
              always lives in Bank 0).                         <<84301>>00435000
    02mar84   Subroutine GET'SERIESII'CONTEXT of TEXTFILE now  <<84302>>00440000
              checks for texting from tape (required).         <<84302>>00445000
              PRINTERROR message length calculation simplified <<84302>>00450000
    11mar84   TEXTFILE improved, got rid of SPECIFIED FILE IS  <<84311>>00455000
              NOT A MEMORY DUMP, fixed NEW'TEXT to indicate    <<84311>>00460000
              correct condition of IDAT, cleaned up some bugs  <<84311>>00465000
              in error exits, other minor fixups.              <<84311>>00470000
    26mar84   HELP now tries to open IDATHELP as follows:      <<84326>>00475000
              1.  In the group.acct IDAT runs in,              <<84326>>00480000
              2.  In the logon group.acct (modified by any     <<84326>>00485000
                  :FILE IDATHELP = ...),                       <<84326>>00490000
              3.  IDATHELP.IDAT.KSE (last resort).             <<84326>>00495000
              Error handling is improved, in particular, FOPEN <<84326>>00500000
              of IDATHELP is checked for errors(!).            <<84326>>00505000
              Entire command words are now allowed (e.g.,      <<84326>>00510000
              T[EXT], F[ORMAT], etc. EXCEPT for D  which  can- <<84326>>00515000
              not have more than the D due to syntax confusion <<84326>>00520000
              (need to allow D, DDA, DA, DSY, DCO, etc.)       <<84326>>00525000
    27jun84   Added octal value to code dump.                  <<84627>>00530000
                                                                        00535000
Quality                                                                 00540000
   The code decoding capability uses DEBUGUTIL, and must run privileged.00545000
                                                                        00550000
;                                                                       00555000
$PAGE                                                                   00560000
BEGIN                                                                   00565000
                                                                        00570000
EQUATE  <<CONDITION CODE VALUES>>                                       00575000
   CCG = 0,                                                             00580000
   CCL = 1,                                                             00585000
   CCE = 2;                                                             00590000
EQUATE   <<CODES FOR DISPALY OPTIONS>>                                  00595000
    OCTAL'MODE   = 0,                                                   00600000
  INTEGER'MODE   = 1,                                                   00605000
    ASCII'MODE   = 2,                                                   00610000
     CODE'MODE   = 3;                                                   00615000
                                                                        00620000
EQUATE                                                                  00625000
      MODEL35      = 1,     << SERIES 3  >>         <<01377>>           00630000
      MODEL25      = 2,     << SERIES 33 >>         <<01377>>           00635000
      MODEL44      = 3,     << SERIES 44 >>         <<01296>>           00640000
      ICF55        = 4,     << SERIES 55 >>         <<01377>>           00645000
      MM           = 5,     << SERIES 37 >>                    <<*8993>>00650000
                                                                        00655000
      PCB'MAXENTNO = 1023;                                              00660000
                                                                        00665000
DEFINE                                                                  00670000
            CR   = %15#,                                                00675000
            ASB  = ASSEMBLE#,                                           00680000
            SEG  = STAREG.(8:8)#;                                       00685000
                                                                        00690000
DEFINE PCB04 = CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+04))#;                   00695000
DEFINE PCB13 = CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+13))#;                   00700000
DEFINE PCB14 = CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+14))#;                   00705000
                                                               <<01377>>00710000
DEFINE SERIES'33'THRU'MM                                       <<*8993>>00715000
             = ( MACHINEID=MODEL25 LOR MACHINEID=MODEL44       <<01296>>00720000
                 LOR MACHINEID=ICF55 LOR MACHINEID=MM ) #;     <<*8993>>00725000
                                                                        00730000
LOGICAL    SERIES2OR3;<<TRUE: FIRST RECORD OF FILE IS FIRMWARE>>        00735000
LOGICAL       CTRLY,  <<TRUE: CONTROL-Y DETECTED>>                      00740000
           NEW'TEXT;  <<TRUE: NO CORE FILE OPEN AT TIME >>              00745000
LOGICAL    DST'GOOD,  <<TRUE: LOW CORE DST PTR VALID>>                  00750000
           CST'GOOD,  <<TRUE: LOW CORE CST PTR VALID>>                  00755000
          FILE'GOOD,  <<TRUE: HAVE VALID DUMP FILE>>                    00760000
           PCB'GOOD;  <<TRUE; LOW CORE PCB PTR VALID>>                  00765000
INTEGER       COREF,  <<DISCFILE NUMBER OF MEMORY DUMP>>                00770000
         CURMEMAREA,  <<MEMORY BLOCK CURRENTLY IN BUFFER>>              00775000
             INFILE,  <<FILE NUMBER FOR $STDINX>>                       00780000
            OUTFILE;  <<FILE NUMBER FOR $STDLIST>>                      00785000
DOUBLE       MAXMEM,  <<LARGEST VALID MEMORY ADDRESS>>                  00790000
              SYSDB;  <<ADDRESS OF SYSTEM DB>>                          00795000
                                                                        00800000
LOGICAL ARRAY COREBUF(0:4095);  <<MEMORY BUFFER>>                       00805000
                                                                        00810000
LOGICAL ARRAY LBUF(0:39);                                               00815000
BYTE ARRAY    BUF(*)=LBUF;                                              00820000
                                                                        00825000
BYTE ARRAY SERIESBUF(0:2);                                              00830000
BYTE POINTER PBUF:=@BUF;                                                00835000
                                                                        00840000
INTRINSIC  FOPEN,ASCII,QUIT,FREAD,FWRITE,PRINT,FREADDIR,MYCOMMAND;      00845000
INTRINSIC SEARCH,XCONTRAP,RESETCONTROL,BINARY,DBINARY,DASCII,DEBUG;     00850000
INTRINSIC FCHECK,FGETINFO,FCLOSE,TERMINATE,FSPACE,FCONTROL,FWRITEDIR;   00855000
                                                                        00860000
                                                                        00865000
         INTEGER STATUS=Q-1,                                   <<01.02>>00870000
                 S0=S-0,                                                00875000
                 NUMREC,                                                00880000
                 MACHINEID;                                             00885000
                                                                        00890000
         ARRAY SCRBUF(0:100); <<FOR GET'SERIESII'CONTEXT SUB.>>         00895000
                                                                        00900000
         ARRAY REGSAVE(0:30)=DB;  <<REGISTERS>>                         00905000
                                                                        00910000
         LOGICAL REG0=REGSAVE+0,                                        00915000
                 REG1=REGSAVE+1,                                        00920000
                 REG2=REGSAVE+2,                                        00925000
                 REG3=REGSAVE+3,                                        00930000
                 REG4=REGSAVE+4,                                        00935000
                 REG5=REGSAVE+5,                                        00940000
                 REG7=REGSAVE+6,                                        00945000
                 XREG=REGSAVE+7,                                        00950000
                 DLREG=REGSAVE+8,                                       00955000
                 DBBANKREG=REGSAVE+9,                                   00960000
                 DBREG=REGSAVE+10,                                      00965000
                 QREG=REGSAVE+11,                                       00970000
                 SREG=REGSAVE+12,                                       00975000
                 ZBANKREG=REGSAVE+13,                                   00980000
                 ZREG=REGSAVE+14,                                       00985000
                 STAREG=REGSAVE+15,                                     00990000
                 PBBANKREG=REGSAVE+16,                                  00995000
                 PBREG=REGSAVE+17,                                      01000000
                 PREG=REGSAVE+18,                                       01005000
                 PLREG=REGSAVE+19,                                      01010000
                 CIRREG=REGSAVE+20,                                     01015000
                 CPX1=REGSAVE+21,                                       01020000
                 CPX2=REGSAVE+22,                                       01025000
                 REG6=REGSAVE+23,                                       01030000
                 MEMSIZE=REGSAVE+24,                                    01035000
                 NIR=REGSAVE+25,                               <<00.01>>01040000
                 SP1=REGSAVE+26,                               <<00.01>>01045000
                 SP2=REGSAVE+27,                               <<00.01>>01050000
                 ISR=REGSAVE+28;                               <<00.01>>01055000
                                                               <<03752>>01060000
                                                               <<03752>>01065000
<<* * * MACHINE CONTEXT * * *>>                                <<00.01>>01070000
                                                               <<00.01>>01075000
DEFINE                                                         <<00.01>>01080000
   CNMACHINEID        = COREBUF(%1400).(8:8) #,                <<01172>>01085000
                                                               <<00.01>>01090000
<<MODEL 35>>                                                   <<00.01>>01095000
   CNSTARFISH         = COREBUF(%1400).(0:8) #,                <<02519>>01100000
   M35CONTENTS24      = COREBUF(%1401)       #,                <<00.01>>01105000
   M35SMREG           = COREBUF(%1402)       #,                <<00.01>>01110000
   M35SP1REG          = COREBUF(%1403)       #,                <<00.01>>01115000
   M35SP2REG          = COREBUF(%1404)       #,                <<00.01>>01120000
   M35DBREG           = COREBUF(%1405)       #,                <<00.01>>01125000
   M35DBANKREG        = COREBUF(%1406).(0:4) #,                <<00.01>>01130000
   M35PBANKREG        = COREBUF(%1406).(4:4) #,                <<00.01>>01135000
   M35SBANKREG        = COREBUF(%1406).(12:4)#,                <<00.01>>01140000
   M35ZREG            = COREBUF(%1407)       #,                <<00.01>>01145000
   M35DLREG           = COREBUF(%1410)       #,                <<00.01>>01150000
   M35XREG            = COREBUF(%1411)       #,                <<00.01>>01155000
   M35QREG            = COREBUF(%1412)       #,                <<00.01>>01160000
   M35CIREG           = COREBUF(%1413)       #,                <<00.01>>01165000
   M35PBREG           = COREBUF(%1414)       #,                <<00.01>>01170000
   M35PLREG           = COREBUF(%1415)       #,                <<00.01>>01175000
   M35PREG            = COREBUF(%1416)       #,                <<00.01>>01180000
   M35CPX1            = COREBUF(%1417)       #,                <<00.01>>01185000
   M35STATUSREG       = COREBUF(%1420)       #,                <<00.01>>01190000
   M35CPX2            = COREBUF(%1421).(0:8) #,                <<00.01>>01195000
   M35NUMBANKS        = COREBUF(%1421).(8:8) #,                <<00.01>>01200000
   CNDRT0             = COREBUF(%1422)       #,                <<02519>>01205000
   CNDRT1             = COREBUF(%1423)       #,                <<02519>>01210000
   CNDRT2             = COREBUF(%1424)       #,                <<02519>>01215000
   CNDRT3             = COREBUF(%1425)       #,                <<02519>>01220000
                                                               <<00.01>>01225000
                                                               <<00.01>>01230000
<<MODEL 25  AND  MODEL ICF/55>>                                <<03013>>01235000
   M25DUMPDEVICEDRT   = COREBUF(%1401)       #,                <<00.01>>01240000
   M25XREG            = COREBUF(%1402)       #,                <<00.01>>01245000
   M25DLREG           = COREBUF(%1403)       #,                <<00.01>>01250000
   M25DBANKREG        = COREBUF(%1404)       #,                <<00.01>>01255000
   M25DBREG           = COREBUF(%1405)       #,                <<00.01>>01260000
   M25QREG            = COREBUF(%1406)       #,                <<00.01>>01265000
   M25SREG            = COREBUF(%1407)       #,                <<00.01>>01270000
   M25SBANKREG        = COREBUF(%1410)       #,                <<00.01>>01275000
   M25ZREG            = COREBUF(%1411)       #,                <<00.01>>01280000
   M25STATUSREG       = COREBUF(%1412)       #,                <<00.01>>01285000
   M25PBANKREG        = COREBUF(%1413)       #,                <<00.01>>01290000
   M25PBREG           = COREBUF(%1414)       #,                <<00.01>>01295000
   M25PREG            = COREBUF(%1415)       #,                <<00.01>>01300000
   M25PLREG           = COREBUF(%1416)       #,                <<00.01>>01305000
   M25CIREG           = COREBUF(%1417)       #,                <<00.01>>01310000
   M25NUMPHYSICALBANKS= COREBUF(%1420)       #,                <<00.01>>01315000
   M25NIRREG          = COREBUF(%1421)       #,                <<00.01>>01320000
   M55NIRREG          = COREBUF(%1515)       #,                <<03013>>01325000
   M25ISR             = COREBUF(%1422)       #,                <<00.01>>01330000
   M25NUMBANKS        = COREBUF(%1423)       #,                <<03013>>01335000
   M55CPX1            = COREBUF(%1421)       #,                <<03013>>01340000
   M55CPX2            = COREBUF(%1422)       #;                <<03013>>01345000
 EQUATE MAXIMUM'BANKS = 64;                                    <<01114>>01350000
                                                                        01355000
<< ORIGINAL VALUES OF REGISTERS SAVED THROUGHOUT      >>                01360000
<< THE PROGRAM.  INITIALIZED IN PROCEDURE "INIT'REGS" >>                01365000
  LOGICAL                                                               01370000
    SVDBBANK,     SVZREG,                                               01375000
    SVDBREG,      SVPBBANK,                                             01380000
    SVSBANK,      SVPBREG,                                              01385000
    SVSREG,       SVQREG,                                               01390000
    SVDLREG;                                                            01395000
                                                                        01400000
                                                                        01405000
LOGICAL PROCEDURE DEASSEMBLE(RESULT,STRING,INSTR,INSTR'WORD2);          01410000
      VALUE INSTR,INSTR'WORD2;                                          01415000
      INTEGER RESULT,INSTR,INSTR'WORD2;                                 01420000
      BYTE ARRAY STRING;                                                01425000
      OPTION VARIABLE, UNCALLABLE, PRIVILEGED, EXTERNAL;                01430000
                                                                        01435000
PROCEDURE HELPROC(CATNUM,LISTNUM,COMIMAGE,COMBASE,ERR,ONECHARPRMPT);    01440000
      VALUE CATNUM,LISTNUM,ONECHARPRMPT;                                01445000
      INTEGER CATNUM,LISTNUM,ERR;                                       01450000
      BYTE ARRAY COMIMAGE,COMBASE;                                      01455000
      LOGICAL ONECHARPRMPT;                                             01460000
      OPTION EXTERNAL;                                                  01465000
                                                                        01470000
PROCEDURE PRINT'FILE'INFO(FN);                                          01475000
      VALUE FN;                                                         01480000
      INTEGER FN;                                                       01485000
      OPTION EXTERNAL;                                                  01490000
                                                                        01495000
PROCEDURE GENMSGU(A,B);                                                 01500000
   VALUE A,B;INTEGER A,B;                                               01505000
   OPTION PRIVILEGED;                                                   01510000
   OPTION EXTERNAL;                                                     01515000
                                                                        01520000
PROCEDURE PRINTERROR(ERRORNUM); <<ERROR MESSAGES>>                      01525000
  VALUE ERRORNUM;                                                       01530000
  INTEGER ERRORNUM;  <<# OF ERROR MESSAGE TO DISPLAY>>                  01535000
  OPTION FORWARD;                                                       01540000
                                                                        01545000
PROCEDURE FMTSIR(PRNTFILE);                                             01550000
  VALUE PRNTFILE;                                                       01555000
  INTEGER PRNTFILE;                                                     01560000
  OPTION FORWARD;                                                       01565000
                                                                        01570000
PROCEDURE HELP(COMMAND,BUF,PARMS);                                      01575000
BYTE ARRAY BUF;                                                         01580000
BYTE POINTER COMMAND,<<ENTIRE COMMAND                   >>              01585000
   PARMS;            <<POINTS TO PARAMETERS             >>              01590000
   OPTION FORWARD;                                                      01595000
                                                                        01600000
PROCEDURE TEXTFILE(PARMSTRING);                                         01605000
   BYTE ARRAY PARMSTRING;                                               01610000
   OPTION FORWARD;                                                      01615000
                                                                        01620000
PROCEDURE PRT'STK(F'NUM,ADRS,S,QINITL);                                 01625000
  VALUE F'NUM,ADRS,S,QINITL;                                            01630000
  INTEGER F'NUM,S,QINITL;                                               01635000
  DOUBLE ADRS;                                                          01640000
  OPTION FORWARD;                                                       01645000
                                                                        01650000
PROCEDURE FMTREGS(PRNTFILE);                                            01655000
   VALUE PRNTFILE;                                                      01660000
   INTEGER PRNTFILE;                                                    01665000
   OPTION FORWARD;                                                      01670000
                                                                        01675000
LOGICAL PROCEDURE ISFREE(PCB'ENTRY);                                    01680000
   VALUE PCB'ENTRY;                                                     01685000
   INTEGER PCB'ENTRY;                                                   01690000
   OPTION FORWARD;                                                      01695000
                                                                        01700000
PROCEDURE PUTNUM(NUM);                                                  01705000
   VALUE NUM;                                                           01710000
   INTEGER NUM;                                                         01715000
   OPTION FORWARD;                                                      01720000
                                                                        01725000
PROCEDURE PUTNUMP(NUM);                                                 01730000
   VALUE NUM;                                                           01735000
   INTEGER NUM;                                                         01740000
   OPTION FORWARD;                                                      01745000
                                                                        01750000
PROCEDURE SET'REG(PARMSTRING);                                          01755000
   BYTE ARRAY PARMSTRING;                                               01760000
   OPTION FORWARD;                                                      01765000
                                                                        01770000
                                                                        01775000
$PAGE "                    PROCEDURE CONTROLY"                          01780000
<<***********************************************************>>         01785000
<< CONTROLY                                                  >>         01790000
<<----------------------------------------------------------->>         01795000
<< CONTROY-Y TRAP ROUTINE  --  SET GLOBAL FLAG TO TRUE       >>         01800000
<<***********************************************************>>         01805000
PROCEDURE CONTROLY;                                                     01810000
BEGIN                                                                   01815000
                                                                        01820000
INTEGER SDEC= Q+1;                                                      01825000
                                                                        01830000
RESETCONTROL;                                                           01835000
CTRLY:=TRUE;                                                            01840000
TOS:=%31400+SDEC;                                                       01845000
ASSEMBLE(XEQ 0);                                                        01850000
                                                                        01855000
END;  <<CONTROLY>>                                                      01860000
$PAGE "                    PROCEDURE CORE"                              01865000
<<***********************************************************>>         01870000
<< CORE                                                      >>         01875000
<<----------------------------------------------------------->>         01880000
<< RETURN CONTENTS OF MEMORY LOCATION                        >>         01885000
<<***********************************************************>>         01890000
LOGICAL PROCEDURE CORE(ADR);                                            01895000
  VALUE ADR;                                                            01900000
  DOUBLE ADR;  <<MEMORY ADDRESS (BANK,ADDRESS)>>                        01905000
BEGIN                                                                   01910000
                                                                        01915000
  << CONDITION CODE IS RETURNED AS FOLLOWS:               >>            01920000
  <<                                                      >>            01925000
  <<   CCG - INVALID ADDRESS PARAMETER                    >>            01930000
  <<   CCE - SUCCESSFULL                                  >>            01935000
  <<   CCL - DISC I/O TO FILE "COREF" FAILED              >>            01940000
                                                                        01945000
  <<THIS PROCEDURE ASSUMES THE EXISTENCE OF THE FOLLOWING >>            01950000
  <<GLOBAL VARIABLES:                                     >>            01955000
  <<                                                      >>            01960000
  << INTEGER       COREF - FILE NUMBER OF DISC FILE       >>            01965000
  <<                       CONTAINING THE MEMORY IMAGE    >>            01970000
  << INTEGER  CURMEMAREA - USED BY THIS PROCEDURE TO      >>            01975000
  <<                       REMEMBER WHICH RECORD OF FILE  >>            01980000
  <<                       "COREF" IS CURRENTLY IN THE    >>            01985000
  <<                       FILE BUFFER "COREBUF"          >>            01990000
  <<                       (MODIFIED BY THIS PROCEDURE)   >>            01995000
  << DOUBLE       MAXMEM - LARGEST VALID MEMORY ADDRESS   >>            02000000
  <<                       IN THE DUMP (FIRST WORD IS THE >>            02005000
  <<                       BANK AND SECOND THE ADDRESS)   >>            02010000
  << LOGICAL ARRAY                                        >>            02015000
  <<     COREBUF(0:4095) - BUFFER FOR ONE RECORD FROM THE >>            02020000
  <<                       FILE "COREF"                   >>            02025000
  <<                       (MODIFIED BY THIS PROCEDURE)   >>            02030000
  <<                                                      >>            02035000
  << PROCEDURE PRINTERROR- PRODUCES ERROR MESSAGES        >>            02040000
                                                                        02045000
DEFINE CC=STATUS.(6:2)#;                                                02050000
                                                                        02055000
LOGICAL  STATUS = Q-1;    <<STATUS REGISTER IN MARKER>>                 02060000
INTEGER     LOC,          <<LOCATION IN BUFFER TO RETURN>>              02065000
             S0 = S;      <<TOP OF STACK>>                              02070000
                                                                        02075000
CORE:=0;  <<RETURN ZERO IN CASE OF AN ERROR>>                           02080000
CC:=CCE;  <<ASSUME NO ERRORS>>                                          02085000
                                                                        02090000
<<CHECK FOR INVALID ADDRESS - RETURN CCG IF INVALID>>                   02095000
IF ADR > MAXMEM  OR  ADR < 0D  THEN BEGIN                               02100000
  CC:=CCG;                                                              02105000
  PRINTERROR(16);                                                       02110000
  RETURN; END;                                                          02115000
                                                                        02120000
<<DETERMINE IF REQUESTED ADDRESS IS ALREADY IN BUFFER>>                 02125000
TOS:=ADR;                                                               02130000
LOC:=S0.(4:12);                                                         02135000
TOS:=TOS & DLSR(12);    <<SHIFT TO GET RECORD (BLOCK) INDEX>>           02140000
DELB;                                                                   02145000
                                                                        02150000
IF S0 <> CURMEMAREA THEN BEGIN                                          02155000
  <<LOCATION NOT IN BUFFER -- MUST READ APPROPRIATE RECORD>>            02160000
  CURMEMAREA:=TOS;                                                      02165000
  FREADDIR(COREF,COREBUF,4096,DOUBLE(CURMEMAREA));                      02170000
  IF <> THEN BEGIN                                                      02175000
    CC:=CCL;                                                            02180000
    PRINTERROR(17);                                                     02185000
    RETURN; END; END                                                    02190000
ELSE                                                                    02195000
  DEL;                                                                  02200000
                                                                        02205000
<<REQUESTED LOCATION IS NOW GUARANTEED IN THE BUFFER>>                  02210000
CORE:=COREBUF(LOC);                                                     02215000
                                                                        02220000
END;  <<CORE>>                                                          02225000
$PAGE "                    PROCEDURE DCORE"                             02230000
<<***********************************************************>>         02235000
<< DCORE                                                     >>         02240000
<<----------------------------------------------------------->>         02245000
<< RETURN CONTENTS OF MEMORY LOCATIONS (DOUBLE WORD)         >>         02250000
<<***********************************************************>>         02255000
LOGICAL PROCEDURE DCORE(ADR);                                           02260000
  VALUE ADR;                                                            02265000
  DOUBLE ADR;  <<MEMORY ADDRESS (BANK,ADDRESS)>>                        02270000
BEGIN                                                                   02275000
                                                                        02280000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     02285000
  <<                                             >>                     02290000
  <<   CCG - INVALID ADDRESS PARAMETER           >>                     02295000
  <<   CCE - SUCCESSFUL                          >>                     02300000
  <<   CCL - DISC I/O TO FILE "COREF" FAILED     >>                     02305000
                                                                        02310000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     02315000
  << PROCEDURE "CORE"                            >>                     02320000
                                                                        02325000
DEFINE  CC = STATUS.(6:2)#;                                             02330000
                                                                        02335000
LOGICAL CONDCODE,         <<CONDITION CODE FROM "CORE">>                02340000
          STATUS = Q-1;   <<STATUS REGISTER IN MARKER>>                 02345000
                                                                        02350000
CC:=CCE;                                                                02355000
                                                                        02360000
TOS:=CORE(ADR);                                                         02365000
PUSH(STATUS);                                                           02370000
CONDCODE:=TOS.(6:2);                                                    02375000
IF CONDCODE <> CCE THEN BEGIN                                           02380000
  DEL;                                                                  02385000
  CC:=CONDCODE;                                                         02390000
  RETURN; END;                                                          02395000
                                                                        02400000
TOS:=CORE(ADR+1D);                                                      02405000
PUSH(STATUS);                                                           02410000
CONDCODE:=TOS.(6:2);                                                    02415000
IF CONDCODE <> CCE THEN BEGIN                                           02420000
  DEL;                                                                  02425000
  CC:=CONDCODE;                                                         02430000
  RETURN; END;                                                          02435000
                                                                        02440000
DCORE:=TOS;                                                             02445000
                                                                        02450000
END;  <<DCORE>>                                                         02455000
$PAGE "                    PROCEDURE GETCORE"                           02460000
<<***********************************************************>>         02465000
<< GETCORE                                                   >>         02470000
<<----------------------------------------------------------->>         02475000
<< RETURN BLOCK OF MEMORY LOCATIONS                          >>         02480000
<<***********************************************************>>         02485000
PROCEDURE GETCORE(ADR,WORDCOUNT,BUFFER);                                02490000
  VALUE ADR,WORDCOUNT;                                                  02495000
  INTEGER    WORDCOUNT;   <<NUMBER OF WORDS TO RETURN>>                 02500000
  DOUBLE           ADR;   <<ADDRESS OF FIRST WORD TO RETURN>>           02505000
  LOGICAL ARRAY BUFFER;   <<BUFFER FOR RETURNING THE WORDS>>            02510000
BEGIN                                                                   02515000
                                                                        02520000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     02525000
  <<                                             >>                     02530000
  <<   CCG - INVALID STARTING OR ENDING ADDRESS  >>                     02535000
  <<   CCE - SUCCESSFUL                          >>                     02540000
  <<   CCL - DISC I/O TO FILE "COREF" FAILED     >>                     02545000
                                                                        02550000
  <<THIS PROCEDURE ASSUMES THE EXISTENCE OF THE FOLLOWING >>            02555000
  <<GLOBAL VARIABLES:                                     >>            02560000
  <<                                                      >>            02565000
  << INTEGER       COREF - FILE NUMBER OF DISC FILE       >>            02570000
  <<                       CONTAINING THE MEMORY IMAGE    >>            02575000
  << INTEGER  CURMEMAREA - USED BY THIS PROCEDURE TO      >>            02580000
  <<                       REMEMBER WHICH RECORD OF FILE  >>            02585000
  <<                       "COREF" IS CURRENTLY IN THE    >>            02590000
  <<                       FILE BUFFER "COREBUF"          >>            02595000
  <<                       (MODIFIED BY THIS PROCEDURE)   >>            02600000
  << DOUBLE       MAXMEM - LARGEST VALID MEMORY ADDRESS   >>            02605000
  <<                       IN THE DUMP (FIRST WORD IS THE >>            02610000
  <<                       BANK AND SECOND THE ADDRESS)   >>            02615000
  << LOGICAL ARRAY                                        >>            02620000
  <<     COREBUF(0:4095) - BUFFER FOR ONE RECORD FROM THE >>            02625000
  <<                       FILE "COREF"                   >>            02630000
  <<                       (MODIFIED BY THIS PROCEDURE)   >>            02635000
  <<                                                      >>            02640000
  << PROCEDURE PRINTERROR- PRODUCES ERROR MESSAGES        >>            02645000
                                                                        02650000
DEFINE  CC = STATUS.(6:2)#;                                             02655000
                                                                        02660000
LOGICAL FIRSTBLOCK,         <<TRUE: COPYING FROM FIRST BLOCK>>          02665000
            STATUS = Q-1;   <<STATUS REGISTER IN MARKER>>               02670000
INTEGER        LOC,         <<CURRENT STARTING ADDR IN BUFFER>>         02675000
         MOVECOUNT,         <<# WORDS TO MOVE IN ONE MOVE>>             02680000
                S0 = S,     <<TOP OF STACK>>                            02685000
            TCOUNT;         <<# WORDS ALREADY TRANSFERRED>>             02690000
                            <<TO TARGET BUFFER           >>             02695000
                                                                        02700000
CC:=CCE;  <<ASSUME NO ERRORS>>                                          02705000
                                                                        02710000
<<CHECK FOR INVALID STARTING OR ENDING ADDRESS>>                        02715000
IF ADR+DOUBLE(WORDCOUNT) > MAXMEM  OR  ADR < 0D THEN BEGIN              02720000
  CC:=CCG;                                                              02725000
  PRINTERROR(16);                                                       02730000
  RETURN; END;                                                          02735000
                                                                        02740000
<<DETERMINE IF STARTING ADDRESS CURRENTLY IN BUFFER>>                   02745000
TOS:=ADR;                                                               02750000
LOC:=S0.(4:12);                                                         02755000
TOS:=TOS & DLSR(12);  <<SHIFT TO GET RECORD (BLOCK) INDEX>>             02760000
                                                                        02765000
IF SERIES2OR3 THEN TOS:=TOS+1;  << SKIP EXTRA FIRST RECORD (FIRMWARE)>> 02770000
                                                                        02775000
IF S0 <> CURMEMAREA THEN BEGIN                                          02780000
  <<NOT IN BUFFER -- READ APPROPRIATE RECORD>>                          02785000
  CURMEMAREA:=TOS;                                                      02790000
  FREADDIR(COREF,COREBUF,4096,DOUBLE(CURMEMAREA));                      02795000
  IF <> THEN BEGIN                                                      02800000
    CC:=CCL;                                                            02805000
    PRINTERROR(17);                                                     02810000
    RETURN; END; END                                                    02815000
ELSE                                                                    02820000
  DEL;                                                                  02825000
                                                                        02830000
<<STARTING ADDRESS NOW IN BUFFER - START COPYING>>                      02835000
TCOUNT:=0;  <<# WORDS COPIED TO TARGET BUFFER>>                         02840000
FIRSTBLOCK:=TRUE;                                                       02845000
                                                                        02850000
WHILE TCOUNT < WORDCOUNT DO BEGIN                                       02855000
                                                                        02860000
  IF NOT FIRSTBLOCK THEN BEGIN                                          02865000
    <<MUST READ NEXT BLOCK OF MEMORY INTO MEMORY BUFFER>>               02870000
    CURMEMAREA:=CURMEMAREA+1;                                           02875000
    FREADDIR(COREF,COREBUF,4096,DOUBLE(CURMEMAREA));                    02880000
    IF <> THEN BEGIN                                                    02885000
      CC:=CCL;                                                          02890000
      PRINTERROR(17);                                                   02895000
      RETURN; END;                                                      02900000
    LOC:=0; END     <<COPY FROM BEGINNING OF BLOCK>>                    02905000
  ELSE                                                                  02910000
    FIRSTBLOCK:=FALSE;                                                  02915000
                                                                        02920000
  <<COPY BLOCK OF WORDS FROM MEMORY BUFFER TO TARGET BUFFER>>           02925000
  IF (MOVECOUNT:=WORDCOUNT-TCOUNT)+LOC >= 4096 THEN                     02930000
    MOVECOUNT:=4096-LOC;                                                02935000
                                                                        02940000
  MOVE BUFFER(TCOUNT):=COREBUF(LOC),(MOVECOUNT);                        02945000
  TCOUNT:=TCOUNT+MOVECOUNT; END;                                        02950000
                                                                        02955000
END;  <<GETCORE>>                                                       02960000
$PAGE "                    PROCEDURE PUTCHAR"                           02965000
<<***********************************************************>>         02970000
<< PUTCHAR                                                   >>         02975000
<<----------------------------------------------------------->>         02980000
<< PLACE ASCII CHARACTER INTO BUFFER                         >>         02985000
<<***********************************************************>>         02990000
PROCEDURE PUTCHAR(CHAR,BUFLOC);                                         02995000
  VALUE CHAR;                                                           03000000
  INTEGER  CHAR;  <<CHARACTER TO PUT IN BUFFER>>                        03005000
  BYTE  BUFLOC;   <<LOCATION IN WHICH TO PLACE CHAR>>                   03010000
BEGIN                                                                   03015000
                                                                        03020000
BUFLOC:= IF %40 <= CHAR <= %176 THEN CHAR                               03025000
                                ELSE ".";                               03030000
                                                                        03035000
END;  <<PUTCHAR>>                                                       03040000
$PAGE "                    PROCEDURE OCTALDUMP"                         03045000
<<***********************************************************>>         03050000
<< OCTALDUMP                                                 >>         03055000
<<----------------------------------------------------------->>         03060000
<< DUMP RANGE OF MEMORY IN OCTAL, INTEGER, ASCII             >>         03065000
<< OR CODE FORMAT.                                           >>         03070000
<<***********************************************************>>         03075000
PROCEDURE OCTALDUMP(FNUM,STARTADR,ENDADR,MODE);                         03080000
  VALUE FNUM,STARTADR,ENDADR,MODE;                                      03085000
  INTEGER    FNUM,    <<FILE NUMBER ON WHICH TO DUMP>>                  03090000
             MODE;    << 0 <= OCTAL  >>                                 03095000
                      << 1 <= INTEGER>>                                 03100000
                      << 2 <= ASCII  >>                                 03105000
                      << 3 <= DEASSEMBLE >>                             03110000
  DOUBLE   ENDADR,    <<LAST ADDRESS TO DUMP>>                          03115000
         STARTADR;    <<FIRST ADDRESS TO DUMP>>                         03120000
  OPTION PRIVILEGED;                                                    03125000
BEGIN                                                                   03130000
                                                                        03135000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     03140000
  << PROCEDURES "GETCORE" AND "PUTCHAR"          >>                     03145000
                                                                        03150000
DEFINE  NUMBER = (MODE <> ASCII'MODE) LAND (MODE <> CODE'MODE)#;        03155000
                                                                        03160000
LOGICAL      BANK,  <<BANK NUMBER OF CURRENT ADDRESS>>                  03165000
          ADDRESS,  <<ADDRESS PORTION OF CURRENT ADDRESS>>              03170000
    CURRENT'MATCH,  <<TRUE: HAVE DUPLICATE LINE>>                       03175000
   PREVIOUS'MATCH,  <<TRUE: HAD PREVIOUS DUPLICATES>>                   03180000
         LASTLINE,  <<TRUE: CURRENT OUTPUT LINE IS FINAL>>              03185000
         CODESIZE;  <<CHARACTER LENGTH OF THE DEASSEMBLY>>              03190000
INTEGER      BASE,  <<VALUE TO PASS TO "ASCII">>                        03195000
              I,J,  <<LOOP VARIABLES AND TEMPORARY VAR>>                03200000
           OFFSET;  <<OFFSET FROM START OF LINE>>                       03205000
DOUBLE      COUNT,  <<# WORDS TO GET FROM GETCORE>>                     03210000
           CURADR,  <<CURRENT ADDRESS TO DUMP>>                         03215000
          LASTADR,  <<ADDRESS OF LAST LINE DUMPED>>                     03220000
           PCOUNT;  <<NUMBER OF WORDS PRINTED>>                         03225000
                                                                        03230000
LOGICAL ARRAY   CURLINE(0:7),  <<CURRENT LINE>>                         03235000
               PREVLINE(0:7);  <<PREVIOUS LINE>>                        03240000
                                                                        03245000
BYTE ARRAY CURBYTES(*)=CURLINE;                                         03250000
BYTE ARRAY PREVBYTES(*)=PREVLINE;                                       03255000
                                                                        03260000
LOGICAL ARRAY LBUF(0:39);     <<OUTPUT BUFFER>>                         03265000
BYTE ARRAY BUF(*)=LBUF;                                                 03270000
                                                                        03275000
BYTE ARRAY TEMPBUF(0:5);      <<TEMPORARY BUFFER>>                      03280000
                                                                        03285000
PCOUNT:=0D;                                                             03290000
CURRENT'MATCH:=FALSE;                                                   03295000
PREVIOUS'MATCH:=FALSE;                                                  03300000
LASTLINE:=FALSE;                                                        03305000
CURADR:=STARTADR;                                                       03310000
                                                                        03315000
<<DETERMINE MODE TO USE AND OFFSET>>                                    03320000
IF NOT (OCTAL'MODE <= MODE <= CODE'MODE) THEN                           03325000
  RETURN                                                                03330000
ELSE                                                                    03335000
  CASE MODE OF BEGIN                                                    03340000
      <<OCTAL>> BEGIN                                                   03345000
                OFFSET:=21;                                             03350000
                BASE:=8; END;                                           03355000
    <<INTEGER>> BEGIN                                                   03360000
                OFFSET:=26;                                             03365000
                BASE:=-10; END;                                         03370000
      <<ASCII>> OFFSET:=21;                                             03375000
       <<CODE>> BEGIN END;                                              03380000
  END;  <<CASE>>                                                        03385000
                                                                        03390000
<<FORMAT AND PRINT 8 WORDS AT A TIME UNTIL DONE>>                       03395000
<<UNLESS DEASSEMBLING, THEN ONLY ONE WORD PER LINE>>                    03400000
WHILE CURADR <= ENDADR DO BEGIN                                         03405000
  BUF:=" ";                                                             03410000
  MOVE BUF(1):=BUF,(79);       <<CLEAR OUTPUT LINE>>                    03415000
                                                                        03420000
  IF CTRLY THEN BEGIN                                                   03425000
    <<CONTROL-Y HAS BEEN ENTERED - STOP FORMATTING>>                    03430000
    FWRITE(FNUM,LBUF,0,0);  <<TO START NEW LINE>>                       03435000
    MOVE BUF:=" <CONTROL-Y>";                                           03440000
    FWRITE(FNUM,LBUF,-12,%60);                                          03445000
    RETURN; END;                                                        03450000
                                                                        03455000
  <<DETERMINE NUMBER OF WORDS FOR CURRENT LINE>>                        03460000
  IF MODE = CODE'MODE THEN                                              03465000
     BEGIN                                                              03470000
     COUNT:=1D;                                                         03475000
     IF CURADR+1D=ENDADR THEN LASTLINE:=TRUE;                           03480000
     END                                                                03485000
  ELSE BEGIN                                                            03490000
     IF (COUNT:=ENDADR-CURADR+1D) > 8D THEN COUNT:=8D;                  03495000
     IF CURADR+8D > ENDADR THEN LASTLINE:=TRUE;                         03500000
     END;                                                               03505000
  GETCORE(CURADR,INTEGER(COUNT),CURLINE);                               03510000
  IF <> THEN RETURN;                                                    03515000
                                                                        03520000
  <<COMPARE FOR DUPLICATE LINE>>                                        03525000
  IF PCOUNT > 0D THEN                                                   03530000
    IF (IF (MODE = CODE'MODE) THEN (CURBYTES = PREVBYTES,(2))           03535000
        ELSE (CURBYTES = PREVBYTES,(16))) THEN BEGIN                    03540000
       PREVIOUS'MATCH := CURRENT'MATCH := TRUE;                <<84228>>03545000
       END                                                     <<84228>>03550000
    ELSE CURRENT'MATCH := FALSE;                               <<84228>>03555000
  IF MODE <> CODE'MODE THEN                                             03560000
   IF (PREVIOUS'MATCH LAND NOT CURRENT'MATCH) OR                        03565000
    (CURRENT'MATCH LAND LASTLINE) THEN BEGIN                            03570000
    <<HAD PREVIOUS MATCH - MUST PRINT LINE>>                            03575000
    MOVE BUF:="LINES";                                                  03580000
    ASCII(LOGICAL(LASTADR),8,BUF(6));                                   03585000
    BUF(13):="-";                                                       03590000
    ASCII(LOGICAL(CURADR-1D),8,BUF(15));                                03595000
    MOVE BUF(22):="SAME AS ABOVE";                                      03600000
    FWRITE(FNUM,LBUF,-35,0);                                            03605000
    BUF:=" ";                                                           03610000
    MOVE BUF(1):=BUF,(79);  <<CLEAR OUTPUT LINE>>                       03615000
    CURRENT'MATCH:=FALSE;                                               03620000
    PREVIOUS'MATCH:=FALSE;                                              03625000
    END;                                                                03630000
                                                                        03635000
  IF MODE = CODE'MODE  OR  NOT CURRENT'MATCH THEN BEGIN                 03640000
    <<FORMAT CURRENT LINE -- MAX OF 8 WORDS>>                           03645000
    TOS:=CURADR;                                                        03650000
    ADDRESS:=TOS;                                                       03655000
    BANK:=TOS;                                                          03660000
    ASCII(BANK,8,TEMPBUF);                                              03665000
    MOVE BUF:=TEMPBUF(3),(3);                                           03670000
    ASCII(ADDRESS,8,BUF(4));                                            03675000
    BUF(11):="(";                                                       03680000
    BUF(18):=")";                                                       03685000
    BUF(19):=":";                                                       03690000
    ASCII(LOGICAL(PCOUNT),8,BUF(12));                                   03695000
                                                                        03700000
    <<FORMAT THE WORDS FROM MEMORY>>                                    03705000
    FOR I:=0 UNTIL INTEGER(COUNT)-1 DO                                  03710000
      IF NUMBER THEN                                                    03715000
        ASCII(CURLINE(I),BASE,BUF(OFFSET+I*7))                          03720000
      ELSE IF MODE = ASCII'MODE THEN BEGIN                              03725000
        PUTCHAR(CURLINE(I).(0:8),BUF(OFFSET+I*2));                      03730000
        PUTCHAR(CURLINE(I).(8:8),BUF(OFFSET+I*2+1));                    03735000
                                                                        03740000
        <<PRINT BYTE OFFSET TO THE RIGHT>>                              03745000
        ASCII(LOGICAL(PCOUNT)*2,8,BUF(49));                             03750000
        BUF(48):="(";                                                   03755000
        BUF(55):=")";                                                   03760000
      END ELSE IF MODE = CODE'MODE THEN                                 03765000
       BEGIN                                                            03770000
        ASCII(CURLINE(I),8,BUF(22));                                    03775000
        CODESIZE:=DEASSEMBLE(J,BUF(30),CURLINE(I),CURLINE(I+1));        03780000
       END;                                                             03785000
                                                                        03790000
    MOVE PREVLINE:=CURLINE,(8);                                         03795000
                                                                        03800000
    FWRITE(FNUM,LBUF,-77,0); END;                                       03805000
                                                                        03810000
  <<UPDATE COUNTERS>>                                                   03815000
  CURADR:=IF MODE = CODE'MODE THEN CURADR+1D ELSE CURADR+8D;            03820000
  IF NOT CURRENT'MATCH THEN LASTADR := CURADR;                 <<84228>>03825000
  PCOUNT:=IF MODE = CODE'MODE THEN PCOUNT+1D ELSE PCOUNT+8D; END;       03830000
                                                                        03835000
END;  <<OCTALDUMP>>                                                     03840000
$PAGE "                        PROCEDURE INIT "                         03845000
<<*****************                                                     03850000
** INIT          **                                                     03855000
*****************>>                                                     03860000
PROCEDURE INIT;                                                         03865000
BEGIN                                                                   03870000
                                                                        03875000
INTEGER DUMMY;  <<REQUIRED BY INTRINSIC "XCONTRAP">>                    03880000
                                                                        03885000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     03890000
  << FOLLOWING GLOBAL VARIABLES:                 >>                     03895000
  <<    CST'GOOD      = |                        >>                     03900000
  <<    DST'GOOD      = |--LOW CORE POINTERS     >>                     03905000
  <<    PCB'GOOD      = |                        >>                     03910000
    <<  CURMEMAREA    = MEMORY BLOCK CURRENTLY IN>>                     03915000
  <<                    BUFFER                   >>                     03920000
  <<    INFILE        = FILE # FOR $STDINX       >>                     03925000
  <<    OUTFILE       = FILE # FOR $STDLIST      >>                     03930000
  <<    MAXMEM        = LARGEST VALID MEMORY ADD.>>                     03935000
  <<    SYSDB         = SYSTEM DB                >>                     03940000
                                                                        03945000
                                                                        03950000
CST'GOOD:=DST'GOOD:=PCB'GOOD:=TRUE;                                     03955000
  NEW'TEXT:=TRUE;                                                       03960000
CURMEMAREA:=-1;                                                         03965000
OUTFILE:=FOPEN(,%10);                                                   03970000
INFILE:=FOPEN(,%55);  <<$STDINX>>                                       03975000
                                                                        03980000
XCONTRAP(@CONTROLY,DUMMY);                                              03985000
                                                                        03990000
SYSDB:=%1000D;                                                          03995000
END;  <<INIT>>                                                          04000000
$PAGE "                    PROCEDURE PRINTERROR"                        04005000
<<***********************************************************>>         04010000
<< PRINTERROR                                                >>         04015000
<<----------------------------------------------------------->>         04020000
<< PRINT ERROR MESSAGE FOR SYNTAX ERROR DETECTED IN COMMAND  >>         04025000
<<***********************************************************>>         04030000
PROCEDURE PRINTERROR(ERRORNUM);                                         04035000
  VALUE ERRORNUM;                                                       04040000
  INTEGER ERRORNUM;  <<# OF ERROR MESSAGE TO DISPLAY>>                  04045000
BEGIN                                                                   04050000
                                                                        04055000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF GLOBAL >>                  04060000
  << VARIABLES "OUTFILE" AND "CR"                    >>                 04065000
                                                                        04070000
INTEGER LENGTH;                                                <<84302>>04075000
                                                                        04080000
LOGICAL ARRAY LBUF(0:39);      <<OUTPUT BUFFER>>                        04085000
BYTE ARRAY     BUF(*)=LBUF;                                             04090000
                                                                        04095000
CASE ERRORNUM OF BEGIN                                                  04100000
   <<0>> MOVE BUF:=" *** UNABLE TO PARSE COMMAND ***", 2;               04105000
   <<1>> MOVE BUF:=" *** SYNTAX ERROR <MODE> ***", 2;                   04110000
   <<2>> MOVE BUF:=" *** UNDEFINED MODE ***", 2;                        04115000
   <<3>> MOVE BUF:=" *** SYNTAX ERROR <COUNT> ***", 2;                  04120000
   <<4>> MOVE BUF:=" *** NEGATIVE COUNT ***", 2;                        04125000
   <<5>> MOVE BUF:=" *** SYNTAX ERROR <DISPLACEMENT> ***", 2;           04130000
   <<6>> MOVE BUF:=" *** INVALID DISPLACEMENT ***", 2;                  04135000
   <<7>> MOVE BUF:=" *** UNRECOGNIZED SYNTAX ***", 2;                   04140000
   <<8>> MOVE BUF:=" *** UNRECOGNIZED COMMAND ***", 2;                  04145000
   <<9>> MOVE BUF:=" *** SPECIFIED SEGMENT IS ABSENT ***", 2;           04150000
  <<10>> MOVE BUF:=" *** INCORRECT NUMBER OF PARAMETERS ***", 2;        04155000
  <<11>> MOVE BUF:=" *** INVALID FORMAT MODE ***", 2;                   04160000
  <<12>> MOVE BUF:=" *** SYNTAX ERROR ***", 2;                          04165000
  <<13>> MOVE BUF:=" *** UNABLE TO ACCESS DST TABLE ***", 2;            04170000
  <<14>> MOVE BUF:=" *** UNABLE TO ACCESS PCB TABLE ***", 2;            04175000
  <<15>> MOVE BUF:=" *** SPECIFIED PIN DOES NOT EXIST ***", 2;          04180000
  <<16>> MOVE BUF:=" *** INVALID ADDRESS GENERATED ***", 2;             04185000
  <<17>> MOVE BUF:=" *** I/O ERROR ON MEMORY DUMP DISC FILE ***", 2;    04190000
  <<18>> MOVE BUF:=" *** UNABLE TO ACCESS CST TABLE ***", 2;            04195000
  <<19>> MOVE BUF:=" *** INVALID EXPRESSION ***", 2;                    04200000
  <<20>> MOVE BUF:=" *** INVALID STACK ***", 2;                         04205000
  <<21>> MOVE BUF:=" *** UNABLE TO TEXT SPECIFIED FILE ***", 2;         04210000
  <<22>> MOVE BUF:=" *** UNABLE TO PURGE SPECIFIED OLD FILE ***", 2;    04215000
  <<23>> MOVE BUF:=" *** SPECIFIED FILE DOES NOT EXIST ***", 2;         04220000
  <<24>> MOVE BUF:=" *** SPECIFIED FILE IS NOT A MEMORY DUMP ***", 2;   04225000
  <<25>> MOVE BUF:=" *** UNABLE TO READ FROM TAPE ***", 2;              04230000
  <<26>> MOVE BUF:=" *** UNABLE TO WRITE TAPE TO DISC ***", 2;          04235000
  <<27>> MOVE BUF:=" *** UNABLE TO PLACE EOF ON TAPE ***", 2;           04240000
  <<28>> MOVE BUF:=" *** INVALID REGISTER ***", 2;                      04245000
  <<29>> MOVE BUF:=" *** INVALID ADDRESS ***", 2;                       04250000
  <<30>> MOVE BUF:=                                                     04255000
             "*** UNABLE TO KEEP PREVIOUS TAPE FILE ON DISC ***", 2;    04260000
  <<31>> MOVE BUF:=" *** WORKFILE IS TEMPORARY ***", 2;                 04265000
  <<32>> MOVE BUF:=" *** You must text in a file first ***", 2;         04270000
  <<33>> MOVE BUF:=" *** PROCINFO error getting group.acct ***", 2;     04275000
  <<34>> MOVE BUF:=" *** Insufficient stack space for HELPROC ***", 2;  04280000
  <<35>> MOVE BUF:=" *** Invalid stack: Delta Q = 0 ***", 2;            04285000
  <<36>> MOVE BUF:=" *** Save this tape! ***@@@@", 2;          04290000
  <<37>> MOVE BUF:=                                                     04295000
         "You cannot text in a Series II dump file from disc. ***", 2;  04300000
  <<38>> MOVE BUF:=" *** File name is too long ***", 2;                 04305000
  <<39>> MOVE BUF:=" *** Couldn't open IDATHELP ***", 2;                04310000
  <<40>> MOVE BUF:=" *** PREP or RUN with MAXDATA >= 8192. ***", 2;     04315000
                                                                        04320000
END;  <<CASE>>                                                          04325000
                                                                        04330000
LENGTH := TOS - @BUF;                                          <<84302>>04335000
                                                                        04340000
FWRITE (OUTFILE, LBUF, -LENGTH, 0);                            <<84302>>04345000
                                                                        04350000
END;  <<PRINTERROR>>                                                    04355000
$PAGE "                    PROCEDURE GETCSTADDR"                        04360000
<<***********************************************************>>         04365000
<< GETCSTADDR                                                >>         04370000
<<----------------------------------------------------------->>         04375000
<< RETURN ADDRESS OF A CST  (IF THE CST IS NOT ABSENT)       >>         04380000
<<***********************************************************>>         04385000
DOUBLE PROCEDURE GETCSTADDR(CSTNUM);                                    04390000
  VALUE CSTNUM;                                                         04395000
  INTEGER CSTNUM;  <<CST OF INTEREST>>                                  04400000
BEGIN                                                                   04405000
                                                                        04410000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     04415000
  <<                                             >>                     04420000
  <<   CCG - CST IS ABSENT                       >>                     04425000
  <<   CCE - SUCCESSFUL                          >>                     04430000
  <<   CCL - UNABLE TO USE THE CST TABLE         >>                     04435000
                                                                        04440000
  << THIS PORCEDURE ASSUMES THE EXISTENCE OF THE>>                      04445000
  << GLOBAL VARIABLES:                          >>                      04450000
  <<     CST'GOOD          PRINTERROR (PROC)    >>                      04455000
  <<     CORE (PROC)       GETCORE (PROC)       >>                      04460000
                                                                        04465000
DEFINE          CC = STATUS.(6:2)#,                                     04470000
          CST'ADDR = CSTENTRY(3)#,                                      04475000
          CST'BANK = CSTENTRY(2)#,                                      04480000
       PRESENT'CST = NOT CSTENTRY(0).(0:1)                              04485000
                      OR CSTENTRY(1).(1:1)#;                            04490000
                                                                        04495000
LOGICAL  STATUS = Q-1;  <<STATUS REGISTER FROM MARKER>>                 04500000
DOUBLE ENTRYADDR;         <<ADDRESS OF CST ENTRY IN QUESTION>>          04505000
                                                                        04510000
LOGICAL ARRAY CSTENTRY(0:3);  <<CST ENTRY FOR SEGMENT>>                 04515000
                                                                        04520000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         04525000
IF NOT CST'GOOD THEN BEGIN                                              04530000
  CC:=CCL;                                                              04535000
  PRINTERROR(18);                                                       04540000
  RETURN; END;                                                          04545000
                                                                        04550000
ENTRYADDR:=DOUBLE(CORE(0D)+LOGICAL(CSTNUM)*4);                          04555000
GETCORE(ENTRYADDR,4,CSTENTRY);                                          04560000
                                                                        04565000
IF PRESENT'CST THEN BEGIN                                               04570000
  TOS:=CST'BANK;                                                        04575000
  TOS:=CST'ADDR;                                                        04580000
  GETCSTADDR:=TOS; END                                                  04585000
ELSE BEGIN                                                              04590000
  CC:=CCG;   <<SEGMENT IS ABSENT>>                                      04595000
  PRINTERROR(9); END;                                                   04600000
                                                                        04605000
END;  <<GETCSTADDR>>                                                    04610000
$PAGE "                    PROCEDURE GETDSTADDR"                        04615000
<<***********************************************************>>         04620000
<< GETDSTADDR                                                >>         04625000
<<----------------------------------------------------------->>         04630000
<< RETURN ADDRESS OF A DST  (IF THE DST IS NOT ABSENT)       >>         04635000
<<***********************************************************>>         04640000
DOUBLE PROCEDURE GETDSTADDR(DSTNUM);                                    04645000
  VALUE DSTNUM;                                                         04650000
  INTEGER DSTNUM;  <<DST OF INTEREST>>                                  04655000
BEGIN                                                                   04660000
                                                                        04665000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     04670000
  <<                                             >>                     04675000
  <<   CCG - DST IS ABSENT                       >>                     04680000
  <<   CCE - SUCCESSFUL                          >>                     04685000
  <<   CCL - UNABLE TO USE THE DST TABLE         >>                     04690000
                                                                        04695000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE>>                      04700000
  << FOLLOWING GLOBAL VARIABLES:                >>                      04705000
  <<     DST'GOOD          PRINTERROR (PROC)    >>                      04710000
  <<     CORE (PROC)       GETCORE (PROC)       >>                      04715000
                                                                        04720000
DEFINE CC=STATUS.(6:2)#;                                                04725000
DEFINE    DST'ADDR = DSTENTRY(3)#,                                      04730000
          DST'BANK = DSTENTRY(2)#,                                      04735000
       PRESENT'DST = NOT DSTENTRY(0).(0:1)                              04740000
                      OR DSTENTRY(1).(1:1)#;                            04745000
                                                                        04750000
LOGICAL  STATUS = Q-1;  <<STATUS REGISTER FROM MARKER>>                 04755000
DOUBLE ENTRYADDR;         <<ADDRESS OF DST ENTRY IN QUESTION>>          04760000
                                                                        04765000
LOGICAL ARRAY DSTENTRY(0:3);  <<DST ENTRY FOR SEGMENT>>                 04770000
                                                                        04775000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         04780000
IF NOT DST'GOOD THEN BEGIN                                              04785000
  CC:=CCL;                                                              04790000
  PRINTERROR(13);                                                       04795000
  RETURN; END;                                                          04800000
                                                                        04805000
ENTRYADDR:=DOUBLE(CORE(2D)+LOGICAL(DSTNUM)*4);                          04810000
GETCORE(ENTRYADDR,4,DSTENTRY);                                          04815000
                                                                        04820000
IF PRESENT'DST THEN BEGIN                                               04825000
  TOS:=DST'BANK;                                                        04830000
  TOS:=DST'ADDR;                                                        04835000
  GETDSTADDR:=TOS; END                                                  04840000
ELSE BEGIN                                                              04845000
  CC:=CCG;   <<SEGMENT IS ABSENT>>                                      04850000
  PRINTERROR(9); END;                                                   04855000
                                                                        04860000
END;  <<GETDSTADDR>>                                                    04865000
$PAGE "                    PROCEDURE GETNUMBER"                         04870000
<<***********************************************************>>         04875000
<< GETNUMBER                                                 >>         04880000
<<----------------------------------------------------------->>         04885000
<< CONVERT ASCII STRING TO BINARY                            >>         04890000
<<***********************************************************>>         04895000
LOGICAL PROCEDURE GETNUMBER(STRING,LENGTH);                             04900000
  VALUE LENGTH;                                                         04905000
  INTEGER          LENGTH;  <<# CHARS IN ASCII STRING>>                 04910000
  BYTE ARRAY       STRING;  <<ASCII STRING TO CONVERT>>                 04915000
BEGIN                                                                   04920000
                                                                        04925000
DEFINE CC=STATUS.(6:2)#;                                                04930000
                                                                        04935000
LOGICAL  STATUS = Q-1;  <<STATUS REGISTER IN MARKER>>                   04940000
                                                                        04945000
BYTE ARRAY BUFFER(0:9); <<USED TO BUILD STRING TO CONVERT>>             04950000
                                                                        04955000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         04960000
GETNUMBER:=0;                                                           04965000
                                                                        04970000
IF LENGTH <= 0 THEN RETURN;   <<NOTHING TO CONVERT>>                    04975000
                                                                        04980000
IF STRING = "#" THEN BEGIN                                              04985000
  <<USER SPECIFIED DECIMAL NUMBER>>                                     04990000
  LENGTH:=LENGTH-1;                                                     04995000
  MOVE BUFFER:=STRING(1),(LENGTH); END                                  05000000
ELSE BEGIN                                                              05005000
  <<ASSUME NUMBER IS IN OCTAL>>                                         05010000
  BUFFER:="%";                                                          05015000
  MOVE BUFFER(1):=STRING,(LENGTH);                                      05020000
  LENGTH:=LENGTH+1; END;                                                05025000
                                                                        05030000
<<CONVERT TO BINARY USING THE BINARY INTRINSIC>>                        05035000
GETNUMBER:=BINARY(BUFFER,LENGTH);                                       05040000
PUSH(STATUS);    <<NEED CONDITION CODE RETURNED>>                       05045000
TOS:=TOS.(6:2);                                                         05050000
CC:=TOS;                                                                05055000
                                                                        05060000
END;  <<GETNUMBER>>                                                     05065000
$PAGE "                    PROCEDURE EXPREVAL"                          05070000
<<***********************************************************>>         05075000
<< EXPREVAL                                                  >>         05080000
<<----------------------------------------------------------->>         05085000
<< EVALUATE AN EXPRESSION AND RETURN VALUE                   >>         05090000
<<***********************************************************>>         05095000
LOGICAL PROCEDURE EXPREVAL(STRING);                                     05100000
  BYTE ARRAY STRING;  <<EXPRESSION TO BE EVALUATED>>                    05105000
                      << <CR> AT END OF EXPRESSION>>                    05110000
BEGIN                                                                   05115000
                                                                        05120000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     05125000
  <<                                             >>                     05130000
  <<   CCG - SYNTAX ERROR UNABLE TO PARSE        >>                     05135000
  <<   CCE - SUCCESSFUL                         >>                      05140000
  <<   CCL - NOT RETURNED                        >>                     05145000
                                                                        05150000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     05155000
  << PROCEDURE "GETNUMBER"                       >>                     05160000
                                                                        05165000
EQUATE  MAXPARM = 24,                                                   05170000
            ADD =  0,                                                   05175000
            SUB =  1,                                                   05180000
            MPY =  2,                                                   05185000
            DIV =  3,                                                   05190000
            EOS =  4,                                                   05195000
           NULL =  5;                                                   05200000
                                                                        05205000
DEFINE       CC = STATUS.(6:2)#,                                        05210000
          DELIM = INFOWORD.(11:5)#,                                     05215000
         LENGTH = INFOWORD.(0:8)#;                                      05220000
                                                                        05225000
LOGICAL  INFOWORD,      <<WORD RETURNED BY MYCOMMAND>>                  05230000
              OP1,      <<OPERAND 1>>                                   05235000
              OP2,      <<OPERAND 2>>                                   05240000
             TEMP,      <<TEMPORARY>>                                   05245000
           STATUS = Q-1;<<STATUS  REGISTER IN MARKER>>                  05250000
INTEGER NUMPARMS,      <<# PARMS IN EXPRESSION>>                        05255000
           NUMTOS,      <<TOP OF OPERAND STACK>>                        05260000
            OPTOS,      <<TOP OF OPERATOR STACK>>                       05265000
             PARM;      <<LOOP VARIABLE>>                               05270000
                                                                        05275000
LOGICAL ARRAY   NUMBER(0:MAXPARM),  <<OPERAND STACK>>                   05280000
               OPERATOR(0:MAXPARM),  <<OPERATOR STACK>>                 05285000
                 OPPRI(0:5);        <<OPERATOR PRIORITIES>>             05290000
DOUBLE ARRAY     PARMS(0:MAXPARM);  <<RETURNED BY MYCOMMAND>>           05295000
BYTE ARRAY   DELIMITERS(0:4);                                           05300000
                                                                        05305000
BYTE POINTER  OPERAND;    <<OPERAND TO CONVERT TO BINARY>>              05310000
                                                                        05315000
CC:=CCE;  <<ASSUME NO ERRORS>>                                          05320000
EXPREVAL:=0;  <<IN CASE OF AN ERROR>>                                   05325000
                                                                        05330000
<<INITIALIZE OPERATOR PRIORITIES>>                                      05335000
OPPRI(ADD):=2;                                                          05340000
OPPRI(SUB):=2;                                                          05345000
OPPRI(MPY):=3;                                                          05350000
OPPRI(DIV):=3;                                                          05355000
OPPRI(EOS):=1;                                                          05360000
OPPRI(NULL):=0;                                                         05365000
                                                                        05370000
<<SET UP TO PARSE THE EXPRESSION>>                                      05375000
DELIMITERS(ADD):="+";                                                   05380000
DELIMITERS(SUB):="-";                                                   05385000
DELIMITERS(MPY):="*";                                                   05390000
DELIMITERS(DIV):="/";                                                   05395000
DELIMITERS(EOS):=CR;                                                    05400000
                                                                        05405000
MYCOMMAND(STRING,DELIMITERS,MAXPARM,NUMPARMS,PARMS);                    05410000
IF <> THEN BEGIN                                                        05415000
  CC:=CCG;                                                              05420000
  RETURN; END;                                                          05425000
                                                                        05430000
<<USE FIRST PARM TO INITIALIZE THE OPERATOR AND OPERAND STACKS>>        05435000
TOS:=PARMS(0);                                                          05440000
INFOWORD:=TOS;                                                          05445000
@OPERAND:=TOS;                                                          05450000
                                                                        05455000
IF NUMPARMS = 0 THEN                                                    05460000
  RETURN;  <<STRING IS NULL - RETURN ZERO>>                             05465000
                                                                        05470000
OPERATOR(0):=NULL;                                                      05475000
OPTOS:=1;                                                               05480000
NUMTOS:=PARM:=0;                                                        05485000
OPERATOR(OPTOS):=DELIM;                                                 05490000
TEMP:=GETNUMBER(OPERAND,LENGTH);                                        05495000
IF = THEN                                                               05500000
  NUMBER(NUMTOS):=TEMP                                                  05505000
ELSE BEGIN                                                              05510000
  CC:=CCG;                                                              05515000
  RETURN; END;                                                          05520000
                                                                        05525000
WHILE OPERATOR(OPTOS) <> EOS DO BEGIN                                   05530000
  TOS:=PARMS(PARM:=PARM+1);                                             05535000
  INFOWORD:=TOS;                                                        05540000
  @OPERAND:=TOS;                                                        05545000
                                                                        05550000
  TEMP:=GETNUMBER(OPERAND,LENGTH);                                      05555000
  IF = THEN                                                             05560000
    NUMBER(NUMTOS:=NUMTOS+1):=TEMP                                      05565000
  ELSE BEGIN                                                            05570000
    CC:=CCG;                                                            05575000
    RETURN; END;                                                        05580000
                                                                        05585000
  WHILE OPPRI(DELIM) <= OPPRI(OPERATOR(OPTOS)) DO BEGIN                 05590000
    OP1:=NUMBER(NUMTOS-1);                                              05595000
    OP2:=NUMBER(NUMTOS);                                                05600000
    CASE OPERATOR(OPTOS) OF BEGIN                                       05605000
      <<+>> TEMP:=OP1+OP2;                                              05610000
      <<->> TEMP:=OP1-OP2;                                              05615000
      <<*>> TEMP:=OP1*OP2;                                              05620000
      <</>> TEMP:=OP1/OP2;                                              05625000
    END;  <<CASE>>                                                      05630000
                                                                        05635000
    NUMBER(NUMTOS:=NUMTOS-1):=TEMP;                                     05640000
    OPTOS:=OPTOS-1; END;                                                05645000
                                                                        05650000
  OPERATOR(OPTOS:=OPTOS+1):=DELIM; END;                                 05655000
                                                                        05660000
EXPREVAL:=NUMBER(NUMTOS);                                               05665000
                                                                        05670000
END;  <<EXPREVAL>>                                                      05675000
$PAGE "                    PROCEDURE VALIDPIN"                          05680000
<<***********************************************************>>         05685000
<< VALIDPIN                                                  >>         05690000
<<----------------------------------------------------------->>         05695000
<< DETERMINE IF SPECIFIED PIN EXISTS                         >>         05700000
<<***********************************************************>>         05705000
LOGICAL PROCEDURE VALIDPIN(PIN);                                        05710000
  VALUE PIN;                                                            05715000
  INTEGER PIN;     <<PIN TO VALIDATE>>                                  05720000
BEGIN                                                                   05725000
                                                                        05730000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     05735000
  << GLOBAL VARIABLE PCB'GOOD AND THE PROC. CORE >>                     05740000
                                                                        05745000
VALIDPIN:=FALSE;                                                        05750000
                                                                        05755000
IF NOT PCB'GOOD THEN RETURN;                                            05760000
                                                                        05765000
IF 1 <= PIN <= INTEGER(CORE(GETDSTADDR(3))) THEN                        05770000
  VALIDPIN:=TRUE;                                                       05775000
                                                                        05780000
END;  <<VALIDPIN>>                                                      05785000
$PAGE "                    PROCEDURE GETSTACKDST"                       05790000
<<***********************************************************>>         05795000
<< GETSTACKDST                                               >>         05800000
<<----------------------------------------------------------->>         05805000
<< RETURN DST INDEX OF STACK FOR THE SPECIFIED PIN           >>         05810000
<<***********************************************************>>         05815000
INTEGER PROCEDURE GETSTACKDST(PIN);                                     05820000
  VALUE PIN;                                                            05825000
  INTEGER PIN;    <<PIN OF PROCESS OF INTEREST>>                        05830000
BEGIN                                                                   05835000
                                                                        05840000
  << CONDITION CODE IS RETURNED AS FOLLOWS:    >>                       05845000
  <<                                           >>                       05850000
  <<  CCG - INVALID PIN #                      >>                       05855000
  <<  CCE - SUCCESSFUL                        >>                        05860000
  <<  CCL - UNABLE TO ACCESS THE PCB TABLE     >>                       05865000
                                                                        05870000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     05875000
  <<FOLLOWING GLOBAL VARIABLES:                  >>                     05880000
  <<       PCB'GOOD         PRINTERROR (PROC)    >>                     05885000
  <<       CORE (PROC)      VALIDPIN (PROC)      >>                     05890000
                                                                        05895000
DEFINE  CC = STATUS.(6:2)#;                                             05900000
                                                                        05905000
LOGICAL  PCBWORD,        <<WORD FROM PCB TABLE>>                        05910000
          STATUS = Q-1;  <<STATUS WORD IN MARKER>>                      05915000
                                                                        05920000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         05925000
                                                                        05930000
IF NOT PCB'GOOD THEN BEGIN                                              05935000
  PRINTERROR(14);                                                       05940000
  CC:=CCL;                                                              05945000
  RETURN; END;                                                          05950000
                                                                        05955000
IF NOT VALIDPIN(PIN) THEN BEGIN                                         05960000
  PRINTERROR(15);                                                       05965000
  CC:=CCG; END                                                          05970000
ELSE BEGIN                                                              05975000
  PCBWORD:=CORE(GETDSTADDR(3)+DOUBLE(LOGICAL(PIN)*%25+3));              05980000
  GETSTACKDST:=PCBWORD.(2:14); END;                                     05985000
                                                                        05990000
END;  <<GETSTACKDST>>                                                   05995000
$PAGE "                     PROCEDURE PARSEOFFSET"                      06000000
<<***********************************************************>>         06005000
<< PARSEOFFSET                                               >>         06010000
<<----------------------------------------------------------->>         06015000
<< PARSE <OFFSET> OF DISPLAY OR PRINT COMMAND                >>         06020000
<<***********************************************************>>         06025000
DOUBLE PROCEDURE PARSEOFFSET(PARMWORDS);                                06030000
  VALUE PARMWORDS;                                                      06035000
  DOUBLE PARMWORDS;  <<DOUBLE-WORD RETURNED BY "MYCOMMAND">>            06040000
BEGIN                                                                   06045000
                                                                        06050000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     06055000
  <<                                             >>                     06060000
  <<   CCG - SYNTAX ERROR                        >>                     06065000
  <<   CCE - SUCCESSFUL                          >>                     06070000
  <<   CCL - UNDEFINED "DISPLACEMENT" SPECIFIED  >>                     06075000
                                                                        06080000
 << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                      06085000
 << FOLLOWING PROCEDURES: GETNUMBER, GETDSTADDR,>>                      06090000
 << GETCSTADDR, EXPREVAL, AND CORE              >>                      06095000
                                                                        06100000
EQUATE  MAXINDIRECT =  5,                                               06105000
           MAXPARMS = 50;                                               06110000
                                                                        06115000
                                                                        06120000
DEFINE  ALPHACHAR = (8:1)#,                                             06125000
               CC = STATUS.(6:2)#,                                      06130000
           LENGTH = (0:8)#;                                             06135000
                                                                        06140000
LOGICAL  FLAGWORD,       <<WORD RETURNED BY MYCOMMAND>>                 06145000
         INFOWORD,       <<WORD RETURNED BY MYCOMMAND>>                 06150000
           STATUS = Q-1, <<STATUS REGISTER IN MARKER>>                  06155000
          TEMPPTR;       <<TEMPORARY>>                                  06160000
INTEGER      BANK,       <<BANK # OF BASE ADDRESS>>                     06165000
           CSTNUM,       <<CST TO DISPLAY>>                             06170000
           DSTNUM,       <<DST TO DISPLAY>>                             06175000
               IN,       <<LOOP VARIABLE>>                              06180000
           OFFSET,       <<WORDS TO OFFSET>>                            06185000
       NUMINDIRECT,       <<# PARMS WITH : DELIMITER>>                  06190000
         NUMPARMS;       <<# PARMS IN REGISTER BASE>>                   06195000
DOUBLE   ADDRBASE,       <<STARTING ADDRESS TO DISPLAY>>                06200000
     INDIRECTBASE;       <<ADDR USED FOR INDIRECTION>>                  06205000
                                                                        06210000
DOUBLE ARRAY INDIRECTPARMS(0:MAXINDIRECT),                              06215000
                     PARMS(0:MAXPARMS);                                 06220000
BYTE ARRAY      DELIMITERS(0:3);                                        06225000
                                                                        06230000
BYTE POINTER  STRING;  <<STRING TO PARSE>>                              06235000
                                                                        06240000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         06245000
TOS:=PARMWORDS;    <<DECODE DOUBLE WORD FROM MYCOMMAND>>                06250000
FLAGWORD:=TOS;                                                          06255000
@STRING:=TOS;      <<GUARANTEED NO LEADING BLANKS>>                     06260000
                                                                        06265000
STRING(FLAGWORD.LENGTH):=CR;  <<REQUIRED BY MYCOMMAND>>                 06270000
                              <<MAY OVERLAY A ",">>                     06275000
                                                                        06280000
<<PARSE STRING TO SEPARATE LEVELS OF INDIRECTION>>                      06285000
<<EACH WILL CONSIST OF SEPARATE EXPRESSION TO EVALUATE>>                06290000
DELIMITERS(0):=":";                                                     06295000
DELIMITERS(1):=CR;                                                      06300000
MYCOMMAND(STRING,DELIMITERS,MAXINDIRECT,NUMINDIRECT,                    06305000
          INDIRECTPARMS);                                               06310000
IF <> THEN BEGIN                                                        06315000
  CC:=CCG;                                                              06320000
  RETURN; END;                                                          06325000
                                                                        06330000
<<WE KNOW THERE MUST BE AT LEAST ONE PARM; OTHERWISE THIS >>            06335000
<<PROCEDURE WOULD NOT HAVE BEEN CALLED.  IT MUST BE       >>            06340000
<<THE NAME OF REGISTER TO USE AS A BASE (WHICH INCLUDES   >>            06345000
<<DST #S, ABSOLUTE ADDRESS MODE, AND EXTENDED ADDRESS     >>            06350000
<<MODE), AND POSSIBLY AN EXPRESSION.  IF NO REGISTER      >>            06355000
<<IS SPECIFIED, THEN DB IS ASSUMED.                       >>            06360000
                                                                        06365000
<<ONCE AGAIN WE ARE GUARANTEED AT LEAST ONE CHARACTER >>                06370000
<<DETERMINE WHAT REGISTER BASE WAS SPECIFIED       >>                   06375000
TOS:=INDIRECTPARMS(0);   <<DECODE DOUBLE WORD FROM MYCOMMAND>>          06380000
INFOWORD:=TOS;                                                          06385000
TEMPPTR:=TOS;                                                           06390000
                                                                        06395000
<<MUST PLACE A <CR> AT END OF 1ST PARM (BASE ADDRESS)>>                 06400000
<<SINCE SUBSEQUENT CALL TO "EXPREVAL" WILL EXPECT IT >>                 06405000
STRING(INFOWORD.LENGTH):=CR;  <<MAY REPLACE A ":">>                     06410000
                                                                        06415000
IF NOT INFOWORD.ALPHACHAR THEN BEGIN                                    06420000
  TOS:=DBBANKREG;                                                       06425000
  TOS:=DBREG;                                                           06430000
  ADDRBASE:=TOS; END <<NONE SPECIFIED - ASSUME DB>>                     06435000
ELSE BEGIN                                                              06440000
  IF STRING = "Q" THEN BEGIN   <<Q RELATIVE >>                          06445000
    INFOWORD.LENGTH:=1;                                                 06450000
    TOS:=ZBANKREG;                                                      06455000
    TOS:=QREG;                                                          06460000
    ADDRBASE:=TOS;                                                      06465000
    TOS:=DBBANKREG;                                                     06470000
    TOS:=DBREG;                                                         06475000
    INDIRECTBASE:=TOS; END                                              06480000
  ELSE                                                                  06485000
  IF STRING = "SY" THEN BEGIN   << SYSBASE RELATIVE>>                   06490000
    <<SET LENGTH SO ENTIRE EXPRESSION EVALUATED  >>                     06495000
    INFOWORD.LENGTH:=2;                                                 06500000
    ADDRBASE:=SYSDB;                                                    06505000
    INDIRECTBASE:=SYSDB; END                                            06510000
  ELSE                                                                  06515000
  IF STRING = "S" THEN BEGIN    << S RELATIVE >>                        06520000
    INFOWORD.LENGTH:=1;                                                 06525000
    TOS:=ZBANKREG;                                                      06530000
    TOS:=SREG;                                                          06535000
    ADDRBASE:=TOS;                                                      06540000
    TOS:=DBBANKREG;                                                     06545000
    TOS:=DBREG;                                                         06550000
    INDIRECTBASE:=TOS; END                                              06555000
  ELSE                                                                  06560000
  IF STRING = "A" THEN BEGIN    << ABSOLUTE >>                          06565000
    ADDRBASE:=0D;                                                       06570000
    <<SPECIFIED ADDRESS COMPUTED COMPUTED BELOW  >>                     06575000
    <<SET LENGTH SO ENTIRE EXPRESSION EVALUATED  >>                     06580000
    INFOWORD.LENGTH:=1;                                                 06585000
    INDIRECTBASE:=0D; END                                               06590000
  ELSE                                                                  06595000
  IF STRING = "DB" THEN BEGIN   << DB RELATIVE >>                       06600000
    INFOWORD.LENGTH:=2;                                                 06605000
    TOS:=DBBANKREG;                                                     06610000
    TOS:=DBREG;                                                         06615000
    ADDRBASE:=TOS;                                                      06620000
    TOS:=DBBANKREG;                                                     06625000
    TOS:=DBREG;                                                         06630000
    INDIRECTBASE:=TOS; END                                              06635000
  ELSE BEGIN                                                            06640000
    <<FOR THE REMAINING POSSIBILITIES, THE BASE VALUE IS >>             06645000
    <<DELIMITED BY EITHER A "+" OR "-".  MUST CALL       >>             06650000
    <<MYCOMMAND TO PARSE 1ST PARAMETER AGAIN>>                          06655000
    DELIMITERS(0):="+";                                                 06660000
    DELIMITERS(1):="-";                                                 06665000
    DELIMITERS(2):=CR;                                                  06670000
    MYCOMMAND(STRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               06675000
    IF <> THEN BEGIN                                                    06680000
      CC:=CCG;                                                          06685000
      RETURN; END;                                                      06690000
                                                                        06695000
    TOS:=PARMS(0);                                                      06700000
    FLAGWORD:=TOS;                                                      06705000
    DEL;      <<DON'T NEED THE BYTE POINTER>>                           06710000
                                                                        06715000
    IF STRING = "EA" THEN BEGIN  << EXTENDED ADDRESSING >>              06720000
      BANK:=GETNUMBER(STRING(2),FLAGWORD.LENGTH-2);                     06725000
      IF <> THEN BEGIN                                                  06730000
        CC:=CCL;   <<INVALID BANK NUMBER>>                              06735000
        RETURN; END;                                                    06740000
      TOS:=BANK;                                                        06745000
      TOS:=0;                                                           06750000
      ADDRBASE:=TOS;                                                    06755000
      INFOWORD.LENGTH:=FLAGWORD.LENGTH;                                 06760000
      INDIRECTBASE:=SYSDB; END                                          06765000
    ELSE                                                                06770000
    IF STRING = "DA" THEN BEGIN   << DATA >>                            06775000
      DSTNUM:=GETNUMBER(STRING(2),FLAGWORD.LENGTH-2);                   06780000
      IF <> THEN BEGIN                                                  06785000
        CC:=CCL;   <<INVALID DST NUMBER>>                               06790000
        RETURN; END;                                                    06795000
                                                                        06800000
      <<GET ADDRESS OF THE DST NUMBER>>                                 06805000
      ADDRBASE:=GETDSTADDR(DSTNUM);                                     06810000
      IF <> THEN BEGIN                                                  06815000
        CC:=CCL;                                                        06820000
        RETURN; END;                                                    06825000
      INFOWORD.LENGTH:=FLAGWORD.LENGTH;                                 06830000
      INDIRECTBASE:=ADDRBASE; END                                       06835000
    ELSE                                                                06840000
    IF STRING = "CO" THEN BEGIN    <<CODE >>                            06845000
      CSTNUM:=GETNUMBER(STRING(2),FLAGWORD.LENGTH-2);                   06850000
      IF <> THEN BEGIN                                                  06855000
        CC:=CCL;                                                        06860000
        RETURN; END;                                                    06865000
                                                                        06870000
      <<GET ADDRESS OF CST>>                                            06875000
      ADDRBASE:=GETCSTADDR(CSTNUM);                                     06880000
      IF <> THEN BEGIN                                                  06885000
        CC:=CCL;                                                        06890000
        RETURN; END;                                                    06895000
      INFOWORD.LENGTH:=FLAGWORD.LENGTH;                                 06900000
      INDIRECTBASE:=ADDRBASE; END                                       06905000
    ELSE BEGIN                                                          06910000
      CC:=CCL;   <<INVALID SPECIFICATION>>                              06915000
      RETURN; END; END;                                                 06920000
                                                                        06925000
  @STRING:=TEMPPTR+INFOWORD.LENGTH; END;                                06930000
                                                                        06935000
<<IF WE REACH THIS POINT, WE HAVE DETERMINED THE BASE ADDR>>            06940000
<<WE NOW WANT TO PARSE THE EXPRESSION TO GET THE OFFSET   >>            06945000
OFFSET:=EXPREVAL(STRING);  <<ALREADY HAVE <CR> AT END>>                 06950000
IF <> THEN BEGIN                                                        06955000
  CC:=CCG;                                                              06960000
  RETURN; END;                                                          06965000
                                                                        06970000
TOS := ADDRBASE;                                                        06975000
TOS := TOS+LOGICAL(OFFSET);                                             06980000
ADDRBASE := TOS;                                                        06985000
                                                                        06990000
<<NOW LOOP UNTIL ALL LEVELS OF INDIRECTION ARE EXHAUSTED>>              06995000
FOR IN:=1 UNTIL NUMINDIRECT-1 DO BEGIN                                  07000000
  <<REDEFINE ADDRESS BASE DUE TO INDIRECTION>>                          07005000
  ADDRBASE:=INDIRECTBASE+DOUBLE(CORE(ADDRBASE));                        07010000
  TOS:=INDIRECTPARMS(IN);  <<DECODE DOUBLE WORD FROM MYCOMMAND>>        07015000
  INFOWORD:=TOS;                                                        07020000
  @STRING:=TOS;   <<SET POINTER TO START OF EXPRESSION>>                07025000
                                                                        07030000
  IF INFOWORD.LENGTH > 0 THEN BEGIN                                     07035000
    STRING(INFOWORD.LENGTH):=CR;  <<MAY REPLACE A ":">>                 07040000
    OFFSET:=EXPREVAL(STRING);                                           07045000
    IF <> THEN BEGIN                                                    07050000
      CC:=CCG;  <<UNABLE TO PARSE EXPRESSION>>                          07055000
      RETURN; END; END                                                  07060000
  ELSE                                                                  07065000
    OFFSET:=0;                                                          07070000
                                                                        07075000
  TOS := ADDRBASE;                                                      07080000
  TOS := TOS+LOGICAL(OFFSET);                                           07085000
  ADDRBASE := TOS;                                                      07090000
  END;                                                                  07095000
                                                                        07100000
PARSEOFFSET:=ADDRBASE;                                                  07105000
                                                                        07110000
END;  <<PARSEOFFSET>>                                                   07115000
$PAGE "                     PROCEDURE PARSECOUNT"                       07120000
<<***********************************************************>>         07125000
<< PARSECOUNT                                                >>         07130000
<<----------------------------------------------------------->>         07135000
<< PARSE <COUNT> OF DISPLAY OR PRINT COMMAND                 >>         07140000
<<***********************************************************>>         07145000
DOUBLE PROCEDURE PARSECOUNT(PARMWORDS);                                 07150000
  VALUE PARMWORDS;                                                      07155000
  DOUBLE PARMWORDS;  <<DOUBLE-WORD RETURNED BY "MYCOMMAND">>            07160000
BEGIN                                                                   07165000
                                                                        07170000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     07175000
  <<                                             >>                     07180000
  <<   CCG - SYNTAX ERROR                        >>                     07185000
  <<   CCE - SUCCESSFUL                          >>                     07190000
  <<   CCL - NEGATIVE COUNT                      >>                     07195000
                                                                        07200000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     07205000
  << GLOBAL VARIABLE CR AND THE PROC. EXPREVAL   >>                     07210000
                                                                        07215000
DEFINE  CC = STATUS.(6:2)#;                                             07220000
DEFINE  LENGTH = INFOWORD.(0:8)#;                                       07225000
                                                                        07230000
BYTE POINTER  STRING;  <<STRING TO PARSE>>                              07235000
                                                                        07240000
LOGICAL INFOWORD,       <<WORD FROM MYCOMMAND>>                         07245000
          STATUS = Q-1, <<STATUS REGISTER IN MARKER>>                   07250000
            TEMP;       <<TEMPORARY>>                                   07255000
                                                                        07260000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         07265000
                                                                        07270000
TOS:=PARMWORDS;                                                         07275000
INFOWORD:=TOS;                                                          07280000
@STRING:=TOS;                                                           07285000
                                                                        07290000
STRING(LENGTH):=CR;                                                     07295000
                                                                        07300000
TEMP:=EXPREVAL(STRING);                                                 07305000
IF = THEN                                                               07310000
  IF INTEGER(TEMP) < 0 THEN                                             07315000
    CC:=CCL                                                             07320000
  ELSE BEGIN                                                            07325000
    TOS:=0;                                                             07330000
    TOS:=TEMP;                                                          07335000
    PARSECOUNT:=TOS; END                                                07340000
ELSE                                                                    07345000
  CC:=CCG;                                                              07350000
                                                                        07355000
END;  <<PARSECOUNT>>                                                    07360000
$PAGE "                     PROCEDURE PARSEMODE"                        07365000
<<***********************************************************>>         07370000
<< PARSEMODE                                                 >>         07375000
<<----------------------------------------------------------->>         07380000
<< PARSE <MODE> OF DISPLAY OR PRINT COMMAND                  >>         07385000
<<***********************************************************>>         07390000
INTEGER PROCEDURE PARSEMODE(PARMWORDS);                                 07395000
  VALUE PARMWORDS;                                                      07400000
  DOUBLE PARMWORDS;  <<DOUBLE-WORD RETURNED BY "MYCOMMAND">>            07405000
BEGIN                                                                   07410000
                                                                        07415000
  << CONDITION CODE IS RETURNED AS FOLLOWS:      >>                     07420000
  <<                                             >>                     07425000
  <<   CCG - SYNTAX ERROR                        >>                     07430000
  <<   CCE - SUCCESSFUL                          >>                     07435000
  <<   CCL - UNDEFINED "MODE" SPECIFIED          >>                     07440000
                                                                        07445000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     07450000
  << FOLLOWING GLOBAL VARIABLES:                 >>                     07455000
  <<      OCTAL'MODE        INTEGER'MODE         >>                     07460000
  <<      ASCII'MODE        CODE'MODE            >>                     07465000
                                                                        07470000
DEFINE  ALPHACHAR = FLAGWORD.(8:1)#,                                    07475000
               CC = STATUS.(6:2)#,                                      07480000
           LENGTH = FLAGWORD.(0:8)#;                                    07485000
                                                                        07490000
LOGICAL  FLAGWORD,       <<2ND WORD RETURNED BY MYCOMMAND>>             07495000
           STATUS = Q-1; <<STATUS REGISTER IN MARKER>>                  07500000
INTEGER  TEMPMODE;       <<TEMPORARY>>                                  07505000
                                                                        07510000
BYTE POINTER STRING;     <<THE <MODE> PORTION OF COMMAND>>              07515000
                                                                        07520000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         07525000
                                                                        07530000
<<RETRIEVE VALUES FROM DOUBLE WORD RETURNED BY "MYCOMMAND">>            07535000
TOS:=PARMWORDS;                                                         07540000
FLAGWORD:=TOS;                                                          07545000
@STRING:=TOS;                                                           07550000
                                                                        07555000
IF LENGTH <> 1 OR NOT(ALPHACHAR) THEN BEGIN                             07560000
  <<MODE SHOULD BE A SINGLE ALPHABETIC CHARACTER>>                      07565000
  CC:=CCG;                                                              07570000
  RETURN; END;                                                          07575000
                                                                        07580000
<<DETERMINE WHICH MODE SPECIFIED>>                                      07585000
TEMPMODE:=IF STRING = "O" THEN OCTAL'MODE                               07590000
          ELSE                                                          07595000
          IF STRING = "I" THEN INTEGER'MODE                             07600000
          ELSE                                                          07605000
          IF STRING = "A" THEN ASCII'MODE                               07610000
          ELSE                                                          07615000
          IF STRING = "C" THEN CODE'MODE                                07620000
                          ELSE -1;                                      07625000
                                                                        07630000
IF TEMPMODE = -1 THEN                                                   07635000
  CC:=CCL   <<INVALID MODE>>                                            07640000
ELSE                                                                    07645000
  PARSEMODE:=TEMPMODE;                                                  07650000
                                                                        07655000
END;  <<PARSEMODE>>                                                     07660000
$PAGE "                     PROCEDURE PARSEDISPLAY"                     07665000
<<***********************************************************>>         07670000
<< PARSEDISPLAY                                              >>         07675000
<<----------------------------------------------------------->>         07680000
<< PARSE THE "DISPLAY" COMMAND                               >>         07685000
<<***********************************************************>>         07690000
PROCEDURE PARSEDISPLAY(PARMSTRING,START,COUNT,DISPMODE);                07695000
  INTEGER      DISPMODE;  <<MODE VALUE>>                                07700000
  DOUBLE          COUNT,  <<# OF WORDS TO DISPLAY>>                     07705000
                  START;  <<ADDRESS OF 1ST WORD TO DISPLAY>>            07710000
  BYTE ARRAY PARMSTRING; <<USER INPUT>>                                 07715000
BEGIN                                                                   07720000
                                                                        07725000
  << CONDITION CODE IS RETURNED AS FOLLOWS:   >>                        07730000
  <<                                          >>                        07735000
  <<   CCG - UNABLE TO PARSE USER INPUT       >>                        07740000
  <<   CCE - SUCCESSFUL                       >>                        07745000
  <<   CCL - SYNTAX ERROR DETECTED            >>                        07750000
                                                                        07755000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     07760000
  << GLOBAL VARIABLE DBREGD AND THE FOLLOWING    >>                     07765000
  << PROCEDURES:                                 >>                     07770000
  <<      PRINTERROR         PARSEOFFSET         >>                     07775000
  <<      PARSECOUNT         PARSEMODE           >>                     07780000
                                                                        07785000
EQUATE  MAXPARMS = 50;                                                  07790000
                                                                        07795000
DEFINE     CC = STATUS.(6:2)#,                                          07800000
       LENGTH = (0:8)#;                                                 07805000
                                                                        07810000
LOGICAL   STATUS = Q-1; <<STATUS REGISTER IN MARKER>>                   07815000
INTEGER NUMPARMS,       <<# PARMS FOUND BY "MYCOMMAND">>                07820000
            TEMP;       <<TEMPORARY>>                                   07825000
DOUBLE     DTEMP;       <<TEMPORARY>>                                   07830000
                                                                        07835000
DOUBLE ARRAY PARMS(0:MAXPARMS);  <<PARMS RETURNED BY THE>>              07840000
                                 <<MYCOMMAND INTRINSIC  >>              07845000
                                                                        07850000
BYTE ARRAY DELIMITERS(0:3);  <<DELIMITERS FOR MYCOMMAND>>               07855000
                                                                        07860000
CC:=CCE;   <<ASSUME NO ERRORS>>                                         07865000
                                                                        07870000
<<PARSE COMMAND TO GET <OFFSET>, <COUNT>, AND <MODE> >>                 07875000
DELIMITERS(0):=",";                                                     07880000
DELIMITERS(1):=CR;                                                      07885000
MYCOMMAND(PARMSTRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               07890000
IF <> THEN BEGIN                                                        07895000
  PRINTERROR(0);                                                        07900000
  CC:=CCG;                                                              07905000
  RETURN; END;                                                          07910000
                                                                        07915000
IF NOT (0 <= NUMPARMS <= 3) THEN BEGIN                                  07920000
  PRINTERROR(7);                                                        07925000
  CC:=CCL;                                                              07930000
  RETURN; END;                                                          07935000
                                                                        07940000
<<HAVE CORRECT NUMBER OF PARMS - SET UP DEFAULTS>>                      07945000
TOS:=DBBANKREG;                                                         07950000
TOS:=DBREG;                                                             07955000
START:=TOS;                                                             07960000
COUNT:=1D;                                                              07965000
DISPMODE:=OCTAL'MODE;                                                   07970000
                                                                        07975000
<<EVALUATE <OFFSET>, IF ONE WAS SPECIFIED>>                             07980000
IF NUMPARMS >= 1 THEN                                                   07985000
  IF LOGICAL(PARMS(0)).LENGTH > 0 THEN BEGIN                            07990000
    DTEMP:=PARSEOFFSET(PARMS(0));                                       07995000
    IF = THEN                                                           08000000
      START:=DTEMP                                                      08005000
    ELSE BEGIN                                                          08010000
      IF > THEN PRINTERROR(5)                                           08015000
           ELSE PRINTERROR(6);                                          08020000
      CC:=CCL;                                                          08025000
      RETURN; END; END;                                                 08030000
                                                                        08035000
<<EVALUATE <COUNT>, IF ONE WAS SPECIFIED>>                              08040000
IF NUMPARMS >= 2 THEN                                                   08045000
  IF LOGICAL(PARMS(1)).LENGTH > 0 THEN BEGIN                            08050000
    DTEMP:=PARSECOUNT(PARMS(1));                                        08055000
    IF = THEN                                                           08060000
      COUNT:=DTEMP                                                      08065000
    ELSE BEGIN                                                          08070000
      IF > THEN PRINTERROR(3)                                           08075000
           ELSE PRINTERROR(4);                                          08080000
      CC:=CCL;                                                          08085000
      RETURN; END; END;                                                 08090000
                                                                        08095000
<<EVALUATE <MODE>, IF ONE WAS SPECIFIED>>                               08100000
IF NUMPARMS >= 3 THEN                                                   08105000
  IF LOGICAL(PARMS(2)).LENGTH > 0 THEN BEGIN                            08110000
    TEMP:=PARSEMODE(PARMS(2));                                          08115000
    IF = THEN                                                           08120000
      DISPMODE:=TEMP                                                    08125000
    ELSE BEGIN                                                          08130000
      IF > THEN PRINTERROR(1)                                           08135000
           ELSE PRINTERROR(2);                                          08140000
      CC:=CCL;                                                          08145000
      RETURN; END; END;                                                 08150000
                                                                        08155000
END;  <<PARSEDISPLAY>>                                                  08160000
$PAGE "                     PROCEDURE DISPLAY"                          08165000
<<***********************************************************>>         08170000
<< DISPLAY                                                   >>         08175000
<<----------------------------------------------------------->>         08180000
<< EXECUTE THE "DISPLAY" COMMAND                             >>         08185000
<<***********************************************************>>         08190000
PROCEDURE DISPLAY(STARTADDR,DISPCOUNT,DISPLAYMODE);                     08195000
  VALUE STARTADDR,DISPCOUNT,DISPLAYMODE;                                08200000
  INTEGER DISPLAYMODE;  <<0: OCTAL>>                                    08205000
                        <<1: INTEGER>>                                  08210000
                        <<2: ASCII  >>                                  08215000
                        <<3: CODE   >>                                  08220000
  DOUBLE    DISPCOUNT,  <<# WORDS TO DISPLAY>>                          08225000
            STARTADDR;  <<ADDRESS OF 1ST WORD TO DISPLAY>>              08230000
BEGIN                                                                   08235000
                                                                        08240000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE GLOBAL >>              08245000
  << VARIABLE:                                          >>              08250000
  <<       OUTFILE              OCTAL'MODE      >>                      08255000
  <<       ASCII'MODE         OCTALDUMP (PROC)  >>                      08260000
                                                                        08265000
                                                                        08270000
DOUBLE  ENDADDR;  <<ADDRESS OF LAST WORD TO DISPLAY>>                   08275000
                                                                        08280000
ENDADDR:=STARTADDR+DISPCOUNT-1D;                                        08285000
                                                                        08290000
IF OCTAL'MODE <= DISPLAYMODE <= CODE'MODE THEN                          08295000
  OCTALDUMP(OUTFILE,STARTADDR,ENDADDR,DISPLAYMODE);                     08300000
                                                                        08305000
END;  <<DISPLAY>>                                                       08310000
$PAGE "                     PROCEDURE FMTSTACK"                         08315000
<<*********************************************>>                       08320000
<<  FMTSTACK                                   >>                       08325000
<<--------------------------------------------->>                       08330000
<< FORMATS AREA SPECIFIED AS A STACK           >>                       08335000
<<*********************************************>>                       08340000
PROCEDURE FMTSTACK(F'NUM,BASE'ADDR);                                    08345000
VALUE BASE'ADDR,                         <<ADDRESS OF PCBX>>            08350000
      F'NUM;                            <<FILE TO WRITE ON>>            08355000
DOUBLE BASE'ADDR;                                                       08360000
INTEGER F'NUM;                                                          08365000
<< THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                       08370000
<< PROCEDURES "CORE" AND "PRT'STK"             >>                       08375000
BEGIN                                                                   08380000
DOUBLE ADDR;                 <<SCRATCH COPY OF BASE'ADDR>>              08385000
LOGICAL BANK=ADDR,                              <<BANK #>>              08390000
      OFFSET=ADDR+1;              <<OFFSET WITHIN BANK>>                08395000
INTEGER CURRENT'S'PTR,               <<POINTER TO DELTA Q>>             08400000
         Q'INIT,                      <<FIRST STACK MARKER>>            08405000
         LEN,                          <<PARAM. FOR FWRITE>>            08410000
         DB'PTR,                      <<SEG REL DB POINTER>>            08415000
         SEG'OFF,                <<TEMP STORAGE FOR OFFSET>>            08420000
         DATA,                    <<CONTENTS OF A LOCATION>>            08425000
         COUNT:=1,                     <<# WORDS IN PXGLOB>>            08430000
         I:=8;                       <<COL # TO PLACE INFO>>            08435000
                                                                        08440000
ARRAY IOBUF(0:39);                      <<BUFFER FOR I/O>>              08445000
BYTE ARRAY IOBUFB(*)=IOBUF;                                             08450000
                                                                        08455000
EQUATE NO'RTN=%320,                       <<NO CR, NO LF>>              08460000
      S'SPACE=%40,                       <<SINGLE SPACE>>               08465000
      OCTAL=8,                            <<OCTAL VALUE>>               08470000
      PXGLOB'LEN=12,                 <<# WORDS IN PXGLOB>>              08475000
      SEG'REL'DB=1,            <<OFFSET IN PXGLOB OF DB>>               08480000
      JMAT'IX=3,       <<OFFSET IN PXGLOB OF JMAT INDEX>>               08485000
      JPCNT'IX=4,     <<OFFSET IN PXGLOB OF JPCNT INDEX>>               08490000
      IP'LDN=8,           <<OFFSET IN PXGLOB OF I/P LDN>>               08495000
      OP'LDN=9,           <<OFFSET IN PXGLOB OF O/P LDN>>               08500000
      JDT'DST'IX=10, <<OFFSET IN PXGLOB OF JDT DST INDEX>>              08505000
      JIT'DST'IX=11, <<OFFSET IN PXGLOB OF JIT DST INDEX>>              08510000
      JCUT'IX=5,       <<OFFSET IN PXGLOB OF JCUT INDEX>>               08515000
      UND=0,                  <<TYPE OF JOB - UNDEFINED>>               08520000
      SES=1,                    <<TYPE OF JOB - SESSION>>               08525000
      JOB=2,                        <<TYPE OF JOB - JOB>>               08530000
      TASK=3,                      <<TYPE OF JOB - TASK>>               08535000
      SEG'REL'S=13,                <<OFFSET IN PCBX OF S>>              08540000
      SEG'REL'QINIT=15;   <<OFFSET IN PCBX OF Q INITIAL>>               08545000
DEFINE                <<BIT LOCATION OF JMAT>>                          08550000
      TYPE=(2:2)#,           <<BIT LOCATION OF JOB TYPE>>               08555000
      DUP=(4:1)#,         <<BIT LOCATION OF DUPLICATIVE>>               08560000
      INT=(5:1)#;         <<BIT LOCATION OF INTERACTIVE>>               08565000
                                                                        08570000
   <<DUMP OUT PXGLOB>>                                                  08575000
   FWRITE(F'NUM,IOBUF,0,S'SPACE);                                       08580000
   MOVE IOBUF := "***PXGLOBAL***";         <<SET UP BUFFER>>            08585000
   FWRITE(F'NUM,IOBUF,-14,S'SPACE);        <<PRINT HEADING>>            08590000
   IF <> THEN QUIT(10);                                                 08595000
   FWRITE(F'NUM,IOBUF,0,S'SPACE);       <<PRINT BLANK LINE>>            08600000
   IF <> THEN QUIT(11);                                                 08605000
                                                                        08610000
   <<CLEAR BUFFER>>                                                     08615000
   IOBUF(0):="  ";                                                      08620000
   MOVE IOBUF(1):=IOBUF(0),(39);   <<FILL IOBUF WITH BLANKS>>           08625000
   ADDR:=BASE'ADDR;                 <<SET ADDR TO BASE'ADDR>>           08630000
   SEG'OFF:=OFFSET;                           <<SAVE OFFSET>>           08635000
   ASCII(OFFSET,OCTAL,IOBUFB);      <<MOVE OFFSET TO IOBUFB>>           08640000
   MOVE IOBUFB(6):=":";                                                 08645000
                                                                        08650000
   <<START PRINTING UNFORMATTED PXGLOB>>                                08655000
   WHILE COUNT <= PXGLOB'LEN/2 DO BEGIN     <<PRINT EACH WORD>>         08660000
      DATA:=CORE(ADDR);                  <<READ IN VALUE>>              08665000
      ASCII(DATA,OCTAL,IOBUFB(I));       <<CONVERT VALUE>>              08670000
      OFFSET := OFFSET + 1;           <<INCREMENT OFFSET>>              08675000
      I := I + 8;                      <<INCREMENT COL #>>              08680000
      COUNT := COUNT + 1;            <<INCREMENT COUNTER>>              08685000
      END;                                                              08690000
                                                                        08695000
   FWRITE(F'NUM,IOBUF,-79,S'SPACE);           <<PRINT BUFFER>>          08700000
   IF <> THEN QUIT(12);                                                 08705000
                                                                        08710000
                                                                        08715000
   ASCII(OFFSET,OCTAL,IOBUFB);      <<MOVE OFFSET TO IOBUFB>>           08720000
   MOVE IOBUFB(6):=":";                                                 08725000
   I:=8; COUNT:=1;                                                      08730000
                                                                        08735000
   <<START PRINTING UNFORMATTED PXGLOB>>                                08740000
   WHILE COUNT <= PXGLOB'LEN/2 DO BEGIN     <<PRINT EACH WORD>>         08745000
      DATA:=CORE(ADDR);                  <<READ IN VALUE>>              08750000
      ASCII(DATA,OCTAL,IOBUFB(I));       <<CONVERT VALUE>>              08755000
      OFFSET := OFFSET + 1;           <<INCREMENT OFFSET>>              08760000
      I := I + 8;                      <<INCREMENT COL #>>              08765000
      COUNT := COUNT + 1;            <<INCREMENT COUNTER>>              08770000
      END;                                                              08775000
                                                                        08780000
  FWRITE(F'NUM,IOBUF,-79,S'SPACE);                                      08785000
  IF <> THEN QUIT(12);                                                  08790000
   FWRITE(F'NUM,IOBUF,0,S'SPACE);                                       08795000
   IF <> THEN QUIT(17);                                                 08800000
   IOBUF(0):="  ";                                                      08805000
   MOVE IOBUF(1):=IOBUF(0),(39);              <<CLEAR BUFFER>>          08810000
                                                                        08815000
   <<PRINT FORMATTED PXGLOB>>                                           08820000
   MOVE IOBUFB := "SEG REL DL:";                   <<HEADING>>          08825000
   OFFSET:=SEG'OFF;                  <<SET DL OFFSET IN PCBX>>          08830000
   DATA:=CORE(ADDR);                      <<READ IN DL VALUE>>          08835000
   ASCII(DATA,OCTAL,IOBUFB(12));             <<CONVERT VALUE>>          08840000
   MOVE IOBUFB(19):="SEG REL DB:";                 <<HEADING>>          08845000
   OFFSET:=SEG'OFF+SEG'REL'DB;       <<SET DB OFFSET IN PCBX>>          08850000
   DATA:=CORE(ADDR);                      <<READ IN DB VALUE>>          08855000
   ASCII(DATA,OCTAL,IOBUFB(31));             <<CONVERT VALUE>>          08860000
   MOVE IOBUFB(38):="JMAT INDEX:";                 <<HEADING>>          08865000
   OFFSET:=SEG'OFF+JMAT'IX;        <<SET JMAT OFFSET IN PCBX>>          08870000
   DATA:=CORE(ADDR);                    <<READ IN JMAT INDEX>>          08875000
   ASCII(DATA,OCTAL,IOBUFB(52));        <<CONVERT VALUE>>               08880000
   MOVE IOBUFB(59):="JPCNT INDEX:";                <<HEADING>>          08885000
   OFFSET:=SEG'OFF+JPCNT'IX;      <<SET JPCNT OFFSET IN PCBX>>          08890000
   DATA:=CORE(ADDR);                   <<READ IN JPCNT INDEX>>          08895000
   ASCII(DATA,OCTAL,IOBUFB(73));       <<CONVERT VALUE>>                08900000
   FWRITE(F'NUM,IOBUF,-79,S'SPACE);           <<PRINT BUFFER>>          08905000
   IF <> THEN QUIT(13);                                                 08910000
   IOBUF(0):="  ";                                                      08915000
   MOVE IOBUF(1):=IOBUF(0),(39);              <<CLEAR BUFFER>>          08920000
   MOVE IOBUFB:="JOB IP LDN:";                     <<HEADING>>          08925000
   OFFSET:=SEG'OFF+IP'LDN;       <<SET OFFSET TO JOB I/P LDN>>          08930000
   DATA:=CORE(ADDR);                   <<READ IN JOB I/P LDN>>          08935000
   ASCII(DATA,OCTAL,IOBUFB(12));          <<CONVERT VALUE>>             08940000
   MOVE IOBUFB(19):="JOB OP LDN:";                 <<HEADING>>          08945000
   OFFSET:=SEG'OFF+OP'LDN;       <<SET OFFSET TO JOB O/P LDN>>          08950000
   DATA:=CORE(ADDR);                   <<READ IN JOB O/P LDN>>          08955000
   ASCII(DATA,OCTAL,IOBUFB(31));          <<CONVERT VALUE>>             08960000
   MOVE IOBUFB(38):="JDT DST INDX:";              <<HEADING>>           08965000
   OFFSET:=SEG'OFF+JDT'DST'IX;       <<SET OFFSET TO JDT DST>>          08970000
   DATA:=CORE(ADDR);                       <<READ IN JDT DST>>          08975000
   ASCII(DATA,OCTAL,IOBUFB(52));         <<CONVERT VALUE>>              08980000
   MOVE IOBUFB(59):="JIT DST INDX:";              <<HEADING>>           08985000
   OFFSET:=SEG'OFF+JIT'DST'IX;       <<SET OFFSET TO JIT DST>>          08990000
   DATA:=CORE(ADDR);                       <<READ IN JIT DST>>          08995000
   ASCII(DATA,OCTAL,IOBUFB(73));         <<CONVERT VALUE>>              09000000
   FWRITE(F'NUM,IOBUF,-79,S'SPACE);           <<PRINT BUFFER>>          09005000
   IF <> THEN QUIT(14);                                                 09010000
   IOBUF(0):="  ";                                                      09015000
   MOVE IOBUF(1):=IOBUF(0),(39);              <<CLEAR BUFFER>>          09020000
   MOVE IOBUFB:="JOB TYPE:";                       <<HEADING>>          09025000
   IF DATA.TYPE=UND THEN MOVE IOBUFB(12):="UNDEF"                       09030000
   ELSE IF DATA.TYPE=SES THEN MOVE IOBUFB(12):="SESSION"                09035000
   ELSE IF DATA.TYPE=JOB THEN MOVE IOBUFB(12):="JOB"                    09040000
   ELSE IF DATA.TYPE=TASK THEN MOVE IOBUFB(12):="TASK";                 09045000
   MOVE IOBUFB(19):="DUP:";                                             09050000
   IF DATA.DUP<>0 THEN MOVE IOBUFB(31):="YES"                           09055000
   ELSE MOVE IOBUFB(31):="NO";                                          09060000
   MOVE IOBUFB(38):="INTERACT:";                                        09065000
   IF DATA.INT <> 0 THEN MOVE IOBUFB(52):="YES"                         09070000
   ELSE MOVE IOBUFB(52):="NO";                                          09075000
   MOVE IOBUFB(59):="JCUT INDEX:";                 <<HEADING>>          09080000
   OFFSET:=SEG'OFF+JCUT'IX;             <<SET OFFSET TO JCUT>>          09085000
   DATA:=CORE(ADDR);                          <<READ IN JCUT>>          09090000
   ASCII(DATA,OCTAL,IOBUFB(73));        <<CONVERT VALUE>>               09095000
   FWRITE(F'NUM,IOBUF,-79,S'SPACE);           <<PRINT BUFFER>>          09100000
   IF <> THEN QUIT(15);                                                 09105000
   FWRITE(F'NUM,IOBUF,0,S'SPACE);         <<PRINT BLANK LINE>>          09110000
   IF <> THEN QUIT(16);                                                 09115000
   ADDR:=BASE'ADDR;                             <<RESET ADDR>>          09120000
   OFFSET:=OFFSET+1;                      <<SET OFFSET TO DB>>          09125000
   DB'PTR:=CORE(ADDR);                          <<SEG REL DB>>          09130000
                                                                        09135000
   <<SEG REL S>>                                                        09140000
   OFFSET:=SEG'OFF+SEG'REL'S;                                           09145000
   CURRENT'S'PTR:=CORE(ADDR)+LOGICAL(DB'PTR-2);                         09150000
   OFFSET:=SEG'OFF+SEG'REL'QINIT;     <<SET OFFSET TO QINIT>>           09155000
   Q'INIT:=CORE(ADDR)+LOGICAL(DB'PTR);      <<SEG REL QINIT>>           09160000
   PRT'STK(F'NUM,BASE'ADDR,CURRENT'S'PTR,Q'INIT);                       09165000
                                                                        09170000
  END;                                                                  09175000
$PAGE "                     PROCEDURE PRT'STK"                          09180000
<<**********************************************>>                      09185000
<<  PRT'STK                                     >>                      09190000
<<---------------------------------------------->>                      09195000
<< PRINTS FORMATTED STACK FROM Q INITIAL ON     >>                      09200000
<<**********************************************>>                      09205000
PROCEDURE PRT'STK(F'NUM,ADR,S,QINITL);                                  09210000
  VALUE F'NUM,                             <<FILE TO WRITE ON>>         09215000
        ADR,                                      <<BASE'ADDR>>         09220000
        S,                                <<SEG REL S POINTER>>         09225000
        QINITL;           <<SEG REL POINTER  TO BEG. OF STACK>>         09230000
                                                                        09235000
  INTEGER F'NUM,                                                        09240000
          S,                                                            09245000
          QINITL;                                                       09250000
                                                                        09255000
  DOUBLE ADR;                                                           09260000
                                                                        09265000
  << THIS PROCEDURE ASSUMES THE EXITENCE OF THE >>                      09270000
  << PROCEDURES "CORE", "PRINTERROR", AND       >>                      09275000
  << "GETCORE"                                  >>                      09280000
                                                                        09285000
                                                                        09290000
  BEGIN                                                                 09295000
    INTEGER COUNT,                 <<COUNTER FOR STACK MARKER>>         09300000
            J,                           <<INDEX FOR STK'MRKR>>         09305000
            I,                      <<COL # TO PLACE INFO. IN>>         09310000
            DELTA'Q,          <<# OF WORDS TO PREVIOUS MARKER>>         09315000
            HOLD'DQ,                <<SCRATCH COPY OF DELTA'Q>>         09320000
            HOLD'S;                       <<SCRATCH COPY OF S>>         09325000
                                                                        09330000
                                                                        09335000
    DOUBLE HOLD'ADR;                    <<SCRATCH COPY OF ADR>>         09340000
                                                                        09345000
                                                                        09350000
    LOGICAL HOLD'BNK=HOLD'ADR,                                          09355000
            HOLD'OFF=HOLD'ADR+1;                                        09360000
    LOGICAL BNK=ADR,                                                    09365000
            OFF=ADR+1;                                                  09370000
    LOGICAL OFFSET;                                                     09375000
    DOUBLE LOCPCB;                                                      09380000
    LOGICAL CURPROCSTK;                                                 09385000
    DOUBLE DSTBASE,                                                     09390000
           DSTBASEOFFSET;                                               09395000
    INTEGER STKDST;                                                     09400000
                                                                        09405000
    ARRAY BUF(0:39),                            <<I/O BUFFER>>          09410000
          STK'MRKR(0:3);                <<HOLDS STACK MARKER>>          09415000
                                                                        09420000
    BYTE ARRAY BUFB(*)=BUF;                                             09425000
                                                                        09430000
    EQUATE OCTAL=8,                             <<OCTAL VALUE>>         09435000
           S'SPACE=%40,                        <<SINGLE SPACE>>         09440000
           STK'WORDS=4;          <<# OF WORDS IN STACK MARKER>>         09445000
                                                                        09450000
    HOLD'ADR:=ADR;                               <<INITIALIZE>>         09455000
                                                                        09460000
    <<IF THIS IS CURRENT STACK, WE MUST TREAT IT DIFFERENTLY>>          09465000
    dstbase:=double(core(2d));                                          09470000
    locpcb:=getdstaddr(3);                                              09475000
    stkdst:=core(double(core(4d)+3)+locpcb).(2:14);            <<84228>>09480000
    dstbaseoffset:=double(stkdst*4)+dstbase;                            09485000
    curprocstk:=if core(dstbaseoffset+2d)=bnk and                       09490000
                   core(dstbaseoffset+3d)=off then                      09495000
                   true else false;                                     09500000
    offset := logical(s);                                               09505000
    if (core(4d) <> 0 ) and curprocstk then                             09510000
       begin                                                            09515000
       move buf:="* Current Process *";                                 09520000
       fwrite(f'num,buf,-19,s'space);                                   09525000
       if <> then quit(21);                                             09530000
       offset := qreg - off;                                            09535000
       end;                                                             09540000
                                                                        09545000
    <<CHECK FOR VALID STACK BY STEPPING THRU>>                          09550000
    HOLD'OFF:=HOLD'OFF+offset;               <<SEG REL OFFSET>>         09555000
    DELTA'Q:=CORE(HOLD'ADR);                <<SEG REL DELTA Q>>         09560000
    HOLD'DQ:=DELTA'Q;                  <<TEMP COPY OF DELTA Q>>         09565000
    HOLD'S:=integer(offset);                 <<TEMP COPY OF S>>         09570000
                                                                        09575000
    WHILE HOLD'S > QINITL DO BEGIN    <<WHILE WE HAVE MARKERS>>         09580000
          IF CTRLY THEN <<ESCAPE HATCH>>                                09585000
             BEGIN                                                      09590000
             MOVE BUF:=" <CONTROL-Y>";                                  09595000
             FWRITE(F'NUM,BUF,-12,%60);                                 09600000
             RETURN;                                                    09605000
             END;                                                       09610000
          HOLD'S:=HOLD'S-HOLD'DQ;    <<SET TO PREVIOUS MARKER>>         09615000
          HOLD'OFF:=HOLD'OFF-LOGICAL(HOLD'DQ);                          09620000
          HOLD'DQ:=CORE(HOLD'ADR);             <<READ DELTA Q>>         09625000
          END;                                                          09630000
                                                                        09635000
    IF HOLD'S <> QINITL THEN BEGIN  <<IF NOT AT MORGUE MARKER>>         09640000
       PRINTERROR(20);                                                  09645000
       RETURN;                                                          09650000
       END;                                                             09655000
                                                                        09660000
    MOVE BUF:=                                                          09665000
    "BANK    ADDRESS   X     DELTA P STATUS  DELTA Q ";                 09670000
                                                                        09675000
    FWRITE(F'NUM,BUF,-55,S'SPACE);                                      09680000
    IF <> THEN QUIT (21);                                               09685000
    FWRITE(F'NUM,BUF,0,S'SPACE);                                        09690000
    IF <> THEN QUIT(22);                                                09695000
                                                                        09700000
      <<RE INITIALIZE>>                                                 09705000
                                                                        09710000
    HOLD'ADR:=ADR;                            <<RESET TO PCBX>>         09715000
    HOLD'S:=integer(offset);           <<RESET TO LAST MARKER>>         09720000
    HOLD'OFF:=HOLD'OFF+LOGICAL(HOLD'S);  <<SET TO LAST MARKER>>         09725000
                                                                        09730000
       <<BEGIN OUTER LOOP TO PRINT ALL MARKERS>>                        09735000
                                                                        09740000
    WHILE HOLD'S > QINITL DO BEGIN                                      09745000
          IF CTRLY THEN RETURN;                                         09750000
          DELTA'Q:=CORE(HOLD'ADR);              <<GET DELTA Q>>         09755000
          HOLD'OFF:=                                                    09760000
             HOLD'OFF-LOGICAL(STK'WORDS-1);      <<ABS OFFSET>>         09765000
                                                                        09770000
          GETCORE(HOLD'ADR,STK'WORDS,STK'MRKR); <<READ MARKER>>         09775000
                                                                        09780000
          BUF(0):="  ";                                                 09785000
          MOVE BUF(1):=BUF(0),(39);            <<CLEAR BUFFER>>         09790000
                                                                        09795000
          ASCII(HOLD'BNK,OCTAL,BUFB);                                   09800000
                                                                        09805000
          ASCII(HOLD'OFF,OCTAL,BUFB(8));     <<LOAD OFFSET>>            09810000
              <<BEGIN INNER LOOP TO PRINT EACH MARKER>>                 09815000
                                                                        09820000
          COUNT:=1;                            << INITIALIZE>>          09825000
          J:=0;                                <<     "     >>          09830000
          I:=16;                               <<     "     >>          09835000
                                                                        09840000
          WHILE COUNT <= STK'WORDS DO BEGIN                             09845000
                 IF CTRLY THEN RETURN;                                  09850000
                 ASCII(STK'MRKR(J),OCTAL,BUFB(I));                      09855000
                 COUNT:=COUNT+1;            <<INCREMENT COUNT>>         09860000
                 J:=J+1;           <<INCREMENT STK'MRKR INDES>>         09865000
                 I:=I+8;                    <<INCREMENT COL #>>         09870000
                 END;                                                   09875000
                                                                        09880000
          HOLD'S:=HOLD'S-DELTA'Q;          <<DECREMENT HOLD'S>>         09885000
          HOLD'OFF:=OFF+LOGICAL(HOLD'S);  <<ABS END OF MARKER>>         09890000
                                                                        09895000
           FWRITE(F'NUM,BUF,-79,S'SPACE);      <<PRINT BUFFER>>         09900000
           IF <> THEN QUIT(23);                                         09905000
           END;                                                         09910000
  END;  <<PRT'STK>>                                                     09915000
$PAGE "                    PROCEDURE PROCDEAD"                          09920000
<<**********************************************>>                      09925000
<<  PROCDEAD                                    >>                      09930000
<<---------------------------------------------->>                      09935000
<< RETURNS TRUE IF PIN IS DEAD                  >>                      09940000
<<**********************************************>>                      09945000
  LOGICAL PROCEDURE PROCDEAD(PNUM);                                     09950000
                                                                        09955000
  VALUE PNUM;  <<REQUESTED PIN>>                                        09960000
  LOGICAL PNUM;                                                         09965000
                                                                        09970000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     09975000
  << PROCEDURE "CORE"                            >>                     09980000
                                                                        09985000
                                                                        09990000
    BEGIN                                                               09995000
    DOUBLE BASE;  <<ADDR OF 1ST WORD IN PCB ENTRY>>                     10000000
                                                                        10005000
    DOUBLE PCBBASE,                                                     10010000
             OFFSET;                                                    10015000
    PCBBASE:=GETDSTADDR(3);  <<GET PCBB FROM DST>>                      10020000
    BASE:=DOUBLE(PNUM*%25+15)+PCBBASE;                                  10025000
                                                                        10030000
    OFFSET:=BASE;  <<OFFSET=PCB ENTRY BASE ADDR>>                       10035000
                                                                        10040000
    <<CHECK IF PROCESS IS DEAD. THE LAST>>                              10045000
    <<WORD OF ITS PCB ENTRY WIL BE SET  >>                              10050000
    <<TO %177777 (-1) IF IT IS.         >>                              10055000
                                                                        10060000
    IF INTEGER(CORE(OFFSET))=%177777                                    10065000
      THEN PROCDEAD:=TRUE                                               10070000
      ELSE PROCDEAD:=FALSE;                                             10075000
                                                                        10080000
    END;  <<PROCDEAD>>                                                  10085000
$PAGE"               PROCEDURE NAME'IT"                                 10090000
<<*********************************************>>                       10095000
<<  NAME'IT                                    >>                       10100000
<<--------------------------------------------->>                       10105000
<< NAMES PIN IF ASSOCIATED TO A SYSTEM NAME    >>                       10110000
<<*********************************************>>                       10115000
  PROCEDURE NAME'IT(PNUM,BUFFER);                                       10120000
                                                                        10125000
  VALUE PNUM;  <<REQUESTED PIN>>                                        10130000
  LOGICAL PNUM;                                                         10135000
BYTE ARRAY BUFFER;                                                      10140000
                                                                        10145000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     10150000
  << PROCEDURE "CORE"                            >>                     10155000
                                                                        10160000
                                                                        10165000
    BEGIN                                                               10170000
                                                                        10175000
  LOGICAL ARRAY PINNUM(0:11);  <<ARRAY CONTAINING    >>                 10180000
                               <<THE PIN'S ASSOCIATED>>                 10185000
                               <<TO THE SYSTEM NAMES >>                 10190000
                                                                        10195000
    BYTE ARRAY SYSNAME(0:6*12-1)=PB:= <<ARRAY OF    >>                  10200000
                                      <<SYSTEM NAMES>>                  10205000
      "PROGEN",                                                         10210000
      "      ",                                                         10215000
      "UCOP  ",                                                         10220000
      "PFAIL ",                                                         10225000
      "DEVREC",                                                         10230000
      "DRUSG ",                                                         10235000
      "STMSG ",                                                         10240000
      "LOG   ",                                                         10245000
      "LOAD  ",                                                         10250000
      "IOMESS",                                                         10255000
      "SYSIO ",                                                         10260000
      "MEMLOG";                                                         10265000
                                                                        10270000
                                                                        10275000
    INTEGER INDEX:=0;                                                   10280000
    LOGICAL OFFSET;                                                     10285000
                                                                        10290000
    DEFINE NAME'ADDR=%1141#; <<ADDR OF TABLE BASE>>                     10295000
                                                                        10300000
    <<GET THE PIN'S FROM THE TABLE>>                                    10305000
                                                                        10310000
    WHILE INDEX <= 11 DO                                                10315000
      BEGIN                                                             10320000
      OFFSET:=LOGICAL(NAME'ADDR+INDEX); <<OFFSET=ENTRY IN TABLE>>       10325000
      PINNUM(INDEX):=CORE(DOUBLE(OFFSET))/21;                           10330000
      INDEX:=INDEX+1;                                                   10335000
      END;                                                              10340000
                                                                        10345000
    INDEX:=0;                                                           10350000
                                                                        10355000
    <<CHECK IF THE PIN HAS >>                                           10360000
    <<A SYSTEM-DEFINED NAME>>                                           10365000
                                                                        10370000
    WHILE INDEX<=11 DO                                                  10375000
      BEGIN                                                             10380000
      IF PNUM=PINNUM(INDEX) THEN                                        10385000
        BEGIN                                                           10390000
        <<IF THE PIN IS A MATCH,>>                                      10395000
        <<ASSIGN IT A NAME      >>                                      10400000
        MOVE BUFFER:=SYSNAME(INDEX*6),(6);                              10405000
        INDEX:=INDEX+12;                                                10410000
        END;                                                            10415000
      INDEX:=INDEX+1;                                                   10420000
      END;                                                              10425000
    END;  <<NAME'IT>>                                                   10430000
$PAGE"               PROCEDURE CURRENT"                                 10435000
<<*********************************************>>                       10440000
<<  CURRENT                                    >>                       10445000
<<--------------------------------------------->>                       10450000
<< RETURNS TRUE IF PIN IS CURRENT              >>                       10455000
<<*********************************************>>                       10460000
                                                                        10465000
  LOGICAL PROCEDURE CURRENT(PIN);                                       10470000
                                                                        10475000
  VALUE PIN;                                                            10480000
  LOGICAL PIN;   <<PROCESS ID NUMBER>>                                  10485000
                                                                        10490000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     10495000
  << PROCEDURE "CORE"                            >>                     10500000
                                                                        10505000
    BEGIN                                                               10510000
                                                                        10515000
    LOGICAL CURPCB;  <<ADDR OF CURRENT PCB ENTRY>>                      10520000
                                                                        10525000
    CURPCB:=CORE(4D);  <<GET CPCB FROM CORE>>                           10530000
                                                                        10535000
                                                                        10540000
  <<CHECK IF PIN IS CURRENT>>                                           10545000
    IF CURPCB/21=PIN                                                    10550000
      THEN CURRENT:=TRUE                                                10555000
      ELSE CURRENT:=FALSE;                                              10560000
                                                                        10565000
                                                                        10570000
    END;                                                                10575000
$PAGE"               PROCEDURE FMTPCBENTRY"                             10580000
<<*********************************************>>                       10585000
<<  FMTPCBENTRY                                >>                       10590000
<<--------------------------------------------->>                       10595000
<< FORMATS AND PRINTS PCB ENTRY                >>                       10600000
<<*********************************************>>                       10605000
                                                                        10610000
PROCEDURE FMTPCBENTRY(FLNUM,PIN,PCBENTRY);                              10615000
                                                                        10620000
VALUE FLNUM, <<FILE NO OF OUTPUT FILE>>                                 10625000
      PIN;   <<PROCESS ID NUMBER>>                                      10630000
INTEGER FLNUM;      <<FILE NUMBER>>                                     10635000
LOGICAL PIN;       <<PROCESS ID NUMBER>>                                10640000
                                                                        10645000
LOGICAL ARRAY PCBENTRY;   <<PCB ENTRY>>                                 10650000
                                                                        10655000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     10660000
  << PROCEDURE "PROCDEAD"                        >>                     10665000
                                                                        10670000
  BEGIN                                                                 10675000
  INTEGER LNUM,     <<LINE COUNT>>                                      10680000
          NUM,      <<INTEGER TO CONVERT TO ASCII>>                     10685000
          LEN,      <<LENGTH OF ASCII STRING>>                          10690000
          COUNT,    <<COUNT FOR        >>                               10695000
          TYPE;     <<PROCESS TYPE>>                                    10700000
                                                                        10705000
  LOGICAL DNUM;     <<DOUBLE TO CONVERT TO ASCII>>                      10710000
LOGICAL ARRAY LTXT(0:39);                                               10715000
BYTE ARRAY TEXT(*)=LTXT;                                                10720000
                                                                        10725000
                                                                        10730000
  BYTE ARRAY BTXT(0:5);    <<ARRAY FOR ASCII CONVERSIONS>>              10735000
  BYTE ARRAY DBTXT(0:11); <<ARRY FOR DOUBLE TO ASCII CONVERT>>          10740000
                                                                        10745000
                                                                        10750000
  DEFINE                                                                10755000
                                                                        10760000
    <<PROCESS IDLENTIFICATION>>                                         10765000
      PTYPE=9#,XPTYPE=(6:3)#,                                           10770000
                                                                        10775000
    <<DATA SEGMLENTS>>                                                  10780000
      XDS=2#,XXDS=(2:14)#,                                              10785000
      ABSDB=2#,XABSDB=(0:1)#,                                           10790000
      STK=3#,XSTK=(2:14)#,                                              10795000
      OVAL=3#,XOVAL=(0:1)#,                                             10800000
      LSTT=15#,                                                         10805000
                                                                        10810000
    <<FAMILY INFO>>                                                     10815000
      FR=5#,XFR=(0:16)#,                                                10820000
      SON=6#,XSON=(0:16)#,                                              10825000
      BR=7#,XBR=(0:16)#,                                                10830000
      OA=8#,XOA=(4:2)#,                                                 10835000
                                                                        10840000
    <<WAKES AND EVENTS>>                                                10845000
      WAKE=4#,EVENT=10#,                                                10850000
      M=(0:1)#,RG=(1:1)#,                                               10855000
      RL=(2:1)#,MA=(3:1)#,                                              10860000
      BIO=(4:1)#,IO=(5:1)#,                                             10865000
      UCOP=(6:1)#,JUNK=(7:1)#,                                          10870000
      TIMER=(8:1)#,MSG=(9:1)#,                                          10875000
      WSON=(10:1)#,FATHR=(11:1)#,                                       10880000
      IMP=(12:1)#,SIR=(13:1)#,                                          10885000
      TMOUT=(14:1)#,MEM=(15:1)#,                                        10890000
                                                                        10895000
    <<RESOURCES>>                                                       10900000
      CRIT=0#,XCRIT=(2:1)#,                                             10905000
      HSIR=0#,XHSIR=(3:1)#,                                             10910000
      SC=3#,XSC=(1:1)#,                                                 10915000
      NIMP=17#,XNIMP=(0:16)#,                                           10920000
      PIMP=16#,XPIMP=(0:16)#,                                           10925000
                                                                        10930000
    <<MISCELLANEOUS>>                                                   10935000
      BMS=9#,XBMS=(1:2)#,                                               10940000
      PPC=9#,XPPC=(3:2)#,                                               10945000
      PCST=11#,XPCST=(0:16)#,                                           10950000
      PCSTSEG=12#,                                                      10955000
      PXPT=14#,XPXPT=(0:16)#,                                           10960000
      SL=1#,XSL=(0:16)#,                                                10965000
      BPLK=18#,XBPLK=(0:16)#,                                           10970000
                                                                        10975000
    <<QUEUE LINKS>>                                                     10980000
      NQPN=19#,XNQPN=(0:16)#,                                           10985000
      PQPN=20#,XPQPN=(0:16)#,                                           10990000
                                                                        10995000
                                                                        11000000
    <<PSEUDO INTERRUPTS>>                                               11005000
      PSIM=8#,XPSIM=(0:3)#,                                             11010000
      HK=9#,XHK=(10:1)#,                                                11015000
      SK=9#,XSK=(11:1)#,                                                11020000
      ST=9#,XST=(12:1)#,                                                11025000
      HB=9#,XHB=(13:1)#,                                                11030000
      CY=9#,XCY=(14:1)#,                                                11035000
      BK=9#,XBK=(15:1)#,                                                11040000
      RITBK=0#,XRITBK=(15:1)#,                                          11045000
      PIOVR=0#,XPIOVR=(4:1)#,                                           11050000
                                                                        11055000
    <<LIFE/DEATH>>                                                      11060000
      LIVE=9#,XLIVE=(0:1)#,                                             11065000
      DEAD=8#,XDEAD=(6:1)#,                                             11070000
      FAC=8#,XFAC=(7:1)#,                                               11075000
                                                                        11080000
    <<SCHEDULE INFORMATION>>                                            11085000
      PRI=13#,XPRI=(8:8)#,                                              11090000
      DISPQ=13#,XDISPQ=(0:1)#,                                          11095000
      LQ=13#,XLQ=(1:1)#,                                                11100000
      CQ=13#,XCQ=(2:1)#,                                                11105000
      DQ=13#,XDQ=(3:1)#,                                                11110000
      EQ=13#,XEQ=(4:1)#,                                                11115000
      INTER=13#,XINTER=(5:1)#,                                          11120000
      CORER=13#,XCORER=(6:1)#,                                          11125000
      HIPRI=0#,XHIPRI=(13:1)#,                                          11130000
      USEDQ=0#,XUSEDQ=(12:1)#,                                          11135000
      TRW=0#,XTRW=(11:1)#,                                              11140000
      SW=0#,XSW=(10:1)#,                                                11145000
      LW=0#,XLW=(9:1)#,                                                 11150000
      MP=0#,XMP=(8:1)#,                                                 11155000
      PC=0#,XPC=(7:1)#,                                                 11160000
      IPEXP=0#,XIPEXP=(6:1)#,                                           11165000
      HSPRI=0#,XHSPRI=(5:1)#,                                           11170000
      SAR=0#,XSAR=(0:1)#,                                               11175000
      SOV=9#,XSOV=(5:1)#;                                               11180000
                                                                        11185000
                                                                        11190000
<<************************************************>>                    11195000
<<CHECKBIT                                        >>                    11200000
<<------------------------------------------------>>                    11205000
<<THIS SUBROUTINE CHECKS IF THE BIT SENT VIA THE  >>                    11210000
<<BIT PARAMETER IS SET OR NOT. IF IT IS, THEN THE >>                    11215000
<<STRING CONSTANT, "YES", IS INSERTED INTO THE    >>                    11220000
<<OUTPUT BUFFER AT THE COLUMN SPECIFIED BY COL.   >>                    11225000
<<************************************************>>                    11230000
                                                                        11235000
                                                                        11240000
  SUBROUTINE CKBIT(BIT,COL);                                            11245000
                                                                        11250000
  VALUE COL,BIT;                                                        11255000
  INTEGER COL;  <<COL IN WHICH TO INSERT YES>>                          11260000
  LOGICAL BIT;  <<BIT TO BE TESTED>>                                    11265000
                                                                        11270000
                                                                        11275000
    BEGIN                                                               11280000
    IF BIT THEN MOVE TEXT(COL):="YES";                                  11285000
    END;                                                                11290000
                                                                        11295000
                                                                        11300000
                                                                        11305000
      LNUM:=1;   <<INITIALIZE THE LINE COUNT>>                          11310000
      WHILE LNUM<=23 DO   <<LOOP THRU THE FORMAT LINES>>                11315000
        BEGIN                                                           11320000
        MOVE TEXT:=79(" ");  <<CLEAR OUT BUFFER>>                       11325000
        CASE LNUM OF  <<BRANCH TO APPROPRIATE >>                        11330000
          BEGIN         <<FORMAT LINE.          >>                      11335000
          ;   <<0 CASE>>                                                11340000
            BEGIN  <<LINE 1>>                                           11345000
            MOVE TEXT(4):="PROCESS ID";                                 11350000
            IF PROCDEAD(PIN) <<CALL PROCDEAD FOR TEST>>                 11355000
              THEN MOVE TEXT(29):="****NOT IN USE****";                 11360000
            MOVE TEXT(65):="SCHEDULE INFO";                             11365000
            END;                                                        11370000
                                                                        11375000
            BEGIN  <<LINE 2>>                                           11380000
            MOVE TEXT(2):="--------------";                             11385000
            MOVE TEXT(39):="RESOURCES";                                 11390000
            MOVE TEXT(65):="-------------";                             11395000
            END;                                                        11400000
                                                                        11405000
            BEGIN  <<LINE 3>>                                           11410000
            MOVE TEXT(4):="PIN: %";                                     11415000
            LEN:=ASCII(PIN,8,BTXT); <<CONVERSION>>                      11420000
            MOVE TEXT(11):=BTXT(6-LEN),(LEN); <<INSERT PIN>>            11425000
            MOVE TEXT(24):="WAKE  EVENT";                               11430000
            MOVE TEXT(37):="-------------";                             11435000
            MOVE TEXT(52):="PSEUDO INT";                                11440000
            MOVE TEXT(68):="PRI:";                                      11445000
            NUM:=PCBENTRY(PRI).XPRI; <<GET PRIO>>                       11450000
            LEN:=ASCII(NUM,8,BTXT); <<CONVERT PRIO>>                    11455000
            MOVE TEXT(73):=BTXT(6-LEN),(LEN); <<INSERT PRIO>>           11460000
            END;                                                        11465000
                                                                        11470000
                                                                        11475000
            BEGIN  <<LINE 4>>                                           11480000
            IF CURRENT(PIN) <<CALL CURRENT FOR TEST>>                   11485000
              THEN MOVE TEXT(4):="(CURRENT)" <<INSERT IF TRUE>>         11490000
              ELSE                                                      11495000
            MOVE TEXT(24):="MASKS FLAGS";                               11500000
            MOVE TEXT(41):="CRIT:";                                     11505000
            CKBIT(PCBENTRY(CRIT).XCRIT,47); <<TEST IF CRITCAL>>         11510000
            MOVE TEXT(52):="-----------";                               11515000
            END;                                                        11520000
                                                                        11525000
            BEGIN  <<LINE 5>>                                           11530000
            MOVE TEXT(2):="PTYPE:";                                     11535000
            NUM:=PCBENTRY(PTYPE).XPTYPE;  <<GET PROC TYPE #>>           11540000
            TYPE:=NUM;                                                  11545000
            CASE NUM OF <<ASSIGN PROCESS TYPE>>                         11550000
              BEGIN                                                     11555000
              MOVE TEXT(9):="USER";  <<PTYPE=0>>                        11560000
              MOVE TEXT(9):="USONM"; <<PTYPE=1>>                        11565000
              MOVE TEXT(9):="UMAIN"; <<PTYPE=2>>                        11570000
              MOVE TEXT(9):="UMTSK"; <<PTYPE=3>>                        11575000
              MOVE TEXT(9):="SYST";  <<PTYPE=4>>                        11580000
              MOVE TEXT(9):="SYS";   <<PTYPE=5>>                        11585000
              MOVE TEXT(9):="SYSTU"; <<PTYPE=6>>                        11590000
              ;                      <<PTYPE=7>>                        11595000
              END;                                                      11600000
            MOVE TEXT(24):="----- -----";                               11605000
            MOVE TEXT(41):="HSIR:";                                     11610000
            CKBIT(PCBENTRY(HSIR).XHSIR,47); <<TEST HSIR>>               11615000
            MOVE TEXT(53):="PSIM:";                                     11620000
            NUM:=PCBENTRY(PSIM).XPSIM; <<GET PSEUDO INT MODE>>          11625000
            CASE NUM OF  <<TEST PSIM>>                                  11630000
              BEGIN                                                     11635000
              ;   <<NUM=0>>                                             11640000
              MOVE TEXT(59):="HK";  <<HARD KILL>>                       11645000
              MOVE TEXT(59):="SK";  <<SOFT KILL>>                       11650000
              MOVE TEXT(59):="ST";  <<STOP>>                            11655000
              MOVE TEXT(59):="HB";  <<HIBERNATE>>                       11660000
              MOVE TEXT(59):="CY";  <<ESCAPE>>                          11665000
              MOVE TEXT(59):="BK";  <<BREAK>>                           11670000
              MOVE TEXT(59):="NORM";  <<NORMAL>>                        11675000
              END;                                                      11680000
            MOVE TEXT(66):="DISPQ:";                                    11685000
            CKBIT(PCBENTRY(DISPQ).XDISPQ,73); <<TEST DISPQ>>            11690000
             END;                                                       11695000
                                                                        11700000
                                                                        11705000
            BEGIN  <<LINE 6>>                                           11710000
            MOVE TEXT(3):="NAME:";                                      11715000
            NAME'IT(PIN,TEXT(9)); <<NAME THE PROCESS>>                  11720000
            MOVE TEXT(22):="M:";                                        11725000
            CKBIT(PCBENTRY(WAKE).M,25); <<TEST M WAKE FLAG>>            11730000
            CKBIT(PCBENTRY(EVENT).M,31); <<TEST M EVENT FLAG>>          11735000
            MOVE TEXT(43):="SC:";                                       11740000
            CKBIT(PCBENTRY(SC).XSC,47); <<TEST SC FLAG>>                11745000
            MOVE TEXT(55):="HK:";                                       11750000
            CKBIT(PCBENTRY(HK).XHK,59); <<TEST HK FLAG>>                11755000
            MOVE TEXT(69):="LQ:";                                       11760000
            CKBIT(PCBENTRY(LQ).XLQ,73); <<TEST LQ FLAG>>                11765000
            END;                                                        11770000
                                                                        11775000
            BEGIN  <<LINE 7>>                                           11780000
            MOVE TEXT(21):="RG:";                                       11785000
            CKBIT(PCBENTRY(WAKE).RG,25); <<TEST RG WAKE FLAG>>          11790000
            CKBIT(PCBENTRY(EVENT).RG,31); <<TEST RG EVENT>>             11795000
            MOVE TEXT(37):="NEXT IMP:";                                 11800000
            NUM:=PCBENTRY(NIMP)/21; <<GET NIMP>>                        11805000
            IF NUM <> 0 THEN  <<CHECK FOR NEXT IMP PROC>>               11810000
              BEGIN                                                     11815000
              LEN:=ASCII(NUM,8,BTXT); <<CONVERT NIMP>>                  11820000
              MOVE TEXT(47):=BTXT(6-LEN),(LEN); <<INSERT NIMP>>         11825000
              END;                                                      11830000
            MOVE TEXT(55):="SK:";                                       11835000
            CKBIT(PCBENTRY(SK).XSK,59);  <<TEST SK FLAG>>               11840000
            MOVE TEXT(69):="CQ:";                                       11845000
            CKBIT(PCBENTRY(CQ).XCQ,73);  <<TEST CQ FLAG>>               11850000
            END;                                                        11855000
                                                                        11860000
                                                                        11865000
            BEGIN  <<LINE 8>>                                           11870000
            MOVE TEXT(21):="RL:";                                       11875000
            CKBIT(PCBENTRY(WAKE).RL,25); <<TEST RL WAKE FLAG>>          11880000
            CKBIT(PCBENTRY(EVENT).RL,31); <<TEST RL EVENT>>             11885000
            MOVE TEXT(37):="PREV IMP:";                                 11890000
            NUM:=PCBENTRY(PIMP)/21 ; <<GET PIMP>>                       11895000
            IF NUM <> 0 THEN <<CHECK FOR PREV IMP PROC>>                11900000
              BEGIN                                                     11905000
              LEN:=ASCII(NUM,8,BTXT); <<CONVERT PIMP>>                  11910000
              MOVE TEXT(47):=BTXT(6-LEN),(LEN); <<INSERT PIMP>>         11915000
              END;                                                      11920000
            MOVE TEXT(55):="ST:";                                       11925000
            CKBIT(PCBENTRY(ST).XST,59);  <<TEST ST FLAG>>               11930000
            MOVE TEXT(69):="DQ:";                                       11935000
            CKBIT(PCBENTRY(DQ).XDQ,73);  <<TEST DQ FLAG>>               11940000
            END;                                                        11945000
                                                                        11950000
            BEGIN  <<LINE 9>>                                           11955000
            MOVE TEXT(2):="DATA SEGMENTS";                              11960000
            MOVE TEXT(21):="MA:";                                       11965000
            CKBIT(PCBENTRY(WAKE).MA,25); <<TEST MA WAKE FLAG>>          11970000
            CKBIT(PCBENTRY(EVENT).MA,31); <<TEST MA EVENT>>             11975000
            MOVE TEXT(55):="HB:";                                       11980000
            CKBIT(PCBENTRY(HB).XHB,59); <<TEST HB FLAG>>                11985000
            MOVE TEXT(69):="EQ:";                                       11990000
            CKBIT(PCBENTRY(EQ).XEQ,73); <<TEST EQ FLAG>>                11995000
            END;                                                        12000000
                                                                        12005000
            BEGIN  <<LINE 10>>                                          12010000
            MOVE TEXT(2):="--------------";                             12015000
            MOVE TEXT(20):="BIO:";                                      12020000
            CKBIT(PCBENTRY(WAKE).BIO,25); <<TEST BIO WAKE>>             12025000
            CKBIT(PCBENTRY(EVENT).BIO,31); <<TEST BIO EVENT>>           12030000
            MOVE TEXT(37):="MISCELLANEOUS";                             12035000
            MOVE TEXT(55):="CY:";                                       12040000
            CKBIT(PCBENTRY(CY).XCY,59); <<TEST CY FLAG>>                12045000
            MOVE TEXT(66):="INTER:";                                    12050000
            CKBIT(PCBENTRY(INTER).XINTER,73);  <<TEST INTER>>           12055000
            END;                                                        12060000
                                                                        12065000
                                                                        12070000
            BEGIN  <<LINE 11>>                                          12075000
            MOVE TEXT(6):="XDS:";                                       12080000
            NUM:=PCBENTRY(XDS).XXDS; <<GET XDS>>                        12085000
            IF NUM <> 0 THEN  <<CHECK FOR EX DATA SEG>>                 12090000
              BEGIN                                                     12095000
             LEN:=ASCII(NUM,8,BTXT);  <<CONVERT XDS>>                   12100000
             MOVE TEXT(11):=BTXT(6-LEN),(LEN); <<INSERT XDS>>           12105000
              END;                                                      12110000
            MOVE TEXT(21):="IO:";                                       12115000
            CKBIT(PCBENTRY(WAKE).IO,25); <<TEST IO WAKE FLAG>>          12120000
            CKBIT(PCBENTRY(EVENT).IO,31); <<TEST IO EVENT>>             12125000
            MOVE TEXT(37):="-------------";                             12130000
            MOVE TEXT(55):="BK:";                                       12135000
            CKBIT(PCBENTRY(BK).XBK,59); <<TEST BK FLAG>>                12140000
            MOVE TEXT(66):="CORER:";                                    12145000
            CKBIT(PCBENTRY(CORER).XCORER,73); <<TEST CORER>>            12150000
            END;                                                        12155000
                                                                        12160000
            BEGIN  <<LINE 12>>                                          12165000
            MOVE TEXT(3):="ABS DB:";                                    12170000
            CKBIT(PCBENTRY(ABSDB).XABSDB,11); <<TEST ABSDB>>            12175000
            MOVE TEXT(19):="UCOP:";                                     12180000
            CKBIT(PCBENTRY(WAKE).UCOP,25); <<TEST UCOP WAKE>>           12185000
            CKBIT(PCBENTRY(EVENT).UCOP,31); <<TEST UCOP EVENT>>         12190000
            MOVE TEXT(41):="BMS:";                                      12195000
            NUM:=PCBENTRY(BMS).XBMS;  <<GET BMS>>                       12200000
            CASE NUM OF <<TEST BMS>>                                    12205000
              BEGIN                                                     12210000
              MOVE TEXT(46 ):="SNF"; <<SENT TO FR>>                     12215000
              MOVE TEXT(46):="REF";  <<RECEIVED FROM FR>>               12220000
              MOVE TEXT(46):="SNS";  <<SENT TO SON>>                    12225000
              MOVE TEXT(46):="RES";  <<RECEIVED FROM SON>>              12230000
              END;                                                      12235000
            MOVE TEXT(52):="RITBK:";                                    12240000
            CKBIT(PCBENTRY(RITBK).XRITBK,59); <<TEST RITBK>>            12245000
            END;                                                        12250000
                                                                        12255000
            BEGIN  <<LINE 13>>                                          12260000
            MOVE TEXT(5):="LSTT:";                                      12265000
            NUM:=PCBENTRY(LSTT); <<GET LSTT>>                           12270000
            IF NUM <> 0 THEN  <<CHECK FOR LSTT DATA SEG>>               12275000
              BEGIN                                                     12280000
             LEN:=ASCII(NUM,8,BTXT);  <<CONVERT LSTT>>                  12285000
             MOVE TEXT(11):=BTXT(6-LEN),(LEN); <<INSERT LSTT>>          12290000
              END;                                                      12295000
            MOVE TEXT(19):="JUNK:";                                     12300000
            CKBIT(PCBENTRY(WAKE).JUNK,25); <<TEST JUNK WAKE>>           12305000
            CKBIT(PCBENTRY(EVENT).JUNK,31); <<TEST JUNK EVENT>>         12310000
            MOVE TEXT(41):="PPC:";                                      12315000
            NUM:=PCBENTRY(PPC).XPPC; <<GET PPC>>                        12320000
            CASE NUM OF <<TEST PPC>>                                    12325000
              BEGIN                                                     12330000
              MOVE TEXT(46):="NUL";   <<NULL>>                          12335000
               MOVE TEXT(46):="STF";   <<SON TO FR>>                    12340000
               MOVE TEXT(46):="FTS";   <<FR TO SON>>                    12345000
               MOVE TEXT(46):="BLK";   <<BLOCKED>>                      12350000
               END;                                                     12355000
            MOVE TEXT(52):="PIOVR:";                                    12360000
            CKBIT(PCBENTRY(PIOVR).XPIOVR,59); <<TEST PIOVR>>            12365000
            MOVE TEXT(66):="HIPRI:";                                    12370000
            CKBIT(PCBENTRY(HIPRI).XHIPRI,73);  <<TEST HIPRI>>           12375000
            END;                                                        12380000
                                                                        12385000
                                                                        12390000
            BEGIN  <<LINE 14>>                                          12395000
            MOVE TEXT(4):="STACK:";                                     12400000
            NUM:=PCBENTRY(STK).XSTK; <<GET STK ADDR>>                   12405000
            IF NUM <> 0 THEN                                            12410000
              BEGIN                                                     12415000
              LEN:=ASCII(NUM,8,BTXT); <<CONVERT STK ADDR>>              12420000
              MOVE TEXT(11):=BTXT(6-LEN),(LEN); <<INSERT STK ADDR>>     12425000
              END;                                                      12430000
            MOVE TEXT(18):="TIMER:";                                    12435000
            CKBIT(PCBENTRY(WAKE).TIMER,25); <<TEST TIMER WAKE>>         12440000
            CKBIT(PCBENTRY(EVENT).TIMER,31); <<TEST TMR EVENT>>         12445000
            MOVE TEXT(40):="PCST:";                                     12450000
            DNUM:=PCBENTRY(PCST); <<GET PCST>>                          12455000
            NUM:=INTEGER(DNUM); <<CONVERT PCST TO INTEGER>>             12460000
            IF NUM <> 0 THEN <<CHECK FOR NONZERO PCST>>                 12465000
              BEGIN                                                     12470000
              LEN:=DASCII(DOUBLE(DNUM),8,DBTXT); <<CONVERT>>            12475000
              MOVE TEXT(46):=DBTXT(11-LEN),(LEN+1); <<INSERT PCST>>     12480000
              END;                                                      12485000
            DNUM:=PCBENTRY(PCSTSEG); <<GET PCST SEGMENT NUMBER>>        12490000
            NUM:=INTEGER(DNUM); <<CONVERT PCST TO INTEGER>>             12495000
            IF NUM <> 0 THEN <<CHECK FOR NONZERO PCST>>                 12500000
              BEGIN                                                     12505000
              LEN:=DASCII(DOUBLE(DNUM),8,DBTXT); <<CONVERT>>            12510000
              MOVE TEXT(53):=DBTXT(11-LEN),(LEN+1); <<INSERT PCST>>     12515000
              END;                                                      12520000
            MOVE TEXT(66):="USEDQ:";                                    12525000
            CKBIT(PCBENTRY(USEDQ).XUSEDQ,73); <<TEST USEDQ>>            12530000
            END;                                                        12535000
                                                                        12540000
            BEGIN  <<LINE 15>>                                          12545000
            MOVE TEXT(3):="OV ALC:";                                    12550000
            CKBIT(PCBENTRY(OVAL).XOVAL,11); <<TEXT OVAL FLAG>>          12555000
            MOVE TEXT(20):="MSG:";                                      12560000
            CKBIT(PCBENTRY(WAKE).MSG,25); <<TEST MSG WAKE>>             12565000
            CKBIT(PCBENTRY(EVENT).MSG,31); <<TEST MSG EVENT>>           12570000
            MOVE TEXT(37):="PBX PTR:";                                  12575000
            DNUM:=PCBENTRY(PXPT); <<GET PBX PTR>>                       12580000
            NUM:=INTEGER(DNUM); <<CONVERT PBX PTR TO INTEGER>>          12585000
            IF NUM <> 0 THEN <<CHECK FOR NONZERO PBX PTR>>              12590000
              BEGIN                                                     12595000
              LEN:=DASCII(DOUBLE(DNUM),8,DBTXT); <<CONVERT>>            12600000
              MOVE TEXT(46):=DBTXT(11-LEN),(LEN+1); <<INSERT PBX PTR>>  12605000
              END;                                                      12610000
            MOVE TEXT(69):="TRW:";                                      12615000
            CKBIT(PCBENTRY(TRW).XTRW,73); <<TEST TRW FLAG>>             12620000
            END;                                                        12625000
                                                                        12630000
            BEGIN  <<LINE 16>>                                          12635000
            MOVE TEXT(20):="SON:";                                      12640000
            CKBIT(PCBENTRY(WAKE).WSON,25); <<TEST SON WAKE>>            12645000
            CKBIT(PCBENTRY(EVENT).WSON,31); <<TEST SON EVENT>>          12650000
            MOVE TEXT(38):="SL PTR:";                                   12655000
            DNUM:=PCBENTRY(SL); <<GET SL>>                              12660000
            NUM:=INTEGER(DNUM); <<CONVERT SL TO INTEGER>>               12665000
            IF NUM <> 0 THEN <<CHECK FOR NONZERO SL>>                   12670000
              BEGIN                                                     12675000
              LEN:=DASCII(DOUBLE(DNUM),8,DBTXT); <<CONVERT>>            12680000
              MOVE TEXT(46):=DBTXT(11-LEN),(LEN+1); <<INSERT SL>>       12685000
              END;                                                      12690000
            MOVE TEXT(70):="SW:";                                       12695000
            CKBIT(PCBENTRY(SW).XSW,73); <<TEST SW FLAG>>                12700000
            END;                                                        12705000
                                                                        12710000
            BEGIN  <<LINE 17>>                                          12715000
            MOVE TEXT(18):="FATHR:";                                    12720000
            CKBIT(PCBENTRY(WAKE).FATHR,25); <<TEST FR WAKE>>            12725000
            CKBIT(PCBENTRY(EVENT).FATHR,31); <<TEST FR EVENT>>          12730000
            MOVE TEXT(38):="BPLINK:";                                   12735000
            NUM:=PCBENTRY(BPLK); <<GET BK PT LINK>>                     12740000
            IF NUM <> 0 THEN  <<CHECK FOR NONZERO BPLK>>                12745000
              BEGIN                                                     12750000
             LEN:=ASCII(DNUM,8,BTXT); <<CONVERT TO ASCII>>              12755000
             MOVE TEXT(46):=BTXT(6-LEN),(LEN);  <<INSERT BPLK>>         12760000
              END;                                                      12765000
            MOVE TEXT(52):="LIFE/DEATH";                                12770000
            MOVE TEXT(69):="LW:";                                       12775000
            CKBIT(PCBENTRY(LW).XLW,73); <<TEST LW FLAG>>                12780000
            END;                                                        12785000
                                                                        12790000
            BEGIN  <<LINE 18>>                                          12795000
            MOVE TEXT(3):="FAMILY INFO";                                12800000
            MOVE TEXT(20):="IMP:";                                      12805000
            CKBIT(PCBENTRY(WAKE).IMP,25); <<TEST IMP WAKE>>             12810000
            CKBIT(PCBENTRY(EVENT).IMP,31); <<TEST IMP EVENT>>           12815000
            MOVE TEXT(52):="-----------";                               12820000
            MOVE TEXT(69):="MP:";                                       12825000
            CKBIT(PCBENTRY(MP).XMP,73); <<TEST MP FLAG>>                12830000
            END;                                                        12835000
                                                                        12840000
            BEGIN <<LINE 19>>                                           12845000
            MOVE TEXT(2):="--------------";                             12850000
            MOVE TEXT(20):="SIR:";                                      12855000
            CKBIT(PCBENTRY(WAKE).SIR,25); <<TEST SIR WAKE>>             12860000
            CKBIT(PCBENTRY(EVENT).SIR,31); <<TEST SIR EVENT>>           12865000
            MOVE TEXT(38):="QUEUE LINKS";                               12870000
            MOVE TEXT(53):="LIVE:";                                     12875000
            CKBIT(PCBENTRY(LIVE).XLIVE,59);<<TEST LIVE FLAG>>           12880000
            MOVE TEXT(69):="PC:";                                       12885000
            CKBIT(PCBENTRY(PC).XPC,73); <<TEST PC FLAG>>                12890000
            END;                                                        12895000
                                                                        12900000
                                                                        12905000
            BEGIN  <<LINE 20>>                                          12910000
            MOVE TEXT(4):="FATHER:";                                    12915000
            NUM:=PCBENTRY(FR)/21;  <<GET FATHER PTR>>                   12920000
            IF NUM <> 0 THEN                                            12925000
              BEGIN                                                     12930000
              LEN:=ASCII(NUM,8,BTXT); <<CONVERT FR PTR>>                12935000
              MOVE TEXT(12):=BTXT(6-LEN),(LEN); <<INSERT FATHER PTR>>   12940000
              END;                                                      12945000
            MOVE TEXT(18):="TMOUT:";                                    12950000
            CKBIT(PCBENTRY(WAKE).TMOUT,25); <<TEST TMOUT WAKE>>         12955000
            CKBIT(PCBENTRY(EVENT).TMOUT,31);<<TEST TMOUT EVNT>>         12960000
            MOVE TEXT(37):="-------------";                             12965000
            MOVE TEXT(53):="DEAD:";                                     12970000
            CKBIT(PCBENTRY(DEAD).XDEAD,59);  <<TEST DEAD FLAG>>         12975000
            MOVE TEXT(66):="IPEXP:";                                    12980000
            CKBIT(PCBENTRY(IPEXP).XIPEXP,73); <<TEST IPEXP>>            12985000
            END;                                                        12990000
                                                                        12995000
            BEGIN  <<LINE 21>>                                          13000000
            MOVE TEXT(7):="SON:";                                       13005000
            NUM:=PCBENTRY(SON)/21; <<GET SON PTR>>                      13010000
            IF NUM <> 0 THEN  <<CHECK FOR NONZERO SON PTR>>             13015000
              BEGIN                                                     13020000
              LEN:=ASCII(NUM,8,BTXT); <<CONVERT SON PTR>>               13025000
              MOVE TEXT(12):=BTXT(6-LEN),(LEN); <<INSERT SON PTR>>      13030000
              END;                                                      13035000
            MOVE TEXT(20):="MEM:";                                      13040000
            CKBIT(PCBENTRY(WAKE).MEM,25); <<TEST MEM WAKE>>             13045000
            CKBIT(PCBENTRY(EVENT).MEM,31); <<TEST MEM EVENT>>           13050000
            MOVE TEXT(37):="NQPIN:";                                    13055000
            DNUM:=PCBENTRY(NQPN)/21; <<GET NEXT Q PIN>>                 13060000
            NUM:=INTEGER(DNUM); <<CONVERT NEXT Q PIN>>                  13065000
            IF (NUM <> 0) AND (NUM<>-1) THEN <<CK FOR NEXT Q PIN>>      13070000
              BEGIN                                                     13075000
              LEN:=DASCII(DOUBLE(DNUM),8,DBTXT);  <<CONVERT>>           13080000
              MOVE TEXT(44):=DBTXT(11-LEN),(LEN+1); <<INSERT NQPN>>     13085000
              END;                                                      13090000
            MOVE TEXT(54):="FAC:";                                      13095000
            CKBIT(PCBENTRY(FAC).XFAC,59); <<TEST FAC FLAG>>             13100000
            MOVE TEXT(66):="HSPRI:";                                    13105000
            CKBIT(PCBENTRY(HSPRI).XHSPRI,73); <<TEST HSPRI>>            13110000
            END;                                                        13115000
                                                                        13120000
                                                                        13125000
            BEGIN  <<LINE 22>>                                          13130000
            MOVE TEXT(3):="BROTHER:";                                   13135000
            NUM:=PCBENTRY(BR)/21; <<GET BR PTR>>                        13140000
            IF NUM <> 0 THEN <<CHECK FOR NONZERO BR PTR>>               13145000
              BEGIN                                                     13150000
             LEN:=ASCII(NUM,8,BTXT);  <<CONVERT BR PTR>>                13155000
             MOVE TEXT(12):=BTXT(6-LEN),(LEN); <<INSERT BR PTR>>        13160000
              END;                                                      13165000
            MOVE TEXT(37):="PQPIN:";                                    13170000
            DNUM:=PCBENTRY(PQPN)/21; <<GET PREV Q PIN>>                 13175000
            NUM:=INTEGER(DNUM); <<CONVERT PQPN TO INTEGER>>             13180000
            IF (NUM<>0) AND (NUM<>-1) THEN <<CK FOR VALID PQPN>>        13185000
              BEGIN                                                     13190000
             LEN:=DASCII(DOUBLE(DNUM),8,DBTXT); <<CONVERT>>             13195000
             MOVE TEXT(44):=DBTXT(11-LEN),(LEN+1); <<INSERT PQPN>>      13200000
              END;                                                      13205000
            MOVE TEXT(68):="SAR:";                                      13210000
            CKBIT(PCBENTRY(SAR).XSAR,73); <<TEST SAR FLAG>>             13215000
            END;                                                        13220000
                                                                        13225000
                                                                        13230000
            BEGIN  <<LINE 23>>                                          13235000
            MOVE TEXT(8):="OA:";                                        13240000
            NUM:=PCBENTRY(OA).XOA; <<TEST OA FLAG>>                     13245000
            CASE NUM OF                                                 13250000
              BEGIN                                                     13255000
              ;        << OTHER SOURCE>>                                13260000
              MOVE TEXT(12):="F";  <<FATHER>>                           13265000
              MOVE TEXT(12):="S";  <<SON>>                              13270000
              MOVE TEXT(12):="R";  <<RIT>>                              13275000
              END;                                                      13280000
            MOVE TEXT(68):="SOV:";                                      13285000
            CKBIT(PCBENTRY(SOV).XSOV,73);                               13290000
            END;                                                        13295000
          END;  <<CASE STATEMENT>>                                      13300000
                                                                        13305000
        FWRITE(FLNUM,LTXT,-79,0);  <<PRINT OUT FORMATED LINE>>          13310000
                                                                        13315000
        LNUM:=LNUM+1;  <<INCREMENT LINE COUNT>>                         13320000
        END; <<WHILE STMT>>                                             13325000
    END;  <<FMTPCBENTRY>>                                               13330000
$PAGE "                     PROCEDURE FORMATINFO"                       13335000
<<***********************************************************>>         13340000
<< FORMATINFO                                                >>         13345000
<<----------------------------------------------------------->>         13350000
<< PARSE AND EXECUTE THE "FORMAT" COMMAND                    >>         13355000
<<***********************************************************>>         13360000
PROCEDURE FORMATINFO(PARMSTRING);                                       13365000
  BYTE ARRAY PARMSTRING;  <<PARAMETER STRING>>                          13370000
BEGIN                                                                   13375000
                                                                        13380000
                                                                        13385000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     13390000
  << GLOBAL VARIABLES "PCB'GOOD", "DST'GOOD",    >>                     13395000
  << AND "OUTFILE" AS WELL AS THE FOLLOWING      >>                     13400000
  << PROCEDURES:                                 >>                     13405000
  <<        PRINTERROR           PARSEOFFSET     >>                     13410000
  <<        GETNUMBER            VALIDPIN        >>                     13415000
  <<        CORE                 GETSTACKDST     >>                     13420000
  <<        GETDSTADDR           GETCORE         >>                     13425000
  <<        FMTPCBENTRY          FMTSTACK        >>                     13430000
                                                                        13435000
EQUATE  MAXPARMS = 4;                                                   13440000
                                                                        13445000
EQUATE  FMT'PCB    =  1,                                                13450000
        FMT'DST    =  2,                                                13455000
        FMT'CST    =  3,                                                13460000
        FMT'CSTX   =  4,                                                13465000
        FMT'STACK  =  5,                                                13470000
        FMT'REGS   =  6,                                                13475000
        FMT'SIR    =  7;                                                13480000
                                                                        13485000
DEFINE  LENGTH = INFOWORD.(0:8)#;                                       13490000
                                                                        13495000
LOGICAL   INFOWORD;  <<WORD FROM MYCOMMAND>>                            13500000
INTEGER     DSTNUM,  <<DST NUMBER TO FORMAT>>                           13505000
           ITEMNUM,  <<REQUESTED ITEM TO FORMAT>>                       13510000
               PIN,  <<PIN NUMBER TO FORMAT>>                           13515000
          NUMPARMS;  <<NUMBER OF PARAMETERS>>                           13520000
DOUBLE     ADDRESS;  <<ADDRESS OF ITEM TO FORMAT>>                      13525000
                                                                        13530000
LOGICAL ARRAY PCBENTRY(0:15);                                           13535000
DOUBLE ARRAY  PARMS(0:MAXPARMS); <<PARMS RETURNED>>                     13540000
BYTE ARRAY DELIMITERS(0:1);                                             13545000
                                                                        13550000
BYTE POINTER  STRING;                                                   13555000
                                                                        13560000
OWN BYTE ARRAY ITEMLIST(0:34):=  <<LIST FOR SEARCH INTRINSIC>>          13565000
   5, 3, "PCB",                                                         13570000
   5, 3, "DST",                                                         13575000
   5, 3, "CST",                                                         13580000
   6, 4, "CSTX",                                                        13585000
   7, 5, "STACK",                                                       13590000
   5, 4, "SIR",                                                         13595000
   0;                                                                   13600000
                                                                        13605000
<<SET UP TO PARSE THE PARAMETERS>>                                      13610000
DELIMITERS(0):=",";                                                     13615000
DELIMITERS(1):=CR;                                                      13620000
MYCOMMAND(PARMSTRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               13625000
IF <> THEN BEGIN                                                        13630000
  PRINTERROR(0);                                                        13635000
  RETURN; END;                                                          13640000
                                                                        13645000
<<DETERMINE WHAT IS TO BE FORMATTED>>                                   13650000
IF NUMPARMS = 0 THEN RETURN;  <<NOTHING SPECIFIED>>                     13655000
IF NUMPARMS > 2 THEN BEGIN                                              13660000
  PRINTERROR(10);                                                       13665000
  RETURN; END;                                                          13670000
TOS:=PARMS(0);                                                          13675000
INFOWORD:=TOS;                                                          13680000
@STRING:=TOS;                                                           13685000
                                                                        13690000
STRING(LENGTH):=CR;  <<REQUIRED BY "EXPREVAL">>                         13695000
                                                                        13700000
ADDRESS:=PARSEOFFSET(PARMS(0));                                         13705000
IF = THEN BEGIN                                                         13710000
  <<USER SPECIFIED A VALID ADDRESS - DETERMINE FORMAT>>                 13715000
  IF NUMPARMS <> 2 THEN BEGIN                                           13720000
    PRINTERROR(10);  <<DID NOT SPECIFY ANY FORMAT>>                     13725000
    RETURN; END;                                                        13730000
  TOS:=PARMS(1);                                                        13735000
  INFOWORD:=TOS;                                                        13740000
  @STRING:=TOS;                                                         13745000
                                                                        13750000
  ITEMNUM:=SEARCH(STRING,LENGTH,ITEMLIST);                              13755000
  IF ITEMNUM = 0 THEN BEGIN                                             13760000
    PRINTERROR(11);  <<INVALID FORMAT SPECIFIED>>                       13765000
    RETURN; END; END                                                    13770000
ELSE BEGIN                                                              13775000
  <<FIRST PARAMETER IS NOT A VALID ADDRESS - DETERMINE>>                13780000
  <<WHAT ENTITY WAS SPECIFIED>>                                         13785000
  IF STRING = "PCB" THEN BEGIN                                          13790000
    PIN:=GETNUMBER(STRING(3),LENGTH-3);                                 13795000
    IF <> THEN BEGIN                                                    13800000
      PRINTERROR(12);                                                   13805000
      RETURN; END;                                                      13810000
                                                                        13815000
    IF NOT VALIDPIN(PIN) THEN BEGIN                                     13820000
      PRINTERROR(15);                                                   13825000
      RETURN; END;                                                      13830000
                                                                        13835000
    <<NOW DETERMINE IF TO FORMAT PCB ENTRY OR STACK>>                   13840000
    IF NUMPARMS = 1 THEN BEGIN                                          13845000
      <<FORMAT THE PCB ENTRY>>                                          13850000
      ITEMNUM:=FMT'PCB;                                                 13855000
      IF PCB'GOOD THEN                                                  13860000
        ADDRESS:=GETDSTADDR(3)+DOUBLE(LOGICAL(PIN)*%25)                 13865000
      ELSE BEGIN                                                        13870000
        PRINTERROR(14);                                                 13875000
        RETURN; END; END                                                13880000
    ELSE BEGIN                                                          13885000
      <<EXAMINE THE SECOND PARAMETER>>                                  13890000
      TOS:=PARMS(1);                                                    13895000
      INFOWORD:=TOS;                                                    13900000
      @STRING:=TOS;                                                     13905000
                                                                        13910000
      ITEMNUM:=SEARCH(STRING,LENGTH,ITEMLIST);                          13915000
      IF ITEMNUM <> FMT'STACK THEN BEGIN                                13920000
        PRINTERROR(11);                                                 13925000
        RETURN; END;                                                    13930000
                                                                        13935000
      <<GET ADDRESS OF THE STACK>>                                      13940000
      DSTNUM:=GETSTACKDST(PIN);                                         13945000
      IF <> THEN RETURN;                                                13950000
      ADDRESS:=GETDSTADDR(DSTNUM);                                      13955000
      IF <> THEN RETURN; END; END                                       13960000
  ELSE                                                                  13965000
  IF STRING = "DST" THEN BEGIN                                          13970000
    DSTNUM:=GETNUMBER(STRING(3),LENGTH-3);                              13975000
    IF <> THEN BEGIN                                                    13980000
      PRINTERROR(12);                                                   13985000
      RETURN; END;                                                      13990000
                                                                        13995000
    <<DETERMINE IF DST ENTRY OR A STACK TO BE FORMATTED>>               14000000
    IF NUMPARMS = 1 THEN BEGIN                                          14005000
      ITEMNUM:=FMT'DST;                                                 14010000
      IF DST'GOOD THEN                                                  14015000
        ADDRESS:=DOUBLE(CORE(2D)+LOGICAL(DSTNUM)*4)                     14020000
      ELSE BEGIN                                                        14025000
        PRINTERROR(13);                                                 14030000
        RETURN; END; END                                                14035000
    ELSE BEGIN                                                          14040000
      <<EXAMINE THE 2ND PARAMETER>>                                     14045000
      TOS:=PARMS(1);                                                    14050000
      INFOWORD:=TOS;                                                    14055000
      @STRING:=TOS;                                                     14060000
                                                                        14065000
      ITEMNUM:=SEARCH(STRING,LENGTH,ITEMLIST);                          14070000
      IF ITEMNUM <> FMT'STACK THEN BEGIN                                14075000
        PRINTERROR(11);                                                 14080000
        RETURN; END;                                                    14085000
                                                                        14090000
      <<GET ADDRESS OF THE STACK>>                                      14095000
      ADDRESS:=GETDSTADDR(DSTNUM);                                      14100000
      IF <> THEN RETURN; END; END                                       14105000
  ELSE                                                                  14110000
    IF STRING = "REG" THEN ITEMNUM:= FMT'REGS                           14115000
  ELSE                                                                  14120000
    IF STRING = "SIR" THEN ITEMNUM:= FMT'SIR                            14125000
  ELSE                                                                  14130000
    PRINTERROR(11); END;                                                14135000
                                                                        14140000
<<NOW CALL THE APPROPRIATE ROUTINE TO FORMAT THE ITEM>>                 14145000
CASE ITEMNUM-1 OF BEGIN                                                 14150000
    <<PCB>> BEGIN                                                       14155000
            GETCORE(ADDRESS,%25,PCBENTRY);                              14160000
            IF = THEN                                                   14165000
              FMTPCBENTRY(OUTFILE,PIN,PCBENTRY); END;                   14170000
    <<DST>> ;                                                           14175000
    <<CST>> ;                                                           14180000
   <<CSTX>> ;                                                           14185000
  <<STACK>> FMTSTACK(OUTFILE,ADDRESS);                                  14190000
   <<REGS>> FMTREGS(OUTFILE);                                           14195000
    <<SIR>> BEGIN                                                       14200000
            MOVE BUF:="PLEASE WAIT.  SIR TABLE IS BEING FORMATTED...";  14205000
            FWRITE(OUTFILE,LBUF,-45,0);                                 14210000
            FMTSIR(OUTFILE);  END                                       14215000
                                                                        14220000
END;  <<CASE>>                                                          14225000
                                                                        14230000
END;  <<FORMATINFO>>                                                    14235000
                                                                        14240000
$PAGE   "                     PROCEDURE DEADLK'ERR"                     14245000
<<***********************************************************>>         14250000
<<  DEADLK'ERR                                               >>         14255000
<<----------------------------------------------------------->>         14260000
<<  THIS PROCEDURE IS RESPONSIBLE FOR PRINTING THE MESSAGE   >>         14265000
<<  INDICATING A SIR DEADLOCK SITUATION WAS FOUND AND WHAT   >>         14270000
<<  PINS ARE DEADLOCKED.                                     >>         14275000
<<    INPUT:  an array of pins that were found in the dead-  >>         14280000
<<            lock situation.                                >>         14285000
<<                                                           >>         14290000
<<            the number of pins in the array                >>         14295000
<<                                                           >>         14300000
<<            the output file number                         >>         14305000
<<***********************************************************>>         14310000
                                                                        14315000
PROCEDURE DEADLK'ERR(HLDRS'IMPD,MARKER,CHAIN,PRNTFILE);                 14320000
   VALUE MARKER,CHAIN,PRNTFILE;                                         14325000
   INTEGER MARKER,CHAIN,PRNTFILE;                                       14330000
   INTEGER ARRAY HLDRS'IMPD;                                            14335000
                                                                        14340000
   BEGIN                                                                14345000
      INTEGER INDEX,CHAR'LEN,REPEAT;                                    14350000
                                                                        14355000
      INDEX:= MARKER;                                                   14360000
      REPEAT:= CHAIN;                                                   14365000
      BUF := " ";   MOVE BUF(1) := BUF, (79);                  <<84301>>14370000
      MOVE BUF:="************************************************";     14375000
      FWRITE(PRNTFILE,LBUF,-79,0);                                      14380000
      MOVE BUF:="THE FOLLOWING PINS ARE IN A SIR DEADLOCK...     ";     14385000
      FWRITE(PRNTFILE,LBUF,-48,0);                                      14390000
      MOVE BUF:=80(" ");                                                14395000
      FWRITE(PRNTFILE,LBUF,-79,0);                                      14400000
      WHILE REPEAT > 0 DO BEGIN                                         14405000
         MOVE BUF(3):="PIN";                                            14410000
         @PBUF:=@BUF+7;                                                 14415000
         PUTNUMP(HLDRS'IMPD(INDEX));                                    14420000
         FWRITE(PRNTFILE,LBUF,-79,0);                                   14425000
         INDEX:=INDEX+1;                                                14430000
         REPEAT:= REPEAT -1;                                            14435000
         BUF := " ";   MOVE BUF(1) := BUF, (79);               <<84301>>14440000
         END;                                                           14445000
      END;                                                              14450000
                                                                        14455000
                                                                        14460000
$PAGE   "                     PROCEDURE FIND'DEADLOCK"                  14465000
<<***********************************************************>>         14470000
<<  FIND'DEADLOCK                                            >>         14475000
<<----------------------------------------------------------->>         14480000
<<  THIS PROCEDURE FINDS SIR DEADLOCK SITUATIONS THAT EXIST  >>         14485000
<<  BETWEEN PINS THAT ARE BOTH HOLDING SIRS AND WAITING FOR  >>         14490000
<<  OTHER SIRS.  INPUT:  *AN ARRAY OF PINS THAT ARE BOTH     >>         14495000
<<                        WAITING FOR SIRS AND HOLDING SIRS  >>         14500000
<<                                                           >>         14505000
<<                       *AN ARRAY OF PINS THAT ARE HOLDING  >>         14510000
<<                        THE SIRS THAT THE PINS IN THE FIRST>>         14515000
<<                        ARRAY ARE WAITING FOR.             >>         14520000
<<***********************************************************>>         14525000
PROCEDURE FIND'DEADLOCK(HLDRS'IMPD,IMPDRS);                             14530000
   INTEGER ARRAY HLDRS'IMPD,IMPDRS;                                     14535000
                                                                        14540000
   BEGIN                                                                14545000
      INTEGER INDEX:=0;                                                 14550000
      INTEGER SEARCH'PIN,START'PIN;                                     14555000
      INTEGER MARKER,CHAIN;                                             14560000
      LOGICAL FOUND;                                                    14565000
                                                                        14570000
      START'PIN:=HLDRS'IMPD(INDEX);                                     14575000
      SEARCH'PIN:= IMPDRS(INDEX);                                       14580000
      MARKER:=INDEX;                                                    14585000
                                                                        14590000
      WHILE HLDRS'IMPD(MARKER)<>0 DO BEGIN                              14595000
         CHAIN:= 1;                                                     14600000
         WHILE SEARCH'PIN <> START'PIN AND HLDRS'IMPD(INDEX)<>0 DO BEGIN14605000
            FOUND:=FALSE;                                               14610000
            WHILE NOT FOUND AND HLDRS'IMPD(INDEX)<>0 DO BEGIN           14615000
               IF HLDRS'IMPD(INDEX) = SEARCH'PIN                        14620000
                  THEN FOUND:= TRUE                                     14625000
                  ELSE INDEX:=INDEX + 1; END;                           14630000
            IF FOUND = TRUE THEN BEGIN                                  14635000
               SEARCH'PIN:= IMPDRS(INDEX);                              14640000
               CHAIN:= CHAIN + 1;                                       14645000
               INDEX:= 0; END; END;                                     14650000
         IF SEARCH'PIN = START'PIN THEN BEGIN                           14655000
            DEADLK'ERR(HLDRS'IMPD,MARKER,CHAIN,OUTFILE);                14660000
            MARKER:= MARKER + CHAIN;                                    14665000
            START'PIN:=HLDRS'IMPD(MARKER);                              14670000
            SEARCH'PIN:=IMPDRS(MARKER); END                             14675000
         ELSE MARKER:= MARKER + 1;                                      14680000
         INDEX:= MARKER; END; END;                                      14685000
                                                                        14690000
$PAGE   "                     PROCEDURE BUILD'LIST"                     14695000
<<***********************************************************>>         14700000
<<  BUILD'LIST                                               >>         14705000
<<----------------------------------------------------------->>         14710000
<<  THIS PROCEDURE IS RESPONSIBLE FOR BUILDING TWO LISTS ;   >>         14715000
<<       1)  ARRAY HLDRS'IMPD: A LIST OF PINS THAT ARE BOTH  >>         14720000
<<           HOLDING SIRS AND WAITING FOR THEM.              >>         14725000
<<       2)  ARRAY IMPDRS:  A LIST OF THE PINS THAT ARE      >>         14730000
<<           HOLDING THE SIRS THE PINS IN ARRAY HLDRS'IMPD   >>         14735000
<<           ARE WAITING FOR.                                >>         14740000
<<***********************************************************>>         14745000
                                                                        14750000
PROCEDURE CHK'FOR'DEADLOCKS(HLDRS'IMPD,IMPDRS);                         14755000
   INTEGER ARRAY HLDRS'IMPD,IMPDRS;                                     14760000
                                                                        14765000
   BEGIN                                                                14770000
      LOGICAL FOUND;                                                    14775000
      DOUBLE LOCPCB,LOCSIR,LOCDST;                                      14780000
      INTEGER CURRENT'Q'ITEM,Q'LENGTH,NEXT,INDX,CURRENT'Q,Q'SET;        14785000
      INTEGER HOLDER'IMPEDED,NXT'IMPD,LSIR;                             14790000
                                                                        14795000
                                                                        14800000
      LOCDST:=DOUBLE(CORE(2D));<< DEFINE DST BASE>>                     14805000
      LOCPCB:=GETDSTADDR(3);                                            14810000
      LOCSIR := GETDSTADDR (%53);                              <<84301>>14815000
      LSIR:=4*(CORE(LOCDST+DOUBLE(4*%53)).(3:13)); <<LENGTH SIR DST>>   14820000
                                                                        14825000
      NEXT:=0;                                                          14830000
      INDX:=0;                                                          14835000
      Q'SET:=LSIR/4;                                                    14840000
      WHILE (INDX:=INDX+4) <= LSIR-4 DO BEGIN                           14845000
         HOLDER'IMPEDED:= CORE(LOCSIR + DOUBLE(INDX));                  14850000
         IF HOLDER'IMPEDED <> 0 THEN BEGIN                              14855000
            FOUND:=FALSE;                                               14860000
            CURRENT'Q:= 1;                                              14865000
            WHILE CURRENT'Q <= Q'SET AND NOT FOUND DO BEGIN             14870000
               CURRENT'Q'ITEM:= 1;                                      14875000
               Q'LENGTH:= CORE(DOUBLE(CURRENT'Q*4+1) + LOCSIR);         14880000
               NXT'IMPD:= CORE(DOUBLE(CURRENT'Q*4+2) + LOCSIR);         14885000
               WHILE CURRENT'Q'ITEM <= Q'LENGTH AND NOT FOUND DO BEGIN  14890000
                  IF NXT'IMPD = HOLDER'IMPEDED THEN BEGIN               14895000
                     FOUND:= TRUE;                                      14900000
                     IMPDRS(NEXT):=CORE(DOUBLE(CURRENT'Q*4)+LOCSIR);    14905000
                     HLDRS'IMPD(NEXT):=HOLDER'IMPEDED;                  14910000
                     NEXT:=NEXT + 1; END                                14915000
                  ELSE IF Q'LENGTH > 1 THEN                             14920000
                     NXT'IMPD:=CORE(DOUBLE(NXT'IMPD*21+17)+LOCPCB);     14925000
                  CURRENT'Q'ITEM:= CURRENT'Q'ITEM + 1; END;             14930000
               CURRENT'Q:=CURRENT'Q + 1; END; END; END;                 14935000
                                                                        14940000
      FIND'DEADLOCK(HLDRS'IMPD,IMPDRS); END;                            14945000
                                                                        14950000
                                                                        14955000
$PAGE   "                     PROCEDURE FMTSIR   "                      14960000
                                                                        14965000
<<***********************************************************>>         14970000
<<  FMTSIR                                                   >>         14975000
<<----------------------------------------------------------->>         14980000
<<  THIS PROCEDURE WILL FORMAT LOCKED SIRS AND THE IMPEDED   >>         14985000
<<  LIST IF ANY. IF NO SIRS ARE LOCKED THEN "NO LOCKED SIRS" >>         14990000
<<  WILL BE FORMATED;                                        >>         14995000
<<***********************************************************>>         15000000
                                                                        15005000
PROCEDURE FMTSIR(PRNTFILE);                                             15010000
                                                                        15015000
   VALUE PRNTFILE;                                                      15020000
   INTEGER PRNTFILE;                                                    15025000
                                                                        15030000
   BEGIN                                                                15035000
                                                                        15040000
   INTEGER COUNT,CNT2,INDX,LSIR,PCB'ENTRIES,PCBCOUNT;      <<<01078>>   15045000
   INTEGER ARRAY IMPDRS(0:1023);                                        15050000
   INTEGER ARRAY HLDRS'IMPD(0:1023);                                    15055000
   OWN BYTE ARRAY PCBNAME(0:9):="PCB TABLE";                            15060000
   DOUBLE LOCSIR,LOCDST,LOCPCB;                                         15065000
   LOGICAL WORK1,WORK2,WORK3,WORK4,WORK5;                  <<<01.02>>   15070000
   LOGICAL ARRAY SIRPIN(0:1023);                                        15075000
   EQUATE PCBSIZE=%25;                                         << WBT >>15080000
                                                                        15085000
   LOCPCB:=GETDSTADDR(3);                                               15090000
   LOCDST:=DOUBLE(CORE(2D));<< DEFINE DST BASE>>             <<00221>>  15095000
   LOCSIR := GETDSTADDR (%53);                                 <<84301>>15100000
   IMPDRS := 0;                                                <<84301>>15105000
   MOVE IMPDRS(1) := IMPDRS, (1023);                           <<84301>>15110000
   MOVE HLDRS'IMPD := IMPDRS, (1024);                          <<84301>>15115000
   LSIR:=4*(CORE(LOCDST+DOUBLE(4*%53)).(3:13)); <<LENGTH SIR DST>>      15120000
                                                                        15125000
   << INITIALIZE TABLE OF IMPEDED/VALID/ACTIVE PINS>>          <<00221>>15130000
   << THIS TABLE PREVENTS LOOPING WHEN PRINTING SIRS>>        <<00221>> 15135000
   << THE TABLE IS ACCESSED INDEXED BY PIN:         >>        <<00221>> 15140000
   <<    VALUE        MEANING                       >>        <<00221>> 15145000
   <<      0      PIN IS NOT IMPEDED                >>        <<00221>> 15150000
   <<      1      PIN IS WAITING FOR CURRENT SIR    >>        << WBT >> 15155000
   <<      2      PIN CANNOT BE WAITING FOR SIR     >>        << WBT >> 15160000
   <<      3      PIN IS <1 OR >NENTRIES            >>        << WBT >> 15165000
   <<      4      PIN IS WAITING FOR ANOTHER SIR    >>        << WBT >> 15170000
   PCB'ENTRIES:=INTEGER(CORE(LOCPCB));                                  15175000
   INDX:=-1;                                                            15180000
   WHILE (INDX:=INDX+1) <= 1023 DO BEGIN                                15185000
      SIRPIN(INDX):=0;                                                  15190000
      IF((INDX<1) OR (INDX>PCB'ENTRIES))THEN SIRPIN(INDX):=3;           15195000
      IF ISFREE(INDX) OR( PCB13.(0:1)= 1)OR (PCB04.(13:1)=0)            15200000
         THEN SIRPIN(INDX):=2;                                          15205000
   END;                                                                 15210000
                                                                        15215000
   INDX:=0; COUNT:=0;                                                   15220000
   WHILE (INDX:=INDX+4)< LSIR DO BEGIN                                  15225000
      WORK1:=CORE(LOCSIR+DOUBLE(INDX))/%25; <<GET SIR ENTRY>>           15230000
      WORK2:=CORE(LOCSIR+DOUBLE(INDX+1))/%25;                           15235000
      WORK3:=CORE(LOCSIR+DOUBLE(INDX+2))/%25;                           15240000
      WORK4:=CORE(LOCSIR+DOUBLE(INDX+3))/%25;                           15245000
      IF WORK1=0 THEN GO AEND; <<FREE SIR>>                             15250000
      COUNT:=COUNT+1;   <<COUNT LOCKED SIRS>>                           15255000
      MOVE BUF:=80(" ");                                                15260000
      FWRITE(PRNTFILE,LBUF,-79,0);                                      15265000
      MOVE BUF:="SIR #    LOCKED BY PIN # ";                            15270000
      @PBUF:=@BUF+2;                                                    15275000
      PUTNUMP(INDX/4);   <<SIR#>>                                       15280000
      @PBUF:=@BUF+21;                                                   15285000
      PUTNUMP(WORK1);    <<PIN#>>                                       15290000
      IF (INDX/4) > %47 THEN GO COUT;                         <<<01.02>>15295000
      CASE * (INDX/4) OF BEGIN  <<CASES>>                               15300000
        BEGIN  <<0>>                                                    15305000
        END;                                                            15310000
        BEGIN  <<1>>                                                    15315000
          MOVE BUF(40):="LOAD PROCESS SIR";                             15320000
        END;                                                            15325000
        BEGIN  <<2>>                                                    15330000
          MOVE BUF(40):="LOCK SEGMENT SIR";                             15335000
        END;                                                            15340000
        BEGIN  <<3>>                                                    15345000
          MOVE BUF(40):="IDD";                                          15350000
        END;                                                            15355000
        BEGIN  <<4>>                                                    15360000
          MOVE BUF(40):="ODD";                                          15365000
        END;                                                            15370000
        BEGIN  <<5>>                                                    15375000
          MOVE BUF(40):="PROCESS TREE STRUCTURE";                       15380000
        END;                                                            15385000
        BEGIN  <<6>>                                                    15390000
          MOVE BUF(40):="SCHEDULING QUEUE";                             15395000
        END;                                                            15400000
        BEGIN  <<7>>                                                    15405000
          MOVE BUF(40):="CST ENTRIES";                                  15410000
        END;                                                            15415000
        BEGIN  <<10>>                                                   15420000
          MOVE BUF(40):="SYSTEM DIRECTORY";                             15425000
        END;                                                            15430000
        BEGIN  <<11>>                                                   15435000
          MOVE BUF(40):="LPDT";                                         15440000
        END;                                                            15445000
        BEGIN  <<12>>                                                   15450000
          MOVE BUF(40):="LDT";                                          15455000
        END;                                                            15460000
        BEGIN  <<13>>                                                   15465000
          MOVE BUF(40):="STORAGE IN OVERLAY AREA";                      15470000
        END;                                                            15475000
        BEGIN  <<14>>                                                   15480000
          MOVE BUF(40):="DISC FREE SPACE TABLE";                        15485000
        END;                                                            15490000
        BEGIN  <<15>>                                                   15495000
          MOVE BUF(40):="JPCNT";                                        15500000
        END;                                                            15505000
        BEGIN  <<16>>                                                   15510000
        MOVE BUF(40):="JCUT";                                 <<00221>> 15515000
        END;                                                            15520000
        BEGIN  <<17>>                                                   15525000
        MOVE BUF(40):="JMAT";                                 <<00221>> 15530000
        END;                                                            15535000
        BEGIN  <<20>>                                                   15540000
          MOVE BUF(40):="FMAVT";                                        15545000
        END;                                                            15550000
        BEGIN  <<21>>                                                   15555000
          MOVE BUF(40):="LOADER SEGMENT TABLE";                         15560000
        END;                                                            15565000
        BEGIN  <<22>>                                                   15570000
          MOVE BUF(40):="VDD";                                          15575000
        END;                                                            15580000
        BEGIN <<23>>                                                    15585000
          MOVE BUF(40):="SPOOL";                                        15590000
        END;                                                            15595000
        BEGIN  <<24>>                                                   15600000
          MOVE BUF(40):="MESSAGE CATALOGUE";                            15605000
        END;                                                            15610000
        BEGIN  <<25>>                                                   15615000
          MOVE BUF(40):="RIT";                                          15620000
        END;                                                            15625000
        BEGIN  <<26>>                                                   15630000
          MOVE BUF(40):="VOLUME TABLE";                                 15635000
        END;                                                            15640000
        BEGIN  <<27>>                                                   15645000
         MOVE BUF(40):="WELCOME MESSAGE SIR";                 <<01078>> 15650000
        END;                                                            15655000
        BEGIN  <<30>>                                                   15660000
         MOVE BUF(40) := "ASSOCIATION TABLE SIR";             <<01664>> 15665000
        END;                                                            15670000
        BEGIN  <<31>>                                                   15675000
          MOVE BUF(40):="CS ALLOCATE SIR";                              15680000
        END;                                                            15685000
        BEGIN  <<32>>                                                   15690000
          MOVE BUF(40):="LOGGING BUFFER";                               15695000
        END;                                                            15700000
        BEGIN  <<33>>                                                   15705000
         MOVE BUF(40):="PRIVATE VOL. MVTAB";                 <<<01.02>> 15710000
        END;                                                            15715000
        BEGIN  <<34>>                                                   15720000
         MOVE BUF(40):="PRIVATE VOL. PROCESS SIR";           <<<01.02>> 15725000
        END;                                                            15730000
        BEGIN  <<35>>                                                   15735000
         MOVE BUF(40):="PRIVATE VOL. USER TABLE";            <<<01.02>> 15740000
        END;                                                            15745000
        BEGIN  <<36>>                                                   15750000
         MOVE BUF(40):="IMAGE";                               <<01078>> 15755000
        END;                                                            15760000
        BEGIN  <<37>>                                                   15765000
         MOVE BUF(40):="KSAM";                                <<01078>> 15770000
        END;                                                            15775000
        BEGIN  <<40>>                                                   15780000
         MOVE BUF(40):="USER LOGGING";                        <<01078>> 15785000
        END;                                                            15790000
        BEGIN  <<41>>                                                   15795000
        END;                                                            15800000
        BEGIN  <<42>>                                                   15805000
        END;                                                            15810000
        BEGIN  <<43>>                                                   15815000
          MOVE BUF(40):="SUB-QUEUE MAPPING TABLE";                      15820000
        END;                                                            15825000
        BEGIN  <<44>>                                                   15830000
         MOVE BUF(40):="CILOG";                               <<01078>> 15835000
        END;                                                            15840000
        BEGIN  <<45>>                                                   15845000
          MOVE BUF(40):="FILE INTEGRITY";                               15850000
        END;                                                            15855000
        BEGIN  <<46>>                                                   15860000
          MOVE BUF(40):="RIN";                                          15865000
        END;                                                            15870000
         BEGIN <<47>>                                         <<<01.02>>15875000
           MOVE BUF(40):="MAG. TAPE LABELS";                 <<<01.02>> 15880000
         END;                                                 <<<01.02>>15885000
COUT:                                                                   15890000
      END;   <<CASES>>                                                  15895000
      FWRITE(PRNTFILE,LBUF,-79,0);                                      15900000
      BUF := " ";   MOVE BUF(1) := BUF, (79);                  <<84301>>15905000
      MOVE BUF:="NO IMPEDED PROCESSES";                                 15910000
      IF WORK2=0 THEN FWRITE(PRNTFILE,LBUF,-79,0)                       15915000
      ELSE                                                              15920000
      BEGIN                                                             15925000
        MOVE BUF:="   ";                                                15930000
        FWRITE(PRNTFILE,LBUF,-79,0);                                    15935000
        MOVE BUF:=80(" ");                                              15940000
        LOCPCB:=GETDSTADDR(3);                                          15945000
      PCBCOUNT := -1;                                          <<01078>>15950000
      DO                                                      <<<01.02>>15955000
        BEGIN                                                           15960000
          PCBCOUNT := PCBCOUNT + 1;                            <<01078>>15965000
          IF PCBCOUNT > PCB'ENTRIES THEN                       <<01078>>15970000
           BEGIN                                               <<01078>>15975000
            MOVE BUF(15):=                                    <<01078>> 15980000
            "ERROR: NUMBER OF IMPEDED PINS EXCEEDS TABLE SIZE";<<01078>>15985000
            FWRITE(PRNTFILE,LBUF,-79,0);                                15990000
            GO TO AEND;                                        <<01078>>15995000
           END;                                                <<01078>>16000000
          BUF := " ";   MOVE BUF(1) := BUF, (79);              <<84301>>16005000
          MOVE BUF(3):="PIN";                                           16010000
          @PBUF:=@BUF+7;                                                16015000
          PUTNUMP(WORK3);                                               16020000
          << CHECK STATUS OF LINK >>                           <<00221>>16025000
           CASE SIRPIN(WORK3) OF                               <<00221>>16030000
            BEGIN                      <<LINK STATES>>         <<00221>>16035000
             BEGIN  <<0>>                                      <<00221>>16040000
              SIRPIN(WORK3):=1;                                <<00221>>16045000
             END;                                              <<00221>>16050000
             BEGIN  <<1>>              <<ALREADY IMPEDED>>     <<00221>>16055000
              MOVE BUF(15):=                                  <<00221>> 16060000
                "ERROR: LOOPING IMPEDED QUEUE POINTER";        <<00221>>16065000
              FWRITE(PRNTFILE,LBUF,-79,0);                              16070000
              GO AEND;                                         <<00221>>16075000
             END;                                              <<00221>>16080000
             BEGIN  <<2>>              <<INACTIVE PIN>>        <<00221>>16085000
              MOVE BUF(15):=                                  <<00221>> 16090000
                "ERROR: IMPEDED PIN IS INACTIVE, ",2;          << WBT >>16095000
                MOVE *:="NOT WAITING FOR SIR, OR ON DISP QUEUE";        16100000
              FWRITE(PRNTFILE,LBUF,-79,0);                              16105000
              GO AEND;                                         <<00221>>16110000
             END;                                              <<00221>>16115000
             BEGIN  <<3>>              <<INVALID PCB>>         <<00221>>16120000
              MOVE BUF(15):=                                  <<00221>> 16125000
                "ERROR: IMPEDED PIN IS INVALID";               <<00221>>16130000
              FWRITE(PRNTFILE,LBUF,-79,0);                              16135000
              GO AEND;                                         <<00221>>16140000
             END;                                              <<00221>>16145000
             BEGIN  <<4>>              <<ALREADY IMPEDED>>     <<00221>>16150000
              MOVE BUF(15):=                                  <<00221>> 16155000
                "WARNING: PIN IS IMPEDED BY ANOTHER SIR";      <<00221>>16160000
              SIRPIN(WORK3):=1;        <<CALL IT IMPEDED>>     <<00221>>16165000
             END;                                              <<00221>>16170000
            END;                     <<**STATE CHECKING>>      <<00221>>16175000
          FWRITE(PRNTFILE,LBUF,-79,0);                                  16180000
          WORK3:=CORE(LOCPCB+DOUBLE(21*WORK3+17));                      16185000
      END UNTIL WORK3 = 0;                                     <<01078>>16190000
      END;                                                              16195000
AEND:                                                                   16200000
     <<CORRECT SIRPIN TABLE FOR PINS IMPEDED>>                 <<00221>>16205000
      WORK1:=-1;                     <<SCAN WHOLE TABLE>>      <<00221>>16210000
      WHILE (WORK1:=WORK1+1) < 1023 DO                                  16215000
       IF SIRPIN(WORK1)=1  THEN SIRPIN(WORK1):=4;              <<00221>>16220000
   END;                                                                 16225000
      CHK'FOR'DEADLOCKS(HLDRS'IMPD,IMPDRS);                             16230000
      IF COUNT =0 THEN                                                  16235000
      BEGIN                                                             16240000
        BUF := " ";   MOVE BUF(1) := BUF, (79);                <<84301>>16245000
        MOVE BUF :="NO LOCKED SIRS";                                    16250000
        FWRITE(PRNTFILE,LBUF,-79,0);                                    16255000
      END;                                                              16260000
BAILOUT:                                                                16265000
   END;                                                                 16270000
                                                                        16275000
$PAGE "                     PROCEDURE ISFREE "                          16280000
<<***********************************************************>>         16285000
<< ISFREE                                                    >>         16290000
<<----------------------------------------------------------->>         16295000
<< THIS PROCEDURE IS A FUNCTION THAT RECEIVES AS AN ARGUMENT >>         16300000
<< A PCB ENTRY NUMBER AND RETURNS TRUE IF THE PCB ENTRY IS   >>         16305000
<< FREE, OTHERWISE IT RETURNS FALSE.                         >>         16310000
<<***********************************************************>>         16315000
                                                                        16320000
LOGICAL PROCEDURE ISFREE(PCB'ENTRY);                                    16325000
   VALUE PCB'ENTRY;                                                     16330000
   INTEGER PCB'ENTRY;                                                   16335000
                                                                        16340000
   BEGIN                                                                16345000
     INTEGER PCB15;                                                     16350000
     ISFREE:=FALSE;                                                     16355000
     PCB15:=CORE(GETDSTADDR(3)+DOUBLE(PCB'ENTRY*21+15));                16360000
     IF PCB15=%177777 THEN ISFREE:=TRUE;                                16365000
   END;                                                                 16370000
                                                                        16375000
$PAGE "                     PROCEDURE COMPUTE"                          16380000
<<***********************************************************>>         16385000
<< COMPUTE                                                   >>         16390000
<<----------------------------------------------------------->>         16395000
<< PARSE AND EXECUTE THE COMPUTE COMMAND                    >>          16400000
<<***********************************************************>>         16405000
PROCEDURE COMPUTE(PARMSTRING);                                          16410000
  BYTE ARRAY PARMSTRING;                                                16415000
BEGIN                                                                   16420000
                                                                        16425000
  << THIS ROCEDURE ASSUMES THE EXISTENCE OF THE >>                      16430000
  << GLOBAL VARIABLE "OUTFILE" AS WELL AS THE   >>                      16435000
  << FOLLOWING PROCEDURES:                      >>                      16440000
  <<        PRINTERROR         EXPREVAL         >>                      16445000
  <<        PARSEMODE          PUTCHAR          >>                      16450000
                                                                        16455000
                                                                        16460000
EQUATE  MAXPARMS = 5;                                                   16465000
                                                                        16470000
DEFINE  LENGTH = INFOWORD.(0:8)#;                                       16475000
                                                                        16480000
                                                                        16485000
LOGICAL  EXPRVALUE,  <<VALUE OF INPUT EXPRESSION>>                      16490000
          INFOWORD;  <<WORD RETURNED BY MYCOMMAND>>                     16495000
INTEGER   DISPMODE,  <<DISPLAY MODE REQUESTED>>                         16500000
                 N,  <<# CHARS TO PRINT>>                               16505000
          NUMPARMS;  <<NUMBER OF PARAMETERS>>                           16510000
                                                                        16515000
LOGICAL ARRAY LBUF(0:39);  <<OUTPUT BUFFER>>                            16520000
BYTE ARRAY BUF(*)=LBUF;                                                 16525000
                                                                        16530000
DOUBLE ARRAY  PARMS(0:MAXPARMS);                                        16535000
                                                                        16540000
BYTE ARRAY  DELIMITERS(0:1),                                            16545000
               TEMPBUF(0:9);                                            16550000
                                                                        16555000
BYTE POINTER  STRING;                                                   16560000
                                                                        16565000
<<PARSE STRING TO GET EXPRESSION AND DISPLAY MODE>>                     16570000
DELIMITERS(0):=",";                                                     16575000
DELIMITERS(1):=CR;                                                      16580000
MYCOMMAND(PARMSTRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               16585000
IF <> THEN BEGIN                                                        16590000
  PRINTERROR(0);                                                        16595000
  RETURN; END;                                                          16600000
                                                                        16605000
IF NOT (0 <= NUMPARMS <= 2) THEN BEGIN                                  16610000
  PRINTERROR(7);                                                        16615000
  RETURN; END;                                                          16620000
                                                                        16625000
<<HAVE CORRECT NUMBER OF PARAMETERS>>                                   16630000
EXPRVALUE:=0;    <<DEFAULT VALUE>>                                     16635000
DISPMODE:=0;     <<OCTAL>>                                              16640000
IF NUMPARMS >= 1 THEN BEGIN                                             16645000
  TOS:=PARMS(0);                                                        16650000
  INFOWORD:=TOS;                                                        16655000
  @STRING:=TOS;                                                         16660000
                                                                        16665000
  IF LENGTH > 0 THEN BEGIN                                              16670000
    STRING(LENGTH):=CR;                                                 16675000
    EXPRVALUE:=EXPREVAL(STRING);                                        16680000
    IF <> THEN BEGIN                                                    16685000
      PRINTERROR(19);                                                   16690000
      RETURN; END; END;                                                 16695000
                                                                        16700000
  IF NUMPARMS >= 2 THEN BEGIN                                           16705000
    DISPMODE:=PARSEMODE(PARMS(1));                                      16710000
    IF <> THEN BEGIN                                                    16715000
      PRINTERROR(1);                                                    16720000
      RETURN; END; END; END;                                            16725000
                                                                        16730000
<<HAVE VALID EXPRESSION AND MODE>>                                      16735000
BUF:=" ";                                                               16740000
MOVE BUF(1):=BUF,(79);  <<BLANK OUT THE BUFFER>>                        16745000
                                                                        16750000
CASE DISPMODE OF BEGIN                                                  16755000
                                                                        16760000
   <<OCTAL>>  BEGIN                                                     16765000
              N:=ASCII(EXPRVALUE,8,TEMPBUF);                            16770000
              MOVE BUF:=TEMPBUF(6-N),(N); END;                          16775000
 <<INTEGER>>  N:=ASCII(EXPRVALUE,10,BUF);                               16780000
   <<ASCII>>  BEGIN                                                     16785000
              PUTCHAR(EXPRVALUE.(0:8),BUF);                             16790000
              PUTCHAR(EXPRVALUE.(8:8),BUF(1));                          16795000
              N:=2; END;                                                16800000
                                                                        16805000
END;  <<CASE>>                                                          16810000
                                                                        16815000
FWRITE(OUTFILE,LBUF,-N,0);                                              16820000
                                                                        16825000
END;  <<COMPUTE>>                                                       16830000
$PAGE "                     PROCEDURE CI"                               16835000
<<***********************************************************>>         16840000
<< CI                                                        >>         16845000
<<----------------------------------------------------------->>         16850000
<< COMMAND INTERPRETER FOR THE PROGRAM                       >>         16855000
<<***********************************************************>>         16860000
PROCEDURE CI;                                                           16865000
BEGIN                                                                   16870000
                                                                        16875000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE FOLLOWING >>           16880000
  << GLOBAL VARIABLES:                                     >>           16885000
  <<                                                       >>           16890000
  <<     INFILE - INPUT FILE NUMBER FOR $STDINX            >>           16895000
  <<      CTRLY - FLAG INDICATING IF CONTROL-Y INTEGER     >>           16900000
                                                                        16905000
  << WE REMAIN IN THIS PROCEDURE UNTIL THE USER ENTERS     >>           16910000
  << AN EXIT COMMAND                                       >>           16915000
                                                                        16920000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     16925000
  << GLOBAL VARIABLE "COREF" AS WELL AS THE      >>                     16930000
  << FOLLOWING PROCEDURES:                       >>                     16935000
  <<        PRINTERROR        PARSEDISPLAY       >>                     16940000
  <<        DISPLAY           FORMATINFO         >>                     16945000
  <<        TEXTFILE          COMPUTE            >>                     16950000
  <<        HELP                                 >>                     16955000
                                                                        16960000
EQUATE  <<INDICES FOR VALID COMMANDS>>                                  16965000
     INVALID'CMD =  0,                                                  16970000
        NULL'CMD =  1,                                                  16975000
        EXIT'CMD =  2,                                                  16980000
        DISP'CMD =  3,                                                  16985000
         FMT'CMD =  4,                                                  16990000
        TEXT'CMD =  5,                                                  16995000
     COMPUTE'CMD =  6,                                                  17000000
       DEBUG'CMD =  7,                                                  17005000
         SET'CMD =  8,                                                  17010000
        HELP'CMD =  9;                                                  17015000
                                                                        17020000
LOGICAL      DONE;  <<TRUE: EXIT COMMAND ENTERED>>                      17025000
INTEGER  DISPMODE,  <<DISPLAY MODE FOR D & P COMMANDS>>                 17030000
          COMMAND,  <<INDEX OF COMMAND SPECIFIED>>                      17035000
                I,  <<LOOP VARIABLE>>                                   17040000
            ERROR,                                                      17045000
          NUMCHAR;  <<NUMBER OF CHARACTERS INPUT>>                      17050000
DOUBLE  DISPCOUNT,  <<# WORDS TO DISPLAY IN D & P COMMANDS>>            17055000
        STARTADDR;  <<OFFSET FOR D & P COMMANDS>>                       17060000
                                                                        17065000
BYTE POINTER  CMDSTART,  <<START OF COMMAND>>                           17070000
             PARMSTART;  <<START OF COMMAND PARAMETERS>>                17075000
                                                                        17080000
LOGICAL ARRAY LBUF(0:39);   <<INPUT/OUTPUT BUFFER>>                     17085000
BYTE ARRAY BUF(*)=LBUF;                                                 17090000
                                                                        17095000
DONE:=FALSE;                                                            17100000
                                                                        17105000
WHILE NOT DONE DO BEGIN  <<LOOP UNTIL EXIT COMMAND>>                    17110000
  CTRLY:=FALSE;                                                         17115000
                                                                        17120000
  <<PROMPT USER>>                                                       17125000
  BUF:="-";                                                             17130000
  PRINT(LBUF,-1,%320);                                                  17135000
                                                                        17140000
  <<READ COMMAND>>                                                      17145000
  NUMCHAR:=FREAD(INFILE,LBUF,-79);                                      17150000
  IF <> THEN                                                            17155000
    <<END-OF-FILE OR I/O ERROR>>                                        17160000
    RETURN;                                                             17165000
                                                                        17170000
<< Squeeze out leading blanks.                              >> <<84326>>17175000
  I := 0;                                                      <<84326>>17180000
  WHILE BUF(I) = " " AND I < NUMCHAR DO I := I + 1;            <<84326>>17185000
  NUMCHAR := NUMCHAR - I;                                      <<84326>>17190000
  MOVE BUF := BUF(I), (NUMCHAR);   << Don't change @BUF.    >> <<84326>>17195000
  BUF(NUMCHAR) := CR;   << Make sure input is terminated.   >> <<84326>>17200000
                                                                        17205000
  <<DETERMINE COMMAND FROM FIRST LETTER OF INPUT>>                      17210000
  IF NUMCHAR = 0 THEN                                                   17215000
    COMMAND:=NULL'CMD                                                   17220000
  ELSE BEGIN                                                            17225000
    @CMDSTART:=@BUF;                                                    17230000
                                                                        17235000
    <<UPSHIFT 1ST PART OF STRING - USE OF "MYCOMMAND">>                 17240000
    <<WILL UPSHIFT THE REMAINDER OF THE STRING       >>                 17245000
    MOVE BUF := BUF WHILE AS, 1;                               <<84326>>17250000
    I := TOS - @BUF;   << Save length to set start of parms >> <<84326>>17255000
                                                                        17260000
    <<DETERMINE COMMAND TYPE>>                                          17265000
    COMMAND:= IF CMDSTART = "E" THEN EXIT'CMD                           17270000
              ELSE                                                      17275000
              IF CMDSTART = "D" THEN DISP'CMD                           17280000
              ELSE                                                      17285000
              IF CMDSTART = "F" THEN FMT'CMD                            17290000
              ELSE                                                      17295000
              IF CMDSTART = "=" THEN COMPUTE'CMD                        17300000
              ELSE                                                      17305000
              IF CMDSTART = "T" THEN TEXT'CMD                           17310000
              ELSE                                                      17315000
              IF CMDSTART = "!" THEN DEBUG'CMD                          17320000
              ELSE                                                      17325000
              IF CMDSTART = "S" THEN SET'CMD                            17330000
              ELSE                                                      17335000
              IF CMDSTART = "H" THEN HELP'CMD                           17340000
                                ELSE INVALID'CMD; END;                  17345000
                                                                        17350000
  if new'text and (command=disp'cmd or                                  17355000
                   command=fmt'cmd  or                                  17360000
                   command=set'cmd   )                                  17365000
     then begin                                                         17370000
     printerror(32);    <<must text in file first>>                     17375000
     command:=null'cmd; <<bypass following case  >>                     17380000
     end;                                                               17385000
                                                                        17390000
  IF CMDSTART = ALPHA AND CMDSTART <> "D" THEN                 <<84326>>17395000
     @PARMSTART := @CMDSTART(I)   << Start of 1st parm.     >> <<84326>>17400000
  ELSE                                                         <<84326>>17405000
     @PARMSTART:=@CMDSTART(1);    << Same for "=" command.  >> <<84326>>17410000
                                                                        17415000
  <<EXECUTE THE COMMAND>>                                               17420000
  CASE COMMAND OF BEGIN                                                 17425000
                                                                        17430000
    <<INVALID COMMAND>>                                                 17435000
    PRINTERROR(8);                                                      17440000
                                                                        17445000
    <<NULL COMMAND>>                                                    17450000
    ;                                                                   17455000
                                                                        17460000
    <<EXIT COMMAND>>                                                    17465000
    DONE:=TRUE;                                                         17470000
                                                                        17475000
    <<DISPLAY COMMAND>> BEGIN                                           17480000
    PARSEDISPLAY(PARMSTART,STARTADDR,DISPCOUNT,DISPMODE);               17485000
    IF = THEN                                                           17490000
      DISPLAY(STARTADDR,DISPCOUNT,DISPMODE); END;                       17495000
                                                                        17500000
    <<FORMAT COMMAND>>                                                  17505000
    FORMATINFO(PARMSTART);                                              17510000
                                                                        17515000
    <<TEXT COMMAND>>                                                    17520000
    TEXTFILE(PARMSTART);                                                17525000
                                                                        17530000
    <<COMPUTE COMMAND>>                                                 17535000
    COMPUTE(PARMSTART);                                                 17540000
                                                                        17545000
    <<DEBUG COMMAND>>                                                   17550000
    DEBUG;                                                              17555000
                                                                        17560000
    << SET COMMAND >>                                                   17565000
    SET'REG(PARMSTART);                                                 17570000
                                                                        17575000
    <<HELP COMMAND (9)>>                                                17580000
    HELP(CMDSTART,BUF,PARMSTART);                                       17585000
                                                                        17590000
  END; <<CASE>> END;                                                    17595000
                                                                        17600000
IF NOT NEW'TEXT THEN                                                    17605000
  BEGIN                                                                 17610000
  FCLOSE(COREF,1,0); << SAVE LAST FILE THAT WAS REFERENCED >>           17615000
    IF <> THEN                                                          17620000
      BEGIN                                                             17625000
      FCHECK(COREF,ERROR);                                              17630000
      GENMSGU(8,ERROR);                                                 17635000
      PRINTERROR(30);                                                   17640000
      END;                                                              17645000
  END;                                                                  17650000
                                                                        17655000
END;  <<CI>>                                                            17660000
$PAGE "                     PROCEDURE WELCOME"                          17665000
<<***********************************************************>>         17670000
<< WELCOME                                                   >>         17675000
<<----------------------------------------------------------->>         17680000
<< DISPLAY WELCOME MESSAGE ON $STDLIST                       >>         17685000
<<***********************************************************>>         17690000
PROCEDURE WELCOME;                                                      17695000
BEGIN                                                                   17700000
                                                               <<84311>>17705000
INTEGER LENGTH;                                                <<84311>>17710000
                                                                        17715000
LOGICAL ARRAY LBUF(0:39);                                               17720000
BYTE ARRAY BUF(*)=LBUF;                                                 17725000
                                                                        17730000
MOVE BUF := ("Interactive Dump Analysis Tool - ",              <<84311>>17735000
             "27 June 84."), 2;   << Change as required.    >> <<84627>>17740000
LENGTH := TOS - @BUF;                                          <<84311>>17745000
PRINT (LBUF, -LENGTH, 0);                                      <<84311>>17750000
MOVE BUF := "(C) HEWLETT-PACKARD COMPANY 1984", 2;             <<84311>>17755000
LENGTH := TOS - @BUF;                                          <<84311>>17760000
PRINT (LBUF, -LENGTH, %60);                                    <<84311>>17765000
                                                                        17770000
                                                                        17775000
MOVE BUF := "Type 'H' for aid.", 2;                            <<84311>>17780000
LENGTH := TOS - @BUF;                                          <<84311>>17785000
PRINT (LBUF, -LENGTH, %60);                                    <<84311>>17790000
END;  <<WELCOME>>                                                       17795000
                                                                        17800000
$PAGE "         PROCEDURE  HELP"                                        17805000
<<**********************************************>>                      17810000
<<   HELP                                       >>                      17815000
<<---------------------------------------------->>                      17820000
<<   Open help catalog, increase zsize, and     >>                      17825000
<<   call external procedure HELPROC for        >>                      17830000
<<   "HELP" command                             >>                      17835000
<<**********************************************>>                      17840000
                                                                        17845000
procedure help(command,buf,parms);                                      17850000
                                                                        17855000
byte array buf;                                                         17860000
byte pointer command,  <<entire command                   >>            17865000
     parms;          <<points to parameters             >>              17870000
                                                                        17875000
begin                                                                   17880000
                                                                        17885000
integer catnum,      <<file number of help catalog      >>              17890000
        i,           <<parse counter                    >>              17895000
        err,         <<HELPROC returns error code       >>              17900000
        actsize,     <<zsize before expansion           >>              17905000
        expandsz,    <<HELPROC requires 3564 extra words>>              17910000
        error1,      <<PROCINFO: success?               >>              17915000
        error2;      <<PROCINFO: additional return info >>              17920000
byte array idathelp(0:28), <<file.group.acct of program >>              17925000
           idatprog(0:40); <<PROCINFO: group, acct of IDAT>>            17930000
intrinsic fopen,fclose,zsize,procinfo;                                  17935000
                                                                        17940000
<< Try to find IDATHELP in the same group.account  IDAT  is >> <<84326>>17945000
<< run  in.  If  that fails, try logon group.acct (allowing >> <<84326>>17950000
<< file equations).  If that fails, try  IDATHELP.IDAT.KSE. >> <<84326>>17955000
<< If THAT fails, give up.                                  >> <<84326>>17960000
<< The user interface group has a manual describing HELPROC.          >>17965000
<< In order to accomodate the 3564 extra stack words required,        >>17970000
<< IDAT must be PREPed or RUN with MAXDATA=8192.                      >>17975000
                                                                        17980000
err:=0;                                                                 17985000
catnum:=0;                                                              17990000
                                                                        17995000
<< search for and open prepared help catalog >>                         18000000
                                                                        18005000
PROCINFO(error1,error2,0,10,idatprog);  <<idatprog:=file.group.acct   >>18010000
if error1 <> 0 then begin                                               18015000
   printerror(33);                                                      18020000
   return;                                                              18025000
   end;                                                                 18030000
while idatprog <> "." do @idatprog:=@idatprog+1; <<scan to .group.acct>>18035000
move idathelp:="IDATHELP";                                              18040000
move idathelp(8):=idatprog,(18);                                        18045000
catnum:=fopen(idathelp,1,%300);                                         18050000
IF <> THEN                                                     <<84326>>18055000
   BEGIN   << Can't open IDATHELP.rungrp.runacct.           >> <<84326>>18060000
   FCHECK (CATNUM, ERR);                                       <<84326>>18065000
   IF 52 <= ERR <= 53 THEN                                     <<84326>>18070000
      BEGIN   << Doesn't exist, try IDATHELP.log.on.        >> <<84326>>18075000
      IDATHELP(8) := " ";   << Delimit file name.           >> <<84326>>18080000
      CATNUM := FOPEN (IDATHELP, 1, %300);                     <<84326>>18085000
      IF <> THEN                                               <<84326>>18090000
         BEGIN   << Still can't open it.                    >> <<84326>>18095000
         FCHECK (CATNUM, ERR);                                 <<84326>>18100000
         IF 52 <= ERR <= 53 THEN                               <<84326>>18105000
            BEGIN   << Doesn't exist, .IDAT.KSE last chance >> <<84326>>18110000
            MOVE IDATHELP(8) := ".IDAT.KSE ";                  <<84326>>18115000
            CATNUM := FOPEN (IDATHELP, 1, %300);               <<84326>>18120000
            IF <> THEN FCHECK (CATNUM, ERR);                   <<84326>>18125000
            END;    << Doesn't exist, .IDAT.KSE last chance >> <<84326>>18130000
         END;    << Still can't open it.                    >> <<84326>>18135000
      END;    << Doesn't exist, try IDATHELP.log.on.        >> <<84326>>18140000
   END;    << Can't open IDATHELP.rungrp.runacct.           >> <<84326>>18145000
                                                               <<84326>>18150000
<< At this point, either the help file is open (CATNUM <> 0)>> <<84326>>18155000
<< or ERR contains the reason why not.                      >> <<84326>>18160000
                                                               <<84326>>18165000
IF CATNUM = 0 THEN                                             <<84326>>18170000
   BEGIN                                                       <<84326>>18175000
   GENMSGU (8, ERR);                                           <<84326>>18180000
   PRINTERROR (39);                                            <<84326>>18185000
   RETURN;                                                     <<84326>>18190000
   END;                                                        <<84326>>18195000
                                                               <<84326>>18200000
                                                                        18205000
actsize:=zsize(0);                        <<query current zsize       >>18210000
expandsz:=zsize(actsize+3564);            <<helproc requires large z  >>18215000
if <> then                                                     <<84326>>18220000
   begin   << Unable to expand ZSIZE.                       >> <<84326>>18225000
   printerror (34);   << Tell user to PREP with ...         >> <<84326>>18230000
   printerror (40);   << ... MAXDATA >= 8192.               >> <<84326>>18235000
   end     << Unable to expand ZSIZE.                       >> <<84326>>18240000
else                                                           <<84326>>18245000
   begin                                                       <<84326>>18250000
   while parms = " " do @parms := @parms + 1;                  <<84326>>18255000
   helproc (catnum, outfile, parms, buf, err, true);           <<84326>>18260000
   actsize := zsize (actsize);   << Restore old ZSIZE.      >> <<84326>>18265000
   end;                                                        <<84326>>18270000
fclose(catnum,0,0);                       <<close help catalog        >>18275000
                                                                        18280000
end;  <<HELP>>                                                          18285000
                                                                        18290000
                                                                        18295000
                                                                        18300000
$PAGE "         PROCEDURE  TEXTFILE"                                    18305000
<<**********************************************>>                      18310000
<<   TEXTFILE                                   >>                      18315000
<<---------------------------------------------->>                      18320000
<<   "TEXT" COMMAND, TEXTING A DISC FILE OR     >>                      18325000
<<    COPYING A DUMPTAPE TO DISC                >>                      18330000
<<**********************************************>>                      18335000
PROCEDURE TEXTFILE(PARMSTRING);                                         18340000
                                                                        18345000
   BYTE ARRAY PARMSTRING;                                               18350000
                                                                        18355000
BEGIN                                                                   18360000
                                                                        18365000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE >>                     18370000
  << FOLLOWING:                                  >>                     18375000
  <<   PROCEDURE PRINTERROR                      >>                     18380000
  <<   GLOBAL VARIABLES    COREF                 >>                     18385000
  <<                       COREBUF               >>                     18390000
  <<                       SCRBUF                >>                     18395000
  <<                       ASB                   >>                     18400000
  <<   MPE PROCEDURES   GENMSGU                  >>                     18405000
  <<                    PRINT'FILE'INFO          >>                     18410000
  <<   MANY GLOBAL VARIABLES CONCERNING THE      >>                     18415000
  <<       REGISTERS AS USED IN SUBROUTINES      >>                     18420000
  <<       GET35CONTEXT,GET25CONTEXT, AND        >>                     18425000
  <<       GET'SERIESII'CONTEXT                  >>                     18430000
                                                                        18435000
                                                                        18440000
EQUATE MAXPARMS=2;                                                      18445000
EQUATE DISC'ACCESS'TYPE = 0;                                   <<84311>>18450000
                                                                        18455000
LOGICAL INFOWORD, USETAPE;                                     <<84311>>18460000
                                                                        18465000
INTEGER NUMPARMS,N,ERROR,RECSIZE,DEVTYPE,BLKSIZE;                       18470000
INTEGER DMPTAPE := 0, LENGTH, TAPE'TYPE:=24;                   <<84311>>18475000
INTEGER TLOG,BUFSAV,ADDRD,I;                 <<03083>>                  18480000
                                                                        18485000
LOGICAL ARRAY LBUF(0:39);                                               18490000
BYTE ARRAY BUF(*)=LBUF;                                                 18495000
                                                                        18500000
DOUBLE ARRAY PARMS(0:MAXPARMS);                                         18505000
                                                                        18510000
BYTE ARRAY TP(0:8);                                                     18515000
BYTE ARRAY DUMPTAPE(0:9);                                      <<84311>>18520000
BYTE ARRAY DELIMITERS(0:1), DISCFILENAME(0:35);                <<84311>>18525000
                                                                        18530000
BYTE POINTER STRING;                                                    18535000
                                                                        18540000
                                                               <<01875>>18545000
                                                               <<00.01>>18550000
      SUBROUTINE GET35CONTEXT; << SERIES II >>                 <<00.01>>18555000
      <<-------------------->>                                          18560000
                                                                        18565000
         BEGIN                                                 <<00.01>>18570000
         XREG:=M35XREG;                                        <<00.01>>18575000
         DLREG:=M35DLREG;                                      <<00.01>>18580000
         DBBANKREG:=M35DBANKREG;                               <<00.01>>18585000
         DBREG:=M35DBREG;                                      <<00.01>>18590000
         QREG:=M35QREG;                                        <<00.01>>18595000
         SREG:=M35SMREG;                                       <<00.01>>18600000
         ZBANKREG:=M35SBANKREG;                                <<00.01>>18605000
         ZREG:=M35ZREG;                                        <<00.01>>18610000
         STAREG:=M35STATUSREG;                                 <<00.01>>18615000
         PBBANKREG:=M35PBANKREG;                               <<00.01>>18620000
         PBREG:=M35PBREG;                                      <<00.01>>18625000
         PREG:=M35PREG;                                        <<00.01>>18630000
         PLREG:=M35PLREG;                                      <<00.01>>18635000
         CIRREG:=M35CIREG;                                     <<00.01>>18640000
         CPX1:=M35CPX1;                                        <<00.01>>18645000
         CPX2:=M35CPX2;                                        <<00.01>>18650000
         SP1:=M35SP1REG;                                       <<00.01>>18655000
         SP2:=M35SP2REG;                                       <<00.01>>18660000
         IF CNSTARFISH <> 0 THEN                               <<02519>>18665000
            BEGIN                                              <<02519>>18670000
            I := CNSTARFISH*4; << COMPUTE LOCATION OF DRT >>   <<02519>>18675000
            COREBUF(I) := CNDRT0;                              <<02519>>18680000
            COREBUF(I+1) := CNDRT1;                            <<02519>>18685000
            COREBUF(I+2) := CNDRT2;                            <<02519>>18690000
            COREBUF(I+3) := CNDRT3;                            <<02519>>18695000
            END                                                <<02519>>18700000
         ELSE                                                  <<02519>>18705000
            COREBUF(24) := M35CONTENTS24;                      <<02519>>18710000
         TOS:=M35NUMBANKS; TOS:=0;                             <<00.01>>18715000
         MAXMEM:=TOS-1D;                                       <<00.01>>18720000
MEMSIZE:=M35NUMBANKS;                                          <<00221>>18725000
         END  <<GET35CONTEXT>>;                                <<00.01>>18730000
                                                               <<00.01>>18735000
                                                                        18740000
      SUBROUTINE GET25CONTEXT;  << SERIES 33 THRU MM >>        <<*8993>>18745000
      <<-------------------->>                                          18750000
                                                                        18755000
         BEGIN                                                 <<00.01>>18760000
         XREG:=M25XREG;                                        <<00.01>>18765000
         DLREG:=M25DLREG;                                      <<00.01>>18770000
         DBBANKREG:=M25DBANKREG;                               <<00.01>>18775000
         DBREG:=M25DBREG;                                      <<00.01>>18780000
         QREG:=M25QREG;                                        <<00.01>>18785000
         SREG:=M25SREG;                                        <<00.01>>18790000
         ZBANKREG:=M25SBANKREG;                                <<00.01>>18795000
         ZREG:=M25ZREG;                                        <<00.01>>18800000
         STAREG:=M25STATUSREG;                                 <<00.01>>18805000
         PBBANKREG:=M25PBANKREG;                               <<00.01>>18810000
         PBREG:=M25PBREG;                                      <<00.01>>18815000
         PREG:=M25PREG;                                        <<00.01>>18820000
         PLREG:=M25PLREG;                                      <<00.01>>18825000
         CIRREG:=M25CIREG;                                     <<00.01>>18830000
         NIR:=M25NIRREG;                                       <<00.01>>18835000
         ISR:=M25ISR;                                          <<00.01>>18840000
         IF MACHINEID = ICF55                                  <<03013>>18845000
         THEN BEGIN                                            <<03013>>18850000
           NIR := M55NIRREG;                                   <<03013>>18855000
           CPX1 := M55CPX1;                                    <<03013>>18860000
           CPX2 := M55CPX2;                                    <<03013>>18865000
         END;                                                  <<03013>>18870000
         TOS:=M25NUMBANKS; TOS:=0;                             <<00.01>>18875000
         MAXMEM:=TOS-1D;                                       <<00.01>>18880000
MEMSIZE:=M25NUMBANKS;                                          <<00221>>18885000
         END  <<GET25CONTEXT>>;                                <<00.01>>18890000
                                                               <<01377>>18895000
                                                               <<03083>>18900000
SUBROUTINE CHECK'TAPE'FILES;                                   <<03083>>18905000
<<------------------------>>                                   <<03083>>18910000
    << THE RECORD AFTER THE END OF THE MEMORY DUMP IS READ>>   <<03083>>18915000
    << IF IT IS NOT AN END OF FILE MARK AN EOF IS ADDED,  >>   <<03083>>18920000
BEGIN                                                          <<03083>>18925000
                                                               <<03083>>18930000
TLOG:=FREAD(DMPTAPE,COREBUF,4096);                             <<03083>>18935000
IF <= THEN                                                     <<03083>>18940000
  BEGIN                                                        <<03083>>18945000
  FSPACE(DMPTAPE,-1);                                          <<03083>>18950000
  FCONTROL (DMPTAPE, 6, N);                                    <<84311>>18955000
  IF <> THEN                                                   <<03083>>18960000
    BEGIN                                                               18965000
    PRINTERROR(27);                                                     18970000
    GO ERRLEAVE;                                                        18975000
   END;END;                                                             18980000
END;                                                           <<03083>>18985000
                                                                        18990000
                                                                        18995000
SUBROUTINE INCOMPLETE;                                         <<01377>>19000000
<<------------------>>                                         <<01377>>19005000
  << THE INPUT DUMP FILE HAS BEEN FOUND TO BE INCOMPLETE.  >>  <<01377>>19010000
  << PRINT ERROR MESSAGE                                   >>  <<01377>>19015000
                                                               <<01377>>19020000
BEGIN                                                          <<01377>>19025000
   MOVE BUF := "INCOMPLETE DUMP:    K WORDS SHORT";           <<01377>> 19030000
   @PBUF := @BUF + 17;                                        <<01377>> 19035000
   ASCII( (NUMREC*4), 10, PBUF );                              <<01377>>19040000
   PRINT (LBUF, -33, %60);                                     <<84311>>19045000
                                                               <<01377>>19050000
END;  << INCOMPLETE. >>                                        <<01377>>19055000
                                                                        19060000
                                                                        19065000
SUBROUTINE GET'SERIESII'CONTEXT;                               <<01377>>19070000
<<--------------------------->>                                <<01377>>19075000
  << THE DEFAULT MACHINE CONTEXT IS THE OLD SERIES II.     >>  <<01377>>19080000
  << OTHER OPTIONS (HANDLED ELSEWHERE) ARE MODELS 25 & 35. >>  <<01377>>19085000
                                                               <<01377>>19090000
BEGIN                                                          <<01377>>19095000
   IF USETAPE THEN                                             <<84302>>19100000
      BEGIN   << Warn user to save tape.                    >> <<84302>>19105000
      PRINTERROR(36);   << This is not an error.            >> <<84302>>19110000
      PRINTERROR(37);   << Neither is this.                 >> <<84302>>19115000
      END                                                      <<84302>>19120000
   ELSE                                                        <<84302>>19125000
      BEGIN   << Tried to text from disc, not allowed.      >> <<84302>>19130000
      PRINTERROR(37);   << Same msg, but this IS an error.  >> <<84302>>19135000
      GO TO ERRLEAVE;                                          <<84302>>19140000
      END;                                                     <<84302>>19145000
   ADDRD := COREBUF( 0 );                                      <<01377>>19150000
   IF LOGICAL( ADDRD ) > %1010 THEN                            <<01377>>19155000
   BEGIN                                                       <<01377>>19160000
      PRINTERROR(24);                                                   19165000
      GO ERRLEAVE;                                                      19170000
   END;                                                        <<01377>>19175000
                                                                        19180000
SERIES2OR3 := TRUE;  << used by getcore >>                              19185000
                                                               <<01377>>19190000
<< SAVE PERTINENT  PARTS OF FIRST RECORD.                >>    <<01377>>19195000
   MOVE SCRBUF := COREBUF(1), (26);                            <<01377>>19200000
   BUFSAV := ADDRD + 1;                                        <<01377>>19205000
                                                                        19210000
<< READ NEXT RECORD AND RESTORE SAVED INFORMATION.       >>    <<01377>>19215000
<< THIS RECORD IS WRITTEN UPON RETURN TO COPY TO DISK CODE >>           19220000
   TLOG := FREAD( DMPTAPE,COREBUF, 4096 );                    <<01377>> 19225000
   IF > THEN                                                   <<84311>>19230000
      INCOMPLETE                                               <<84311>>19235000
   ELSE IF < THEN                                              <<84311>>19240000
      BEGIN   << Tape error.                                >> <<84311>>19245000
      PRINTERROR (25);                                         <<84311>>19250000
      GO TO ERRLEAVE;                                          <<84311>>19255000
      END;    << Tape error.                                >> <<84311>>19260000
   MOVE REGSAVE := COREBUF( BUFSAV+1 ), (26);                  <<01377>>19265000
   MOVE COREBUF( BUFSAV ) := SCRBUF, (26);                     <<01377>>19270000
   MOVE COREBUF( BUFSAV-7 ) := REGSAVE, (6);                   <<01377>>19275000
   COREBUF( BUFSAV-1 ) := REG6;                                <<01377>>19280000
   COREBUF( BUFSAV )   := REG7;                                <<01377>>19285000
                                                               <<01377>>19290000
   TOS := 0;                                                   <<01377>>19295000
   TOS := MEMSIZE;                                             <<01377>>19300000
   TOS := TOS&DCSR(3)&LSL(3);                                  <<01377>>19305000
   ASB( XCH );                                                 <<01377>>19310000
   TOS := TOS&CSL(3);                                          <<01377>>19315000
   ASB( XCH );                                                 <<01377>>19320000
   TOS := TOS - 1D;                                            <<01377>>19325000
   IF < THEN BEGIN DDEL; TOS := %777777D; END;  << 256 K >>    <<01833>>19330000
   MAXMEM := TOS;                                              <<01377>>19335000
                                                               <<01377>>19340000
END;  << GET'SERIESII'CONTEXT >>                               <<01377>>19345000
                                                               <<01377>>19350000
                                                                        19355000
SUBROUTINE INIT'SVREGS;                                                 19360000
<<------------------->>                                                 19365000
 BEGIN                                                                  19370000
                                                                        19375000
<< SAVE THE VALUES OF THE REGISTERS IN CASE THE USER>>                  19380000
<< CHANGES THEM BY USING THE "SET" COMMAND.  THIS   >>                  19385000
<< ENSURES THAT THE REGISTERS CAN BE RESET TO THE   >>                  19390000
<< ORIGINAL VALUES.                                 >>                  19395000
                                                                        19400000
  SVDBBANK:=DBBANKREG;       SVPBBANK:=PBBANKREG;                       19405000
  SVDBREG :=DBREG;           SVPBREG :=PBREG;                           19410000
  SVSBANK :=ZBANKREG;        SVQREG  :=QREG;                            19415000
  SVSREG  :=SREG;            SVZREG  :=ZREG;                            19420000
  SVDLREG :=DLREG;                                                      19425000
                                                                        19430000
END; << SUBROUTINE INIT'SVREGS >>                                       19435000
                                                                        19440000
                                                                        19445000
SUBROUTINE GET'SERIES'TYPE;                                             19450000
<<----------------------->>                                             19455000
BEGIN                                                                   19460000
                                                                        19465000
                                                               <<01377>>19470000
<< GET MACHINE ID AND APPROPRIATE MACHINE CONTEXT.       >>    <<01377>>19475000
   MACHINEID := CNMACHINEID;                                   <<01377>>19480000
   IF      MACHINEID = MODEL35                                 <<01377>>19485000
      THEN GET35CONTEXT                                        <<01377>>19490000
   ELSE IF SERIES'33'THRU'MM                                   <<*8993>>19495000
      THEN GET25CONTEXT                                        <<01377>>19500000
   ELSE    GET'SERIESII'CONTEXT;                               <<01377>>19505000
                                                                        19510000
CASE MACHINEID OF                                                       19515000
   BEGIN                                                                19520000
  << SERIES II >> BEGIN                                                 19525000
                  MOVE SERIESBUF:="II ";                                19530000
                  END;                                                  19535000
  << SERIES III>> BEGIN                                                 19540000
                  MOVE SERIESBUF:="III";                                19545000
                  END;                                                  19550000
  << SERIES 33 >> BEGIN                                                 19555000
                  MOVE SERIESBUF:="33 ";                                19560000
                  END;                                                  19565000
  << SERIES 44 >> BEGIN                                                 19570000
                  MOVE SERIESBUF:="44 ";                                19575000
                  END;                                                  19580000
  << SERIES 64 >> BEGIN                                                 19585000
                  MOVE SERIESBUF:="64 ";                                19590000
                  END;                                                  19595000
  << SERIES 37 >> BEGIN                                        <<*8993>>19600000
                  MOVE SERIESBUF:="37 ";                       <<*8993>>19605000
                  END;                                         <<*8993>>19610000
   END; <<CASE>>                                                        19615000
                                                                        19620000
END;                                                                    19625000
                                                                        19630000
                                                                        19635000
<<  M A I N    B O D Y                                   >>    <<01377>>19640000
                                                                        19645000
IF NOT   NEW'TEXT THEN                                                  19650000
  BEGIN                                                                 19655000
  FCLOSE(COREF,1,0); << SAVE LAST FILE BEFORE TEXTING NEW ONE >>        19660000
    IF <> THEN                                                          19665000
      BEGIN                                                             19670000
      FCHECK(COREF,ERROR);                                              19675000
      GENMSGU(8,ERROR);                                                 19680000
      PRINTERROR(30);                                                   19685000
                                                               <<84311>>19690000
ERRLEAVE:                                                      <<84311>>19695000
                                                               <<84311>>19700000
      IF DMPTAPE <> 0 THEN                                     <<84311>>19705000
         FCLOSE (DMPTAPE, 0, 0);                               <<84311>>19710000
      IF COREF <> 0 THEN                                       <<84311>>19715000
         FCLOSE (COREF, 0, 0);   << Leave like we found it. >> <<84311>>19720000
      NEW'TEXT := TRUE;          << No text file open.      >> <<84311>>19725000
      RETURN;                                                  <<84311>>19730000
      END;                                                              19735000
  NEW'TEXT := TRUE;                                            <<84311>>19740000
  END;                                                         <<84311>>19745000
                                                                        19750000
SERIES2OR3 := FALSE;                                                    19755000
CURMEMAREA:=-1;                                                         19760000
FILE'GOOD:=FALSE;                                                       19765000
USETAPE:=FALSE;                                                         19770000
MOVE DUMPTAPE := "DUMPTAPE ";                                  <<84311>>19775000
                                                                        19780000
<<SET UP TO PARSE THE PARAMETERS>>                                      19785000
DELIMITERS(0):=",";                                                     19790000
DELIMITERS(1):=CR;                                                      19795000
MYCOMMAND(PARMSTRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               19800000
  IF <> THEN                                                            19805000
    BEGIN                                                               19810000
    PRINTERROR(0);                                                      19815000
    RETURN;                                                             19820000
    END;                                                                19825000
                                                                        19830000
IF NOT (0<=NUMPARMS <=2) THEN                                           19835000
  BEGIN                                                                 19840000
  PRINTERROR(7);                                                        19845000
  RETURN;                                                               19850000
  END;                                                                  19855000
                                                                        19860000
IF NUMPARMS = 0 THEN RETURN;                                            19865000
                                                                        19870000
IF NUMPARMS = 2 THEN << SHOULD BE TAPE OPTION >>                        19875000
  BEGIN                                                                 19880000
  TOS:=PARMS(1);                                                        19885000
  INFOWORD:=TOS;                                                        19890000
  @STRING:=TOS;                                                         19895000
  LENGTH := INFOWORD.(0:8);                                    <<84311>>19900000
                                                                        19905000
  IF LENGTH <> 4 OR STRING <> "TAPE" THEN                               19910000
    BEGIN                                                               19915000
    PRINTERROR(12);                                                     19920000
    RETURN;                                                             19925000
    END;                                                                19930000
                                                                        19935000
  <<NEED TO OPEN TAPE FILE>>                                            19940000
  USETAPE:=TRUE;                                                        19945000
  END;                                                                  19950000
                                                                        19955000
<<GET NAME OF DISC FILE TO OPEN>>                                       19960000
TOS:=PARMS(0);                                                          19965000
INFOWORD:=TOS;                                                          19970000
@STRING:=TOS;                                                           19975000
LENGTH := INFOWORD.(0:8);                                      <<84311>>19980000
                                                                        19985000
IF LENGTH > 35 THEN                                            <<84311>>19990000
   BEGIN   << Exceeds maximum Fname/Lock.Group.Acct.        >> <<84311>>19995000
   PRINTERROR (38);   << "File name is too long."           >> <<84311>>20000000
   RETURN;   << Let File System handle syntax errors.       >> <<84311>>20005000
   END;    << Exceeds maximum Fname/Lock.Group.Acct.        >> <<84311>>20010000
MOVE DISCFILENAME:=STRING,(LENGTH);                                     20015000
DISCFILENAME(LENGTH):=" ";                                     <<84311>>20020000
COREF := FOPEN (DISCFILENAME, %3, %4);   << Try to open old >> <<84311>>20025000
IF = THEN                                                      <<84311>>20030000
   BEGIN   << File exists.                                  >> <<84311>>20035000
   IF USETAPE THEN                                             <<84311>>20040000
      BEGIN   << User inputting from tape, must purge xstng >> <<84311>>20045000
      MOVE BUF := DISCFILENAME, (LENGTH), 2;                   <<84311>>20050000
      MOVE *   := " already exists - OK to purge? (Y/N) ", 2;  <<84311>>20055000
      LENGTH := TOS - @BUF;                                    <<84311>>20060000
      FWRITE (OUTFILE, LBUF, -LENGTH, %320);                   <<84311>>20065000
      IF <> THEN TERMINATE;                                    <<84311>>20070000
      FREAD (INFILE, LBUF, -20);                               <<84311>>20075000
      IF <> THEN TERMINATE;                                    <<84311>>20080000
      IF BUF = "Y" OR BUF = "y" THEN                           <<84311>>20085000
         BEGIN   << User approved the purge.                >> <<84311>>20090000
         FCLOSE (COREF, 4, 0);                                 <<84311>>20095000
         IF <> THEN                                            <<84311>>20100000
            BEGIN   << Purge failed, find out why and leave >> <<84311>>20105000
            FCHECK (COREF, ERROR);                             <<84311>>20110000
            GENMSGU (8, ERROR);                                <<84311>>20115000
            PRINTERROR (22);                                   <<84311>>20120000
            GO TO ERRLEAVE;                                    <<84311>>20125000
            END;    << Purge failed, find out why and leave >> <<84311>>20130000
         END     << User approved the purge.                >> <<84311>>20135000
      ELSE                                                     <<84311>>20140000
         BEGIN   << User disallowed the purge.              >> <<84311>>20145000
         PRINTERROR (22);                                      <<84311>>20150000
         GO TO ERRLEAVE;                                       <<84311>>20155000
         END;    << User disallowed the purge.              >> <<84311>>20160000
      END;    << User inputting from tape, must purge xstng >> <<84311>>20165000
   END     << File exists.                                  >> <<84311>>20170000
ELSE                                                           <<84311>>20175000
   BEGIN   << Can't open file, does it exist?               >> <<84311>>20180000
   FCHECK (COREF, ERROR);                                      <<84311>>20185000
   IF 52 <= ERROR <= 53 THEN                                   <<84311>>20190000
      BEGIN   << No such file, O.K. if texting from tape.   >> <<84311>>20195000
      IF NOT USETAPE THEN                                      <<84311>>20200000
         BEGIN   << Not texting from tape, error.           >> <<84311>>20205000
         PRINTERROR (23);                                      <<84311>>20210000
         GO TO ERRLEAVE;                                       <<84311>>20215000
         END;    << Not texting from tape, error.           >> <<84311>>20220000
      END     << No such file, O.K. if texting from tape.   >> <<84311>>20225000
   ELSE                                                        <<84311>>20230000
      BEGIN   << Some other error, report it and leave.     >> <<84311>>20235000
      GENMSGU (8, ERROR);                                      <<84311>>20240000
      PRINTERROR (21);                                         <<84311>>20245000
      GO TO ERRLEAVE;                                          <<84311>>20250000
      END;    << Some other error, report it and leave.     >> <<84311>>20255000
   END;    << Can't open file, does it exist?               >> <<84311>>20260000
                                                                        20265000
<< EITHER HAVE SUCCESSFULLY OPENED EXISTING disc DUMPFILE OR NEED       20270000
   TO OPEN NEW FILE                                          >>         20275000
IF COREF = 0 THEN                                              <<84311>>20280000
  BEGIN   << OPEN AS NEW FILE >>                                        20285000
  COREF:=FOPEN(DISCFILENAME,0,%4,4096,,,,,,1024D,32,4);                 20290000
    IF <> THEN                                                          20295000
      BEGIN                                                             20300000
      FCHECK(COREF,ERROR);                                              20305000
      GENMSGU(8,ERROR);                                                 20310000
      PRINTERROR(21);                                                   20315000
      GO TO ERRLEAVE;                                          <<84311>>20320000
      END;                                                              20325000
  END;                                                                  20330000
                                                                        20335000
<< VERIFY THAT FILE HAS CORRECT CHARACTERISTICS >>                      20340000
FGETINFO(COREF,,,,RECSIZE,DEVTYPE,,,,,,,,,BLKSIZE);                     20345000
IF <> THEN                                                              20350000
  BEGIN                                                                 20355000
  FCHECK(COREF,ERROR);                                                  20360000
  GENMSGU(8,ERROR);                                                     20365000
  PRINTERROR(21);                                                       20370000
  GO TO ERRLEAVE;                                              <<84311>>20375000
  END;                                                                  20380000
                                                                        20385000
IF RECSIZE <> 4096 OR DEVTYPE.(10:3) <> DISC'ACCESS'TYPE       <<84311>>20390000
                   OR BLKSIZE <> RECSIZE THEN                  <<84311>>20395000
  BEGIN             << ^ Blocking factor of one.         >>    <<84311>>20400000
  PRINTERROR(24);                                              <<84311>>20405000
  GO TO ERRLEAVE;                                              <<84311>>20410000
  END;                                                                  20415000
                                                                        20420000
<< Open tape file if necessary, and copy to disc file.      >> <<84311>>20425000
IF USETAPE THEN                                                         20430000
  BEGIN                                                                 20435000
  MOVE TP:="TAPE ";                                                     20440000
  DMPTAPE:=FOPEN(DUMPTAPE,%200,%4,4096,TP);                             20445000
   IF <> THEN                                                           20450000
     BEGIN                                                              20455000
     FCHECK(DMPTAPE,ERROR);                                             20460000
     GENMSGU(8,ERROR);                                                  20465000
     PRINTERROR(21);                                                    20470000
     GO TO ERRLEAVE;                                           <<84311>>20475000
     END;                                                               20480000
                                                                        20485000
  << VERIFY THAT TAPE FILE HAS CORRECT CHARACTERISTICS >>               20490000
  FGETINFO(DMPTAPE,,,,RECSIZE,DEVTYPE,,,,,,,,,BLKSIZE);                 20495000
    IF <> THEN                                                          20500000
      BEGIN                                                             20505000
      FCHECK(DMPTAPE,ERROR);                                            20510000
      GENMSGU(8,ERROR);                                                 20515000
      PRINTERROR(21);                                                   20520000
      GO TO ERRLEAVE;                                          <<84311>>20525000
      END;                                                              20530000
                                                                        20535000
  IF RECSIZE <> 4096 OR DEVTYPE.(10:6) <> TAPE'TYPE            <<84311>>20540000
                     OR BLKSIZE <> RECSIZE THEN                <<84311>>20545000
    BEGIN                                                               20550000
    PRINTERROR(24);                                                     20555000
    RETURN;                                                             20560000
    END;                                                                20565000
                                                                        20570000
                                                                        20575000
<< READ THE FIRST RECORD IN THE DUMP FILE.               >>    <<01377>>20580000
   NUMREC := 256;   << 2 MB WORDS / 4 K WORDS PER REC.   >>    <<01377>>20585000
   TLOG := FREAD( DMPTAPE, COREBUF, 4096 );                    <<01377>>20590000
   IF <> THEN       << FREAD ERROR ON FIRST RECORD.      >>    <<01377>>20595000
      BEGIN                                                    <<01377>>20600000
      FCHECK(DMPTAPE,ERROR);                                            20605000
      GENMSGU(8,ERROR);                                                 20610000
      PRINTERROR(25);                                                   20615000
      GO ERRLEAVE;                                             <<01377>>20620000
      END;                                                     <<01377>>20625000
                                                                        20630000
   GET'SERIES'TYPE;                                                     20635000
                                                                        20640000
   FWRITEDIR( COREF, COREBUF, 4096, 0D );                      <<01377>>20645000
   IF <> THEN                                                  <<01377>>20650000
      BEGIN                                                    <<84311>>20655000
      PRINT'FILE'INFO( COREF );                                <<01377>>20660000
      PRINTERROR(26);                                                   20665000
      GO ERRLEAVE;                                             <<01377>>20670000
      END;                                                     <<01377>>20675000
                                                                        20680000
   NUMREC := INTEGER( MAXMEM&DLSR(12) );                       <<01377>>20685000
   WHILE NUMREC > 0 DO                                         <<84311>>20690000
   BEGIN                                                       <<01377>>20695000
<< COPY THE REST OF THE DUMP FILE TO THE CORE DISK FILE. >>    <<01377>>20700000
                                                               <<01377>>20705000
   << READ AND CHECK THE NEXT RECORD.                    >>    <<01377>>20710000
      TLOG := FREAD( DMPTAPE, COREBUF, 4096 );                 <<01377>>20715000
      IF < THEN                                                         20720000
         BEGIN                << READ ERROR ON TAPE FILE >>             20725000
         FCHECK (DMPTAPE,ERROR);                                        20730000
         GENMSGU (8,ERROR);                                             20735000
         PRINTERROR (25);                                               20740000
         GO ERRLEAVE;                                                   20745000
         END                                                            20750000
      ELSE IF > THEN            << FREAD SHORT.          >>    <<01377>>20755000
         BEGIN                                                 <<01377>>20760000
         << IF THIS IS LAST RECORD, THEN FREAD SHORT OKAY.  >> <<01377>>20765000
            IF NUMREC > 1 THEN                                 <<01377>>20770000
            BEGIN                                              <<01377>>20775000
               INCOMPLETE;                                     <<01377>>20780000
               GO ERRLEAVE;                                    <<01377>>20785000
            END;                                               <<01377>>20790000
         END;  << FREAD SHORT. >>                              <<01377>>20795000
                                                               <<01377>>20800000
   << WRITE THE RECORD TO THE CORE DISK FILE.            >>    <<01377>>20805000
      FWRITE( COREF, COREBUF, 4096, 0 );                       <<01377>>20810000
      IF <> THEN                                               <<01377>>20815000
      BEGIN                                                    <<01377>>20820000
         PRINT'FILE'INFO( COREF );                             <<01377>>20825000
         PRINTERROR(26);                                                20830000
         GO ERRLEAVE;                                          <<01377>>20835000
      END;                                                     <<01377>>20840000
                                                               <<01377>>20845000
      NUMREC := NUMREC - 1;                                    <<01377>>20850000
                                                               <<01377>>20855000
     END;    << COPYING LOOP >>                                <<01377>>20860000
                                                               <<01377>>20865000
   CHECK'TAPE'FILES; << ADD EOF IF NEEDED >>                   <<03083>>20870000
                                                                        20875000
   << SAVE TAPE FILE ON DISC, THEN REOPEN >>                            20880000
   FCLOSE(COREF,1,0);                                                   20885000
   IF <> THEN                                                           20890000
      BEGIN                                                             20895000
      FCHECK(COREF,ERROR);                                              20900000
      GENMSGU(8,ERROR);                                                 20905000
      PRINTERROR(31);                                                   20910000
      GO TO ERRLEAVE;                                          <<84311>>20915000
      END                                                               20920000
   ELSE                                                        <<84311>>20925000
      BEGIN   << No problem closing, try to reopen.         >> <<84311>>20930000
      COREF := FOPEN (DISCFILENAME, 3, 4);                     <<84311>>20935000
      IF <> THEN                                               <<84311>>20940000
         BEGIN   << Couldn't reopen file.                   >> <<84311>>20945000
         FCHECK (COREF, ERROR);                                <<84311>>20950000
         GENMSGU (8, ERROR);                                   <<84311>>20955000
         PRINTERROR (21);                                      <<84311>>20960000
         GO TO ERRLEAVE;                                       <<84311>>20965000
         END;    << Couldn't reopen file.                   >> <<84311>>20970000
      END;    << No problem closing, try to reopen.         >> <<84311>>20975000
   FCLOSE (DMPTAPE, 0, 0);   << Done with tape file.        >> <<84311>>20980000
   END     << Texting file from tape.                       >> <<84311>>20985000
ELSE                                                           <<84311>>20990000
   BEGIN   << Texting from disc.                            >> <<84311>>20995000
   FREADDIR (COREF, COREBUF, 4096, 0D);                        <<84311>>21000000
   IF <> THEN                                                  <<84311>>21005000
      BEGIN                                                    <<84311>>21010000
      FCHECK (COREF, ERROR);                                   <<84311>>21015000
      GENMSGU (8, ERROR);                                      <<84311>>21020000
      GO TO ERRLEAVE;                                          <<84311>>21025000
      END;                                                     <<84311>>21030000
   GET'SERIES'TYPE;                                            <<84311>>21035000
   END;    << Texting from disc.                            >> <<84311>>21040000
                                                                        21045000
INIT'SVREGS;  <<SAVE ORIGINAL VALUES OF REGISTERS FROM DISCFILE>>       21050000
NEW'TEXT := FALSE;   << Ready to boogie.                    >> <<84311>>21055000
                                                                        21060000
END;    << of TEXTFILE.                                     >> <<84311>>21065000
$PAGE "                PROCEDURE FMTREGS"                               21070000
<<*********************************************>>                       21075000
<<  FMTREGS                                    >>                       21080000
<<--------------------------------------------->>                       21085000
<< FORMATS AND PRINTS REGISTER TABLE AND THE   >>                       21090000
<< FIRST 9 WORDS OF FIXED LOW MEMORY           >>                       21095000
<<*********************************************>>                       21100000
                                                                        21105000
PROCEDURE FMTREGS(PRNTFILE);                                            21110000
   VALUE PRNTFILE;                                                      21115000
   INTEGER PRNTFILE;                                                    21120000
BEGIN                                                                   21125000
                                                                        21130000
<<  THIS PROCEDURE ASSUMES THE EXISTENCE OF THE FOLLOWING >>            21135000
<< GLOBAL VARIABLES:                                      >>            21140000
<<    ALL REGISTERS AND "SAVE" REGISTERS                  >>            21145000
<<    MACHINEID                                           >>            21150000
<<    SERIESBUF                  PROCEDURE PUTNUM         >>            21155000
<<    COREF                      COREBUF                  >>            21160000
                                                                        21165000
ARRAY LBUF(0:35);                                                       21170000
BYTE ARRAY BUF(*)=LBUF;                                                 21175000
                                                                        21180000
LOGICAL DUMMY;  << Dummy return from CORE call which loads COREBUF>>    21185000
                                                                        21190000
BYTE ARRAY TEMP(0:5);  << FOR ASCII CONVERSIONS >>                      21195000
                                                                        21200000
LOGICAL ARRAY OUTLN(0:34);                                              21205000
BYTE ARRAY OUTLNB(*)=OUTLN;  << LINE OF ASTERISKS FOR                   21210000
                                "BOXING-IN" TABLE     >>                21215000
LOGICAL ARRAY HEAD(0:34);                                               21220000
BYTE ARRAY HEADB(*)=HEAD;  << HEADER OF REGISTER TABLE >>               21225000
                                                                        21230000
<< BODYLINES OF TABLE>>                                                 21235000
LOGICAL ARRAY BDYLN1(0:34),                                             21240000
              BDYLN2(0:34),                                             21245000
              BDYLN3(0:34),                                             21250000
              BDYLN4(0:34),                                             21255000
              BDYLN5(0:34),                                             21260000
              BDYLN6(0:34),                                             21265000
              BDYLN7(0:34),                                             21270000
              BDYLN8(0:34);                                             21275000
                                                                        21280000
BYTE ARRAY BDYLN1B(*)=BDYLN1,                                           21285000
           BDYLN2B(*)=BDYLN2,                                           21290000
           BDYLN3B(*)=BDYLN3,                                           21295000
           BDYLN4B(*)=BDYLN4,                                           21300000
           BDYLN5B(*)=BDYLN5,                                           21305000
           BDYLN6B(*)=BDYLN6,                                           21310000
           BDYLN7B(*)=BDYLN7,                                           21315000
           BDYLN8B(*)=BDYLN8;                                           21320000
                                                                        21325000
                                                                        21330000
SUBROUTINE INIT'BUFFERS;                                                21335000
<<-------------------->>                                                21340000
    << INITIALIZE BUFFERS THAT WON'T CHANGE DURING THE >>               21345000
    << COURSE OF THE PROCEDURE                         >>               21350000
BEGIN                                                                   21355000
                                                                        21360000
<< LINE OF ASTERISKS >>                                                 21365000
MOVE OUTLNB:="*";                                                       21370000
MOVE OUTLNB(1):=OUTLNB,(70);                                            21375000
                                                                        21380000
<< HEADER LINE >>                                                       21385000
MOVE HEADB:="*   DATA SEGMENT   *";                                     21390000
MOVE HEADB(20):="  CODE SEGMENT  *";                                    21395000
MOVE HEADB(37):="MISCELLANEOUS*";                                       21400000
MOVE HEADB(51):=" STATUS = ";                                           21405000
ASCII(STAREG,8,HEADB(61));                                              21410000
MOVE HEADB(67):="  *";                                                  21415000
                                                                        21420000
<< BLANK OUT TABLE LINES >>                                             21425000
MOVE BDYLN1B:=" ";                                                      21430000
MOVE BDYLN1B(1):=BDYLN1B,(69);                                          21435000
                                                                        21440000
MOVE BDYLN2B := BDYLN1B, (70);                                 <<84301>>21445000
                                                                        21450000
MOVE BDYLN3B := BDYLN1B, (70);                                 <<84301>>21455000
                                                                        21460000
MOVE BDYLN4B := BDYLN1B, (70);                                 <<84301>>21465000
                                                                        21470000
MOVE BDYLN5B := BDYLN1B, (70);                                 <<84301>>21475000
                                                                        21480000
MOVE BDYLN6B := BDYLN1B, (70);                                 <<84301>>21485000
                                                                        21490000
MOVE BDYLN6B := BDYLN1B, (70);                                 <<84301>>21495000
                                                                        21500000
MOVE BDYLN7B := BDYLN1B, (70);                                 <<84301>>21505000
                                                                        21510000
MOVE BDYLN8B := BDYLN1B, (70);                                 <<84301>>21515000
                                                                        21520000
                                                                        21525000
END;   << SUBROUTINE INIT'BUFFERS >>                                    21530000
                                                                        21535000
                                                                        21540000
SUBROUTINE LOAD'DATASEG;                                                21545000
<<-------------------->>                                                21550000
   << MOVE DATA SEGMENT TO OUTPUT BUFFERS >>                            21555000
BEGIN                                                                   21560000
                                                                        21565000
MOVE BDYLN1B:="* DB BANK =";                                   <<84301>>21570000
ASCII(DBBANKREG,8,BDYLN1B(12));                                         21575000
BDYLN1B(19) := "*";                                            <<84301>>21580000
IF SVDBBANK <> DBBANKREG THEN BDYLN1B(18) := "#";              <<84301>>21585000
                                                                        21590000
MOVE BDYLN2B:="* DB      =";                                   <<84301>>21595000
ASCII(DBREG,8,BDYLN2B(12));                                             21600000
BDYLN2B(19) := "*";                                            <<84301>>21605000
IF SVDBREG <> DBREG THEN BDYLN2B(18) := "#";                   <<84301>>21610000
                                                                        21615000
MOVE BDYLN3B:="* S  BANK =";                                   <<84301>>21620000
ASCII(ZBANKREG,8,BDYLN3B(12));                                          21625000
BDYLN3B(19) := "*";                                            <<84301>>21630000
IF SVSBANK <> ZBANKREG THEN BDYLN3B(18) := "#";                <<84301>>21635000
                                                                        21640000
MOVE BDYLN4B:="* DL      =";                                   <<84301>>21645000
ASCII(DLREG,8,BDYLN4B(12));                                             21650000
BDYLN4B(19) := "*";                                            <<84301>>21655000
IF SVDLREG <> DLREG THEN BDYLN4B(18) := "#";                   <<84301>>21660000
                                                                        21665000
MOVE BDYLN5B:="* Q       =";                                   <<84301>>21670000
ASCII(QREG,8,BDYLN5B(12));                                              21675000
BDYLN5B(19) := "*";                                            <<84301>>21680000
IF SVQREG <> QREG THEN BDYLN5B(18) := "#";                     <<84301>>21685000
                                                                        21690000
MOVE BDYLN6B:="* S       =";                                   <<84301>>21695000
ASCII(SREG,8,BDYLN6B(12));                                              21700000
BDYLN6B(19) := "*";                                            <<84301>>21705000
IF SVSREG <> SREG THEN BDYLN6B(18) := "#";                     <<84301>>21710000
                                                                        21715000
MOVE BDYLN7B:="* Z       =";                                   <<84301>>21720000
ASCII(ZREG,8,BDYLN7B(12));                                              21725000
BDYLN7B(19) := "*";                                            <<84301>>21730000
IF SVZREG <> ZREG THEN BDYLN7B(18) := "#";                     <<84301>>21735000
                                                                        21740000
BDYLN8B := BDYLN8B(19) := "*";                                 <<84301>>21745000
                                                                        21750000
END;  << SUBROUTINE LOAD'DATASEG >>                                     21755000
                                                                        21760000
                                                                        21765000
SUBROUTINE LOAD'CODESEG;                                                21770000
<<-------------------->>                                                21775000
  << MOVE CODE SEGMENT TO OUTPUT BUFFERS >>                             21780000
BEGIN                                                                   21785000
                                                                        21790000
MOVE BDYLN1B(21) := "PB    =";                                 <<84301>>21795000
ASCII(PBREG,8,BDYLN1B(29));                                             21800000
BDYLN1B(36) := "*";                                            <<84301>>21805000
IF SVPBREG <> PBREG THEN BDYLN1B(35) := "#";                   <<84301>>21810000
                                                                        21815000
MOVE BDYLN2B(21) := "P     =";                                 <<84301>>21820000
ASCII(PREG,8,BDYLN2B(29));                                              21825000
BDYLN2B(36) := "*";                                            <<84301>>21830000
                                                                        21835000
MOVE BDYLN3B(21) := "PL    =";                                 <<84301>>21840000
ASCII(PLREG,8,BDYLN3B(29));                                             21845000
BDYLN3B(36) := "*";                                            <<84301>>21850000
                                                                        21855000
MOVE BDYLN4B(21) := "PBBANK=";                                 <<84301>>21860000
ASCII(PBBANKREG,8,BDYLN4B(29));                                         21865000
BDYLN4B(36) := "*";                                            <<84301>>21870000
IF SVPBBANK <> PBBANKREG THEN BDYLN4B(35) := "#";              <<84301>>21875000
                                                                        21880000
MOVE BDYLN5B(21) := "(P-PB)=";                                 <<84301>>21885000
ASCII((PREG-PBREG),8,BDYLN5B(29));                                      21890000
BDYLN5B(36) := "*";                                            <<84301>>21895000
                                                                        21900000
BDYLN6B(36) := BDYLN7B(36) := BDYLN8B(36) := "*";              <<84301>>21905000
                                                                        21910000
END;  << SUBROUTINE LOAD'CODESEG >>                                     21915000
                                                                        21920000
                                                                        21925000
SUBROUTINE LOADNUMP( BPTR, NUM);                               <<*8993>>21930000
<<--------------------------->>                                <<*8993>>21935000
 << USED TO MOVE SEGMENT NO. FROM STATUS REG. TO OUTPUT BUFF >><<*8993>>21940000
                                                               <<*8993>>21945000
   VALUE BPTR,NUM;                                             <<*8993>>21950000
   BYTE POINTER BPTR;                                          <<*8993>>21955000
   INTEGER      NUM;                                           <<*8993>>21960000
BEGIN                                                          <<*8993>>21965000
   @PBUF := @BPTR;                                             <<*8993>>21970000
   PUTNUMP ( NUM);                                             <<*8993>>21975000
END;      << SUBROUTINE LOADNUMP >>                            <<*8993>>21980000
                                                               <<*8993>>21985000
                                                               <<*8993>>21990000
SUBROUTINE LOAD'MISCREGS;                                               21995000
<<--------------------->>                                               22000000
   <<  MOVE MISCELLANEOUS REGISTERS TO OUTPUT BUFFERS >>                22005000
BEGIN                                                                   22010000
                                                                        22015000
MOVE BDYLN1B(38) := "X  =";                                    <<84301>>22020000
ASCII(XREG,8,BDYLN1B(43));                                              22025000
BDYLN1B(50) := "*";                                            <<84301>>22030000
                                                                        22035000
MOVE BDYLN2B(38) := "CIR=";                                    <<84301>>22040000
ASCII(CIRREG,8,BDYLN2B(43));                                            22045000
BDYLN2B(50) := "*";                                            <<84301>>22050000
                                                                        22055000
CASE MACHINEID OF BEGIN                                                 22060000
 << SERIES II >> BEGIN                                                  22065000
                 MOVE BDYLN3B(37) := "CPX1=";                  <<84301>>22070000
                 ASCII(CPX1,8,BDYLN3B(43));                             22075000
                 BDYLN3B(50) := "*";                           <<84301>>22080000
                                                                        22085000
                 MOVE BDYLN4B(37):="MSIZE=";                            22090000
                 ASCII(MEMSIZE,8,BDYLN4B(43));                          22095000
                 BDYLN4B(50) := "*";                           <<84301>>22100000
                                                                        22105000
                 END;                                                   22110000
 << SERIES III>> BEGIN                                                  22115000
                 MOVE BDYLN3B(37):="CPX1= ";                            22120000
                 ASCII(CPX1,8,BDYLN3B(43));                             22125000
                 BDYLN3B(50) := "*";                           <<84301>>22130000
                                                                        22135000
                 MOVE BDYLN4B(37):="CPX2= ";                            22140000
                 ASCII(CPX2,8,BDYLN4B(43));                             22145000
                 BDYLN4B(50) := "*";                           <<84301>>22150000
                                                                        22155000
                 END;                                                   22160000
                                                                        22165000
 << SERIES 33 >> BEGIN                                                  22170000
                 MOVE BDYLN3B(37):=" NIR= ";                            22175000
                 ASCII(NIR,8,BDYLN3B(43));                              22180000
                 BDYLN3B(50) := BDYLN4B(50) := "*";            <<84301>>22185000
                 END;                                                   22190000
                                                                        22195000
 << SERIES 44 >> BEGIN                                                  22200000
                 MOVE BDYLN3B(37):=" NIR= ";                            22205000
                 ASCII(NIR,8,BDYLN3B(43));                              22210000
                 BDYLN3B(50) := BDYLN4B(50) := "*";            <<84301>>22215000
                 END;                                                   22220000
                                                                        22225000
 << SERIES 55 >> BEGIN                                                  22230000
                 MOVE BDYLN3B(37):=" NIR= ";                            22235000
                 ASCII(NIR,8,BDYLN3B(43));                              22240000
                 BDYLN3B(50) := "*";                           <<84301>>22245000
                                                                        22250000
                 MOVE BDYLN4B(37):="CPX1= ";                            22255000
                 ASCII(CPX1,8,BDYLN4B(43));                             22260000
                 BDYLN4B(50) := "*";                           <<84301>>22265000
                 END;                                                   22270000
                                                                        22275000
                                                               <<*8993>>22280000
<< SERIES 37 >> BEGIN                                          <<*8993>>22285000
                MOVE BDYLN3B(37):=" NIR ";                     <<*8993>>22290000
                ASCII(NIR,8,BDYLN3B(43));                      <<*8993>>22295000
                BDYLN3B(50) := BDYLN4B(50) := "*";             <<*8993>>22300000
                                                               <<*8993>>22305000
                MOVE BDYLN6B(37):=" UCODE VER=";               <<*8993>>22310000
                ASCII(CORE(DOUBLE(%1421)),8,BDYLN7B(41));      <<*8993>>22315000
                MOVE BDYLN8B(37):=" STOP = 000";               <<*8993>>22320000
               LOADNUMP(BDYLN8B(42),CORE(DOUBLE(%1422)).(8:8));<<*8993>>22325000
                END;                                           <<*8993>>22330000
                                                               <<*8993>>22335000
    END;   << CASE >>                                                   22340000
BDYLN5B(50) := BDYLN6B(50) := BDYLN7B(50) :=                   <<84301>>22345000
               BDYLN8B(50) := "*";                             <<84301>>22350000
     MOVE BDYLN5B(37):=" MAP= ";                                        22355000
     IF CORE(%1220D) THEN MOVE BDYLN5B(42):=" ON"                       22360000
     ELSE MOVE BDYLN5B(42):=" OFF";                                     22365000
END;  <<SUBROUTINE LOAD'MISCREGS >>                                     22370000
                                                                        22375000
                                                               <<03013>>22380000
SUBROUTINE ON'OFF (BPTR, NUM);                                 <<03013>>22385000
<<--------------------------->>                                <<03013>>22390000
   << LOADS "ON" OR "OFF" TO OUTPUT BUFFER DEPENDING ON >>              22395000
   << THE VALUE OF THE NUMBER PASSED TO THIS PROC.      >>              22400000
                                                                        22405000
    VALUE BPTR,NUM;                                            <<03013>>22410000
    BYTE POINTER BPTR;                                         <<03013>>22415000
    INTEGER      NUM;                                          <<03013>>22420000
BEGIN                                                          <<03013>>22425000
    IF NUM= 1                                                  <<03013>>22430000
    THEN MOVE BPTR := "ON "                                    <<03013>>22435000
    ELSE MOVE BPTR := "OFF";                                   <<03013>>22440000
END;   << SUBROUTINE ON'OFF >>                                 <<03013>>22445000
                                                               <<03013>>22450000
                                                                        22455000
SUBROUTINE LOAD'STATUS;                                                 22460000
<<------------------->>                                                 22465000
    << MOVE STATUS REGISTER TO OUTPUT BUFFERS >>                        22470000
BEGIN                                                                   22475000
                                                                        22480000
MOVE BDYLN1B(52) := "MODE      =";                             <<84301>>22485000
IF STAREG.(0:1)=1                                                       22490000
  THEN MOVE BDYLN1B(64):="PRIV"                                         22495000
  ELSE MOVE BDYLN1B(64):="USER";                                        22500000
BDYLN1B(69) := "*";                                            <<84301>>22505000
                                                                        22510000
MOVE BDYLN2B(52) := "INTERRUPTS=";                             <<84301>>22515000
ON'OFF(BDYLN2B(64),STAREG.(1:1));                                       22520000
BDYLN2B(69) := "*";                                            <<84301>>22525000
                                                                        22530000
MOVE BDYLN3B(52) := "TRAPS     =";                             <<84301>>22535000
ON'OFF(BDYLN3B(64),STAREG.(2:1));                                       22540000
BDYLN3B(69) := "*";                                            <<84301>>22545000
                                                                        22550000
MOVE BDYLN4B(52) := "STACK OP  =";                             <<84301>>22555000
IF STAREG.(3:1)=1                                                       22560000
  THEN MOVE BDYLN4B(64):="RGHT"                                         22565000
  ELSE MOVE BDYLN4B(64):="LEFT";                                        22570000
BDYLN4B(69) := "*";                                            <<84301>>22575000
                                                                        22580000
MOVE BDYLN5B(52) := "OVERFLOW  =";                             <<84301>>22585000
ON'OFF(BDYLN5B(64),STAREG.(4:1));                                       22590000
BDYLN5B(69) := "*";                                            <<84301>>22595000
                                                                        22600000
MOVE BDYLN6B(52) := "CARRY     =";                             <<84301>>22605000
ON'OFF(BDYLN6B(64),STAREG.(5:1));                                       22610000
BDYLN6B(69) := "*";                                            <<84301>>22615000
                                                                        22620000
MOVE BDYLN7B(52) := "COND CODE =";                             <<84301>>22625000
CASE STAREG.(6:2) OF                                                    22630000
    BEGIN                                                               22635000
 << 0 >> MOVE BDYLN7B(64):="CCG";                                       22640000
 << 1 >> MOVE BDYLN7B(64):="CCL";                                       22645000
 << 2 >> MOVE BDYLN7B(64):="CCE";                                       22650000
    END;  << CASE >>                                                    22655000
BDYLN7B(69) := "*";                                            <<84301>>22660000
                                                                        22665000
MOVE BDYLN8B(52) := "SEGMENT # =";                             <<84301>>22670000
LOADNUMP(BDYLN8B(64-3),SEG);                                            22675000
BDYLN8B(69) := "*";                                            <<84301>>22680000
                                                                        22685000
END; << SUBROUTINE LOAD'STATUS >>                                       22690000
                                                                        22695000
                                                                        22700000
SUBROUTINE PRNT'REGS'TABLE;                                             22705000
<<---------------------->>                                              22710000
   << PRINTS REGISTER TABLE >>                                          22715000
BEGIN                                                                   22720000
                                                                        22725000
<< CLEAR OUT BUFFER >>                                                  22730000
BUF:=" ";                                                      <<84301>>22735000
MOVE BUF(1):=BUF,(69);                                                  22740000
                                                                        22745000
<< PRINT TABLE HEADINGS >>                                              22750000
MOVE BUF:="*****   REGISTERS   *****", 2;                      <<84301>>22755000
DUMMY := TOS - @BUF;                                           <<84301>>22760000
FWRITE (PRNTFILE, LBUF, -DUMMY, %60);                          <<84301>>22765000
                                                                        22770000
BUF:=" ";                                                      <<84301>>22775000
MOVE BUF(1):=BUF,(69);                                                  22780000
                                                                        22785000
MOVE BUF(54):="** SERIES ";                                             22790000
MOVE BUF(64):=SERIESBUF(0),(3);                                         22795000
MOVE BUF(67):=" **";                                                    22800000
FWRITE(PRNTFILE,LBUF,-70,%60);                                          22805000
                                                                        22810000
<< PRINT THE TABLE >>                                                   22815000
FWRITE(PRNTFILE,OUTLN,-70,%40);                                         22820000
FWRITE(PRNTFILE,HEAD,-70,%40);                                          22825000
FWRITE(PRNTFILE,OUTLN,-70,%40);                                         22830000
FWRITE(PRNTFILE,BDYLN1,-70,%40);                                        22835000
FWRITE(PRNTFILE,BDYLN2,-70,%40);                                        22840000
FWRITE(PRNTFILE,BDYLN3,-70,%40);                                        22845000
FWRITE(PRNTFILE,BDYLN4,-70,%40);                                        22850000
FWRITE(PRNTFILE,BDYLN5,-70,%40);                                        22855000
FWRITE(PRNTFILE,BDYLN6,-70,%40);                                        22860000
FWRITE(PRNTFILE,BDYLN7,-70,%40);                                        22865000
FWRITE(PRNTFILE,BDYLN8,-70,%40);                                        22870000
FWRITE(PRNTFILE,OUTLN,-70,%60);                                         22875000
                                                                        22880000
<< CLEAR BUFFER >>                                                      22885000
BUF:=" ";                                                      <<84301>>22890000
MOVE BUF(1):=BUF,(69);                                                  22895000
                                                                        22900000
<< PRINT A COMMENT CONCERNING THE SHOWN VALUES OF REGS. >>              22905000
MOVE BUF(6):="# - SIGNIFIES THAT VALUE SHOWN IS DIFFERENT", 2; <<84301>>22910000
DUMMY := TOS - @BUF;                                           <<84301>>22915000
FWRITE (PRNTFILE, LBUF, -DUMMY, %40);                          <<84301>>22920000
                                                                        22925000
BUF:=" ";                                                      <<84301>>22930000
MOVE BUF(1):=BUF,(69);                                                  22935000
                                                                        22940000
MOVE BUF(10) := "FROM ORIGINAL VALUE OF REGISTER.", 2;         <<84301>>22945000
DUMMY := TOS - @BUF;                                           <<84301>>22950000
FWRITE (PRNTFILE, LBUF, -DUMMY, %60);                          <<84301>>22955000
                                                                        22960000
END; <<SUBROUTINE PRNT'REGS'TABLE >>                                    22965000
                                                                        22970000
SUBROUTINE FMT'FLM;                                                     22975000
<<--------------->>                                                     22980000
   << FORMATS AND PRINTS THE FIRST %11 WORDS OF FIXED >>                22985000
   << LOW MEMORY.                                     >>                22990000
BEGIN                                                                   22995000
                                                                        23000000
DUMMY:=CORE(0D);  <<use CORE to load COREBUF, used frequently>>         23005000
                                                                        23010000
<< LINE 1 (BLANK) >>                                                    23015000
BUF:=" ";                                                      <<84301>>23020000
MOVE BUF(1):=BUF,(69);                                                  23025000
FWRITE (PRNTFILE, LBUF, 0, %40);                               <<84301>>23030000
                                                                        23035000
<< LINE 2 >>                                                            23040000
BUF:=" ";                                                      <<84301>>23045000
MOVE BUF(1):=BUF,(69);                                                  23050000
MOVE BUF := "***** FIXED LOW MEMORY *****", 2;                 <<84301>>23055000
DUMMY := TOS - @BUF;                                           <<84301>>23060000
FWRITE (PRNTFILE, LBUF, -DUMMY, %40);                          <<84301>>23065000
                                                                        23070000
                                                                        23075000
<< LINE 3 >>                                                            23080000
BUF := " ";                                                    <<84301>>23085000
MOVE BUF(1) := BUF, (69);                                      <<84301>>23090000
MOVE BUF(2) := "(@% 0) CST  PTR";                              <<84301>>23095000
ASCII(COREBUF(0),8,BUF(24));                                            23100000
MOVE BUF(37) := "(@% 5) ICS QI";                               <<84301>>23105000
ASCII(COREBUF(5),8,BUF(64));                                            23110000
FWRITE(PRNTFILE,LBUF,-70,%40);                                          23115000
                                                                        23120000
<< LINE 4 >>                                                            23125000
BUF := " ";                                                    <<84301>>23130000
MOVE BUF(1) := BUF, (69);                                      <<84301>>23135000
MOVE BUF(2) := "(@% 1) XCST PTR";                              <<84301>>23140000
ASCII(COREBUF(1),8,BUF(24));                                            23145000
MOVE BUF(37) := "(@% 6) ICS ZI";                               <<84301>>23150000
ASCII(COREBUF(6),8,BUF(64));                                            23155000
FWRITE(PRNTFILE,LBUF,-70,%40);                                          23160000
                                                                        23165000
<< LINE 5 >>                                                            23170000
BUF := " ";                                                    <<84301>>23175000
MOVE BUF(1) := BUF, (69);                                      <<84301>>23180000
MOVE BUF(2) := "(@% 2) DST  PTR";                              <<84301>>23185000
ASCII(COREBUF(2),8,BUF(24));                                            23190000
MOVE BUF(37) := "(@% 7) INTERRUPT MASK";                       <<84301>>23195000
ASCII(COREBUF(7),8,BUF(64));                                            23200000
FWRITE(PRNTFILE,LBUF,-70,%40);                                          23205000
                                                                        23210000
<< LINE 6 >>                                                            23215000
BUF := " ";                                                    <<84301>>23220000
MOVE BUF(1) := BUF, (69);                                      <<84301>>23225000
MOVE BUF(2) := "(@% 3)";                                       <<84301>>23230000
ASCII(COREBUF(3),8,BUF(24));                                            23235000
MOVE BUF(37) := "(@%10) DRT BANK";                             <<84301>>23240000
ASCII(COREBUF(%10),8,BUF(64));                                          23245000
FWRITE(PRNTFILE,LBUF,-70,%40);                                          23250000
                                                                        23255000
<< LINE 7 >>                                                            23260000
BUF := " ";                                                    <<84301>>23265000
MOVE BUF(1) := BUF, (69);                                      <<84301>>23270000
MOVE BUF(2) := "(@% 4) CPCB IDX";                              <<84301>>23275000
ASCII(COREBUF(4),8,BUF(24));                                            23280000
MOVE BUF(37) := "(@%11) DRT ADDR";                             <<84301>>23285000
ASCII(COREBUF(%11),8,BUF(64));                                          23290000
FWRITE(PRNTFILE,LBUF,-70,%40);                                          23295000
                                                                        23300000
END;  << SUBROUTINE FMT'FLM >>                                          23305000
                                                                        23310000
                                                                        23315000
<<---------------------->>                                              23320000
<< MAINLINE FOR FMTREGS >>                                              23325000
<<---------------------->>                                              23330000
                                                                        23335000
INIT'BUFFERS;  << INITIALIZE SPECIFIC BUFFERS >>                        23340000
                                                                        23345000
LOAD'DATASEG;  << PREPARE DATA REGS FOR PRINTING >>                     23350000
                                                                        23355000
LOAD'CODESEG;  << PREPARE CODE REGS. FOR PRINTING >>                    23360000
                                                                        23365000
LOAD'MISCREGS; << PREPARE OTHER REGS. FOR PRINTING >>                   23370000
                                                                        23375000
LOAD'STATUS;   << PREPARE STATUS FOR PRINTING >>                        23380000
                                                                        23385000
PRNT'REGS'TABLE;<< PRINT REGISTER TABLE >>                              23390000
                                                                        23395000
FMT'FLM;        << PRINTS 1ST 9 WORDS OF FIXED LOW MEMORY >>            23400000
                                                                        23405000
END; << FMTREGS >>                                                      23410000
$PAGE "                       PROCEDURE PUTNUM"                         23415000
                                                                        23420000
<<             PUT NUMBER                                         >>    23425000
<<    THIS PROCEDURE CONVERTS A NUMBER INTO AN ASCII              >>    23430000
<<    REPRESENTATION OF OCTAL AND STORES IT INTO THE PRINT BUFFER >>    23435000
<<    AT THE CURRENT POINTER AND ADVANCES THE POINTER.            >>    23440000
<<    THE NUMBER ALWAYS OCCUPIES A SEVEN POSITION FIELD WITH A    >>    23445000
<<    TRAILING BLANK.  PUTNUM DOES NOT SUPPRESS LEADING ZEROS.    >>    23450000
<<    PUTNUMP SUPPRESSES LEADING ZEROS AND DOES NOT ALTER THE     >>    23455000
<<    LOCATIONS WHERE THEY WOULD HAVE BEEN PUT.  THE NUMBERS ARE  >>    23460000
<<    RIGHT JUSTIFIED IN THE FIELD (EXCEPT FOR THE TRAILING BLANKS>>    23465000
<<                                                                >>    23470000
PROCEDURE PUTNUM(NUM);                                                  23475000
      VALUE NUM; INTEGER NUM;                                           23480000
      BEGIN                                                             23485000
         INTEGER I:=5;                                                  23490000
         LOGICAL FLAG:=FALSE;                                           23495000
         ENTRY PUTNUMP;                                                 23500000
         FLAG:=TRUE;                                                    23505000
PUTNUMP:                                                                23510000
        TOS:=NUM;                                                       23515000
        TOS:=TOS&CSL(1);                                                23520000
        TOS:=S0.(15:1);                                                 23525000
LOOP:                                                                   23530000
        IF <> OR FLAG OR I=0 THEN BEGIN                                 23535000
           PBUF:=TOS+"0";                                               23540000
           FLAG:=TRUE;                                                  23545000
        END ELSE BEGIN                                                  23550000
           DEL; END;                                                    23555000
        @PBUF:=@PBUF+1;                                                 23560000
        I:=I-1;                                                         23565000
        IF < THEN BEGIN                                                 23570000
           PBUF:=" ";                                                   23575000
           @PBUF:=@PBUF+1;                                              23580000
           RETURN; END;                                                 23585000
        TOS:=TOS&CSL(3);                                                23590000
        TOS:=S0.(13:3);                                                 23595000
        GO LOOP;                                                        23600000
     END;  << PROCEDURE PUTNUM >>                                       23605000
$PAGE "                  PROCEDURE SET'REG"                             23610000
<<**********************************************>>                      23615000
<<  SET'REG                                     >>                      23620000
<<---------------------------------------------->>                      23625000
<< SETS REGISTER TO SPECIFIED VALUE OR RESETS   >>                      23630000
<< ONE OR ALL REGS. TO ORIGINAL VALUE           >>                      23635000
<<**********************************************>>                      23640000
PROCEDURE SET'REG(PARMSTRING);                                          23645000
  BYTE ARRAY PARMSTRING;                                                23650000
BEGIN                                                                   23655000
  << ALLOWS DB,DL,Q,S,Z,&PB REGISTERS (AND RESPECTIVE >>                23660000
  << BANKS) TO BE SET TO ANY VALUE.  A COMMAND WITHOUT>>                23665000
  << AN ADDRESS SETS THE REGISTER BACK TO ITS VALUE AT>>                23670000
  << TIME OF DUMP.                                    >>                23675000
                                                                        23680000
  << THIS PROCEDURE ASSUMES THE EXISTENCE OF THE FOLLOW->>              23685000
  <<ING GLOBAL VARIABLES:                               >>              23690000
  <<   PROCEDURE PRINTERROR              CR             >>              23695000
  <<   ALL REGISTERS AND "SAVE" REGISTERS               >>              23700000
                                                                        23705000
EQUATE MAXPARMS = 2;                                                    23710000
                                                                        23715000
EQUATE SET'DB     = 0,                                                  23720000
       SET'DL     = 1,                                                  23725000
       SET'Q      = 2,                                                  23730000
       SET'S      = 3,                                                  23735000
       SET'Z      = 4,                                                  23740000
       SET'PB     = 5,                                                  23745000
       SET'ALL    = 6,                                                  23750000
       INVALID    = 7;                                                  23755000
                                                                        23760000
DEFINE LENGTH = INFOWORD.(0:8)#;                                        23765000
                                                                        23770000
BYTE ARRAY DELIMITERS(0:1);                                             23775000
                                                                        23780000
BYTE ARRAY TEMP(0:9);                                                   23785000
                                                                        23790000
BYTE POINTER STRING;                                                    23795000
                                                                        23800000
INTEGER NUMPARMS,REG'OPTION;                                            23805000
                                                                        23810000
LOGICAL INFOWORD,BANK,BASE;                                             23815000
                                                                        23820000
DOUBLE ARRAY PARMS(0:MAXPARMS);                                         23825000
                                                                        23830000
                                                                        23835000
SUBROUTINE SET'BASE(PARM);                                              23840000
<<--------------------------->>                                         23845000
VALUE PARM;                                                             23850000
DOUBLE PARM;                                                            23855000
<< SET ADDRESS OF REGISTER SPECIFIED >>                                 23860000
BEGIN                                                                   23865000
<< POINT STRING TO ACTUAL PARAMETER >>                                  23870000
   TOS:=PARM;                                                           23875000
   INFOWORD:=TOS;                                                       23880000
   @STRING:=TOS;                                                        23885000
                                                                        23890000
   IF STRING=CR THEN << NOTHING SPECIFIED >>                            23895000
      BEGIN                                                             23900000
      PRINTERROR(12);                                                   23905000
      GO EXIT'PROC;                                                     23910000
      END                                                               23915000
   ELSE << MOVE NEW ADDRESS TO REGISTER >>                              23920000
   BEGIN                                                                23925000
      IF STRING(0)="#" THEN << DECIMAL NUMBERED ENTERED >>              23930000
      BASE:=BINARY(STRING(1),LENGTH-1)                                  23935000
      ELSE                                                              23940000
         BEGIN                                                          23945000
         MOVE TEMP:=STRING(0),(LENGTH);                                 23950000
         MOVE STRING(1):=TEMP,(LENGTH);                                 23955000
         MOVE STRING(0):="%";<<NEEDED FOR BINARY INTRINSIC>>            23960000
         BASE:=BINARY(STRING,LENGTH+1);                                 23965000
         END;                                                           23970000
                                                                        23975000
      CASE REG'OPTION OF                                                23980000
         BEGIN                                                          23985000
         << DB >> DBREG:=BASE;                                          23990000
         << DL >> DLREG:=BASE;                                          23995000
         << Q  >> QREG :=BASE;                                          24000000
         << S  >> SREG :=BASE;                                          24005000
         << Z  >> ZREG :=BASE;                                          24010000
         << PB >> PBREG:=BASE;                                          24015000
         END; << CASE >>                                                24020000
                                                                        24025000
   END;  << MOVE NEW ADDRESS TO REGISTER >>                             24030000
                                                                        24035000
END; << SUBROUTINE SET'BASE >>                                          24040000
                                                                        24045000
<<  MAIN BODY OF SET'REG >>                                             24050000
                                                                        24055000
<< SET UP TO PARSE THE PARAMETERS >>                                    24060000
DELIMITERS(0):="=";                                                     24065000
DELIMITERS(1):=CR;                                                      24070000
MYCOMMAND(PARMSTRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);               24075000
  IF <> THEN                                                            24080000
    BEGIN                                                               24085000
    PRINTERROR(0);                                                      24090000
    RETURN;                                                             24095000
    END;                                                                24100000
                                                                        24105000
IF NOT (0<=NUMPARMS<=2) THEN                                            24110000
  BEGIN                                                                 24115000
  PRINTERROR(7);                                                        24120000
  RETURN;                                                               24125000
  END;                                                                  24130000
                                                                        24135000
IF NUMPARMS = 0 THEN RETURN; << NOTHING SPECIFIED >>                    24140000
                                                                        24145000
<< PUT FIRST PARAMETER ON STACK >>                                      24150000
TOS:=PARMS(0);                                                          24155000
INFOWORD:=TOS;                                                          24160000
@STRING:=TOS;                                                           24165000
                                                                        24170000
<< DETERMINE THE REGISTER THAT NEEDS TO BE CHANGED.>>                   24175000
REG'OPTION:=                                                            24180000
          IF STRING = "DB"     THEN SET'DB                              24185000
          ELSE                                                          24190000
          IF STRING = "DL"     THEN SET'DL                              24195000
          ELSE                                                          24200000
          IF STRING = "Q"      THEN SET'Q                               24205000
          ELSE                                                          24210000
          IF STRING = "S"      THEN SET'S                               24215000
          ELSE                                                          24220000
          IF STRING = "Z"      THEN SET'Z                               24225000
          ELSE                                                          24230000
          IF STRING = "PB"     THEN SET'PB                              24235000
          ELSE                                                          24240000
          IF STRING = "ALL"    THEN SET'ALL                             24245000
          ELSE                                                          24250000
          INVALID;                                                      24255000
                                                                        24260000
<< INVALID REGISTER >>                                                  24265000
IF REG'OPTION = INVALID THEN                                            24270000
  BEGIN                                                                 24275000
  PRINTERROR(28);                                                       24280000
  RETURN;                                                               24285000
  END;                                                                  24290000
                                                                        24295000
IF NUMPARMS = 1 THEN  << RESET OPTION >>                                24300000
  BEGIN  << REPLACE REG. WITH ORIGINAL VALUE >>                         24305000
  CASE  REG'OPTION  OF                                                  24310000
    BEGIN                                                               24315000
    << DB >> BEGIN                                                      24320000
             DBBANKREG:=SVDBBANK;                                       24325000
             DBREG:=SVDBREG;                                            24330000
             END;                                                       24335000
    << DL >> BEGIN                                                      24340000
             DLREG:=SVDLREG;                                            24345000
             ZBANKREG:=SVSBANK;                                         24350000
             END;                                                       24355000
    << Q  >> BEGIN                                                      24360000
             QREG:=SVQREG;                                              24365000
             ZBANKREG:=SVSBANK;                                         24370000
             END;                                                       24375000
    << S  >> BEGIN                                                      24380000
             SREG:=SVSREG;                                              24385000
             ZBANKREG:=SVSBANK;                                         24390000
             END;                                                       24395000
    << Z  >> BEGIN                                                      24400000
             ZREG:=SVZREG;                                              24405000
             ZBANKREG:=SVSBANK;                                         24410000
             END;                                                       24415000
    << PB >> BEGIN                                                      24420000
             PBBANKREG:=SVPBBANK;                                       24425000
             PBREG:=SVPBREG;                                            24430000
             END;                                                       24435000
    << ALL>> BEGIN                                                      24440000
             DBBANKREG:=SVDBBANK;                                       24445000
             DBREG:=SVDBREG;                                            24450000
             DLREG:=SVDLREG;                                            24455000
             QREG:=SVQREG;                                              24460000
             SREG:=SVSREG;                                              24465000
             ZREG:=SVZREG;                                              24470000
             ZBANKREG:=SVSBANK;                                         24475000
             PBBANKREG:=SVPBBANK;                                       24480000
             PBREG:=SVPBREG;                                            24485000
             END;                                                       24490000
    END; << CASE >>                                                     24495000
                                                                        24500000
    EXIT'PROC:  RETURN;                                                 24505000
  END  << NUMBER OF PARMS = 1 (RESET OPTION) >>                         24510000
                                                                        24515000
ELSE  << SET REG. OR REG. AND BANK TO NEW ADDRESS >>                    24520000
  BEGIN                                                                 24525000
                                                                        24530000
  << LOAD REST OF PARMS >>                                              24535000
  TOS:=PARMS(1);                                                        24540000
  INFOWORD:=TOS;                                                        24545000
  @STRING:=TOS;                                                         24550000
                                                                        24555000
  STRING(LENGTH):=CR; << NEEDED FOR MYCOMMAND >>                        24560000
                                                                        24565000
  << SET UP TO PARSE PARAMETER >>                                       24570000
  DELIMITERS(0):=",";                                                   24575000
  DELIMITERS(1):=CR;                                                    24580000
  MYCOMMAND(STRING,DELIMITERS,MAXPARMS,NUMPARMS,PARMS);                 24585000
    IF <> THEN                                                          24590000
      BEGIN                                                             24595000
      PRINTERROR(0);                                                    24600000
      RETURN;                                                           24605000
      END;                                                              24610000
                                                                        24615000
  IF NOT (0<=NUMPARMS<=2)  THEN                                         24620000
    BEGIN                                                               24625000
    PRINTERROR(7);                                                      24630000
    RETURN;                                                             24635000
    END;                                                                24640000
                                                                        24645000
  IF NUMPARMS = 1 THEN  << CHANGE ONLY REG, NOT BANK >>                 24650000
    BEGIN                                                               24655000
    SET'BASE(PARMS(0));                                                 24660000
    RETURN;                                                             24665000
    END;                                                                24670000
                                                                        24675000
  << NUMBER OF PARMS MUST BE 2 >>                                       24680000
  SET'BASE(PARMS(1));  << CHANGE REGISTER >>                            24685000
                                                                        24690000
  << LOAD PARM CONTAINING BANK >>                                       24695000
   TOS:=PARMS(0);                                                       24700000
   INFOWORD:=TOS;                                                       24705000
   @STRING:=TOS;                                                        24710000
   IF STRING(0)="#" THEN << DECIMAL NUMBER ENTERED >>                   24715000
      BASE:=BINARY(STRING(1),LENGTH-1)                                  24720000
   ELSE                                                                 24725000
      BEGIN                                                             24730000
      MOVE TEMP:=STRING,(LENGTH);                                       24735000
      MOVE STRING(1):=TEMP,(LENGTH);                                    24740000
      MOVE STRING(0):="%"; << NEEDED FOR THE BINARY INTRINSIC >>        24745000
      BANK:=BINARY(STRING,LENGTH+1)                                     24750000
      END;                                                              24755000
                                                                        24760000
   CASE REG'OPTION OF   << CHANGE REG BANK>>                            24765000
   BEGIN                                                                24770000
   << DB  >> DBBANKREG:=BANK;                                           24775000
   << DL  >> ZBANKREG:=BANK;                                            24780000
   << Q   >> ZBANKREG:=BANK;                                            24785000
   << S   >> ZBANKREG:=BANK;                                            24790000
   << Z   >> ZBANKREG:=BANK;                                            24795000
   << PB  >> PBBANKREG:=BANK;                                           24800000
   END; << CASE >>                                                      24805000
                                                                        24810000
  END;  << SETTING REGISTER TO NEW VALUE >>                             24815000
                                                                        24820000
END;  << PROCEDURE SET'REG >>                                           24825000
$PAGE "                     OUTER BLOCK"                                24830000
                                                                        24835000
<<*********************************************>>                       24840000
<<  OUTER BLOCK                                >>                       24845000
<<*********************************************>>                       24850000
                                                                        24855000
WELCOME; << SEND MESSAGE TO USER >>                                     24860000
INIT;   << INITIALIZE >>                                                24865000
CI;    << COMMAND INTERPRETOR >>                                        24870000
                                                                        24875000
END.                                                                    24880000
