<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$CONTROL CODE,MAP,NOWARN,LIST,USLINIT                          <<02012>>00001000
<< HP3000 SERIES II/III DUMP ANALYZER >>                                00003000
<< HP32002C MPE SOURCE C.00.00 >>                              << WBT >>00005000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00007000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00009000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00011000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00013000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00015000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00017000
$CONTROL MAIN=DPAN4                                            << WBT >>00019000
$CONTROL SEGMENT=INIT                                                   00021000
<< HP32002C MPE SOURCE C.00.00 >>                              << WBT >>00023000
COMMENT                                                                 00025000
MODULE DPAN                                                             00027000
                                                                        00029000
Product Information                                                     00031000
   Product name, mnemonic, project number                               00033000
      DPAN, DN,                                                         00035000
   Project abstract                                                     00037000
      Format raw memory dumps to facilitate analysis of 3000 problems   00039000
   Project personnel                                                    00041000
      MPE kernel/startup                                                00043000
                                                                        00045000
General Design Overview                                                 00047000
   Design approach and Major modules                                    00049000
                                                                        00051000
                              DPAN4                                     00053000
                                |                                       00055000
                           PROCESSDUMP                                  00057000
                                |                                       00059000
       +------------------------+---------------------------+           00061000
   initialize           formatted tables            formatted memory    00063000
   TAPETODISK               PRINTAVAIL                PRINTMEMORY       00065000
   VERIFYTBL                    .                       FILLMEMBUF      00067000
   FIXPCBSTACK                  .                       SORTMEMBUF      00069000
   CATEGORIZE'DST               .                       PRINTMEMLOCS    00071000
                            PRINTXCST                   DUMPMEM         00073000
                                                                        00075000
   There are 3 main parts to DPAN: initializing, table formatting,      00077000
   and memory formatting.  The main routine, DPAN4, calls               00079000
   PROCESS'DUMP, which in turn calls routines for these 3 parts.        00081000
   PROCESS'DUMP also handles the PARM values which may be passed in,    00083000
   and selectively calls the routines in the latter two parts.          00085000
                                                                        00087000
   Initialization                                                       00089000
      Initialization is done with 4 routines. TAPE'TO'DISK copies the   00091000
      files from the dump tape into temporary files, for later use.     00093000
      VERIFYTBL computes and verifies the base addresses for several    00095000
      system tables and initializes some global variables accordingly.  00097000
      FIXPCBSTACK also initializes some variables.  CATEGORIZEDST fills 00099000
      up the global array DST'TYPE, which describes each data segment.  00101000
                                                                        00103000
   Table Formatting                                                     00105000
      Table formatting means the detailed formatting of specific system 00107000
      tables.  In general, each routine handles a specific, resident    00109000
      system table.  As yet, all the system tables are not formatted so 00111000
      elaborately.  There are 19 of these routines, ranging from        00113000
      PRINTAVAIL to PRINTXCST.                                          00115000
                                                                        00117000
   Memory Formatting                                                    00119000
      Memory formatting is driven by the PRINTMEMORY routine.  This     00121000
      routine loops over the desired banks, and sequentially dumps a    00123000
      half-formatted octal dump of each segment.  Four principal rou-   00125000
      tines are used to do so.  FILLMEMBUF creates 4 word records which 00127000
      describe the entries in the bank, putting them in the array       00129000
      MEMBUF.  It does this by checking through the CST, DST, and       00131000
      available area tables for segments in the current bank.  SORT-    00133000
      MEMBUF sorts these entries into ascending memory order.  PRINT-   00135000
      MEMLOCS uses MEMBUF to print the preview page which comes before  00137000
      each bank and summarizes what is in the next bank to be printed.  00139000
      Lastly, DUMPMEM calls routines (OCTALDUMP, CSTENTRY, DSTENTRY) to 00141000
      produce the actual dump of each segment described by MEMBUF.      00143000
                                                                        00145000
   Major data structures                                                00147000
      The principal structures are MEMBUF and DST'TYPE                  00149000
                                                                        00151000
   Overall flow of data and control                                     00153000
      Described above                                                   00155000
                                                                        00157000
   Performance considerations                                           00159000
      The basic approach to performance, with the recent resegmentation,00161000
      was to locate the 101 procedures in as few large code segments as 00163000
      possible.  The main segments, INIT, TABLES, MEMORY, and UTIL      00165000
      correspond with the design overview above.  This should minimize  00167000
      segment faults.                                                   00169000
      As for use of DPAN, it is often helpful to use the minidump option00171000
      or the interactive dialogue to list only the needed dump parts,   00173000
      in light of the cost of (EPOC) paper and machine loads.           00175000
                                                                        00177000
Module Implementation                                                   00179000
                                                                        00181000
   Here are descriptions of the utility routines available in DPAN:     00183000
                                                                        00185000
   CHECKSTACK(DSTNO)                                                    00187000
      Verify that the given DST is a stack and print its markers (if ok)00189000
      and its PCBX.  Can be followed by a call to FORMATSTACK.          00191000
                                                                        00193000
   CORE(ADR)                                                            00195000
      Input is doubleword ADR value.  Finds and returns as a logical    00197000
      value the contents of this location in the core image of the dump 00199000
      being analyzed.  Prints error message if invalid address.         00201000
   DCORE(ADR)                                                           00203000
      Like core, but returns a doubleword.                              00205000
   SYSGLOB(ADR)                                                         00207000
      Like core, but adds %1000 to ADR.                                 00209000
                                                                        00211000
   DCONS(HI,LO)                                                         00213000
      Glues HI and LO together and returns them as a doubleword         00215000
                                                                        00217000
   DSTTOADDR(DSTNO)                                                     00219000
      Input is logical DST number.  Looks up starting address of this   00221000
      data segment, and returns it as a doubleword bank+address.        00223000
                                                                        00225000
   ERROR                                                                00227000
      Calls intrinsic TERMINATE.                                        00229000
                                                                        00231000
   NAMECST(CSTENTRY)                                                    00233000
      Looks up the name of CSTENTRY in LOADMAP.PUB.SYS                  00235000
      and returns 17 bytes worth of it to where @PBUF points.           00237000
      @PBUF is advanced.  Nothing done if LOADMAP not accessable.       00239000
   NAMEDST                                                              00241000
      Uses global variable MBENTNO to return the names of system        00243000
      data segments into PBUF at @PBUF.                                 00245000
   NAMEPROC(SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL)                           00247000
      Uses MPEPMAP to look up the segment name and offset of a proc.    00249000
      However, maintaining this MPEPMAP is rare and this DPAN           00251000
      feature has fallen into disuse.  It might be easier to use        00253000
      the system SL, since this is always there.                        00255000
                                                                        00257000
   OCTALDUMP(STADR,ENADR,TABLEBASE)                                     00259000
      All input parameters are doubleword, passed by value.  The last   00261000
      parameter is optional.  Prints a nice, two column formatted octal 00263000
      dump of the core between STADR and ENADR.  Checks for duplicate   00265000
      memory locations and prints a message whenever one is found.      00267000
      If global flag CHARFLAG is true, also prints the ASCII            00269000
      translation of the line of core.                                  00271000
   SKIPOCTALDUMP                                                        00273000
      Parallels OCTALDUMP, but prints a message stating that the range  00275000
      of addresses has been skipped.                                    00277000
                                                                        00279000
   ONFREELIST(TABLEBASE,INDEX)                                          00281000
      Given standard table base, scan through free list to see if       00283000
      index is present on free list.                                    00285000
                                                                        00287000
                                                                        00289000
   Printing utilities                                                   00291000
      There are several printing utilities available in DPAN.  Since    00293000
      DPAN uses these to keep track of the page numbers for the headers 00295000
      and the index, it is important for any new code to follow these   00297000
      conventions.  Global variables PAGENO, LINECOUNT, and LNSPERPG    00299000
      are all maintainted. @PBUF points to output buffer PBUF.          00301000
                                                                        00303000
   NEWPAGE skips to a new page, increments the page number, etc.        00305000
   PRINTLINE writes DBUFFER to (printer file) LPF.                      00307000
      Entry point BLANKBUF fills PBUF with blanks.                      00309000
   PUTCHAR(WORD) puts a pair of characters (1 word) into PBUF           00311000
      and advances @PBUF.                                               00313000
   PUTDNUM(P)(DNUM) is like PUTNUM, but for double variables.           00315000
   PUTNUM(P)(NUM) converts an integer number to ASCII, and writes it    00317000
      to @PBUF.  The number occupies a field of 7.  PUTNUM does         00319000
      not suppress leading zeroes, PUTNUMP does.                        00321000
   PUTNZ(NUM,COL) Puts NUM at COL in PBUF if NUM<>0.                    00323000
   SKIPLINES(NLINES) will skip lines.                                   00325000
                                                                        00327000
Global Data Structure Implementation                                    00329000
   Overall data structure relations                                     00331000
      Narrative                                                         00333000
      Maps of linkages                                                  00335000
                                                                        00337000
   DPAN Global variables                                                00339000
   (for each data structure)                                            00341000
   Data structure name                                                  00343000
      Purpose                                                           00345000
      Creation and dispostion                                           00347000
      Access methods                                                    00349000
      Users                                                             00351000
      Data layout and description                                       00353000
      Storage management                                                00355000
      Subordinate data structures                                       00357000
                                                                        00359000
   CHARFLAG used by OCTALDUMP for optional translation to ASCII.        00361000
   DBUFFER(0:100) is the printed output buffer                          00363000
   DSTADDR bases of DST, CST, and PCB tables.                           00365000
   DST'TYPE is used by CATEGORIZE'DST to classify all data segments.    00367000
   MBTYPE, MBENTNO, MBBANK, MBADDR are used by FILLMEMBUF and           00369000
      DUMPMEM to work with the MEMBUF array.                            00371000
   NUM'RESPONSES number of flags set in INTERACTIVE'DIALOG.             00373000
   PBUF is a byte array equivalenced to DBUFFER                         00375000
   PRINT'BANK(0:MAXIMUM'BANKS) do we want to print this bank?           00377000
   RESPONSES (see INTERACTIVE'DIALOG) flags whether certain parts       00379000
      of the dump are wanted.                                           00381000
                                                                        00383000
                                                                        00385000
Fix History                                                             00387000
   12/17/82                                                             00389000
      Installation of comment templates, split of source modules to     00391000
      share responsibility with other groups, resegmentation.           00393000
                                                                        00395000
Quality                                                                 00397000
      DPAN needs much more in-code documentation, particularly with     00399000
   global variables.                                                    00401000
      Implicit passing of global variables should be eliminated as      00403000
   much as possible.                                                    00405000
      As Stan Sieler's new variable XREF indicates, there are           00407000
   numerous variables in DPAN which are declared, but never             00409000
   used.  These should not simply be removed, but examined,             00411000
   since each may point to a nearby flaw in the code.                   00413000
      TOS is used too much.                                             00415000
      FILLMEMBUF should be completely revamped -- this could lead to    00417000
   a significant simplification of DUMPMEM.                             00419000
                                                                        00421000
;                                                                       00423000
      BEGIN                                                             00425000
                                                               <<03013>>00427000
DOUBLE DRT'TABLE'ADDRESS;   <<USUALLY A COPY OF DRTBANK/ADDR>> <<03013>>00429000
       <<TAKEN FROM FIXED CELLS %10, %11.  IF THESE VALUES>>   <<03013>>00431000
       <<ARE INVALID, THEN WE USE DEFAULT VALUES OF 0-0 >>     <<03013>>00433000
                                                               <<03013>>00435000
 INTRINSIC MYCOMMAND, ASCII;                                   <<04701>>00437000
 DEFINE DUPLICATIVE = (JSM.(14:1))#;                           <<01114>>00439000
 DEFINE SYSGLOB'EXT = CORE(DOUBLE(SYSBASE+%377)) + SYSBASE#,   << WBT >>00441000
        MITVERNO    = DOUBLE(SYSGLOB'EXT + %76)#,              <<01114>>00443000
        MITUPNO     = DOUBLE(SYSGLOB'EXT + %74)#,              <<01114>>00445000
        MITFNO      = DOUBLE(SYSGLOB'EXT + %75)#;              <<01114>>00447000
         LOGICAL NOPRFLAG:=FALSE;  <<SUPPRESS PRINT OFF>>      <<00221>>00449000
         DEFINE CSTBLK=CORE(DOUBLE(SYSBASE+%51))+SYSBASE#;     << WBT >>00451000
         EQUATE CSTB=0,CSTB'=1,DSTB=2,CPCB=4,PCBB=3;                    00453000
         EQUATE CSTMAXENT=%277,CSTMAXENT'=%77,CSTSIZE=4;                00455000
         EQUATE DSTMAXENT=512,DSTSIZE=4,SYSBASE=%1000;         << WBT >>00457000
         EQUATE CCG=0,CCL=1,CCE=2;                             <<01.02>>00459000
         EQUATE LSTSYSDST = %73;  << LAST SYS DST # >>         <<03556>>00461000
         EQUATE SERIES2=0,SERIES3=1;                           <<2M.HM>>00463000
         LOGICAL CSTBAD:=FALSE,CSTBAD':=TRUE,DSTBAD:=FALSE;             00465000
      LOGICAL ARRAY BAD'DST(0:2) := FALSE,FALSE,FALSE;         <<01080>>00467000
         INTEGER PARM=Q-4;                                     <<01.02>>00469000
         INTEGER STATUS=Q-1;                                   <<01.02>>00471000
         LOGICAL CSTFLG:=0;                                    <<01.02>>00473000
DOUBLE CST'ADDRESS, DST'ADDRESS, PCB'ADDR;                     << WBT >>00475000
         LOGICAL DSTFLG:=0;                                    <<01.02>>00477000
         LOGICAL SERIES:=0;                                    <<01.3A>>00479000
         LOGICAL PCBFLG:=0;                                    <<01.02>>00481000
         LOGICAL GLOBPARM:=0;                                  <<01.02>>00483000
         LOGICAL DSTLENGTH:=%077777;     <<LENGTH OF DST>>     <<00221>>00485000
         LOGICAL CHARFLAG,BNKFLG:=FALSE;                       <<01114>>00487000
         LOGICAL STACKFLAG,MARKERS'OK;                         <<00221>>00489000
         LOGICAL PRTNPRT:=FALSE;     <<FLAG FOR NOPRINT ENTRY>><<03084>>00491000
         DOUBLE STACKMARKER;    <<POINTER TO TOP MARKER>>      <<00221>>00493000
         DOUBLE STACKSREG;      <<S REGISTER FOR STACK>>       <<00221>>00495000
         DOUBLE STARTADR;       <<SAVED TOP OF STACK>>         <<00221>>00497000
         ENTRY EIGHTLPI;     <<8 LINES PER INCH FORMATTED>>    <<00221>>00499000
         ENTRY NOPRINT;      <<TO APPEND LOADMAP AND MPECHECK>><<03084>>00501000
         LOGICAL SVPAPER:=TRUE;                                <<00.01>>00503000
         LOGICAL GLOBTEMP:=TRUE;                               << WBT >>00505000
  INTEGER MAXDUMPBANK;                                         <<00221>>00507000
         ARRAY REGSAVE(0:30)=DB;  <<REGISTERS>>                         00509000
         LOGICAL REG0=REGSAVE+0,                                        00511000
                 REG1=REGSAVE+1,                                        00513000
                 REG2=REGSAVE+2,                                        00515000
                 REG3=REGSAVE+3,                                        00517000
                 REG4=REGSAVE+4,                                        00519000
                 REG5=REGSAVE+5,                                        00521000
                 REG7=REGSAVE+6,                                        00523000
                 XREG=REGSAVE+7,                                        00525000
                 DLREG=REGSAVE+8,                                       00527000
                 DBBANKREG=REGSAVE+9,                                   00529000
                 DBREG=REGSAVE+10,                                      00531000
                 QREG=REGSAVE+11,                                       00533000
                 SREG=REGSAVE+12,                                       00535000
                 ZBANKREG=REGSAVE+13,                                   00537000
                 ZREG=REGSAVE+14,                                       00539000
                 STAREG=REGSAVE+15,                                     00541000
                 PBBANKREG=REGSAVE+16,                                  00543000
                 PBREG=REGSAVE+17,                                      00545000
                 PREG=REGSAVE+18,                                       00547000
                 PLREG=REGSAVE+19,                                      00549000
                 CIRREG=REGSAVE+20,                                     00551000
                 CPX1=REGSAVE+21,                                       00553000
                 CPX2=REGSAVE+22,                                       00555000
                 REG6=REGSAVE+23,                                       00557000
                 MEMSIZE=REGSAVE+24,                                    00559000
                 NIR=REGSAVE+25,                               <<00.01>>00561000
                 SP1=REGSAVE+26,                               <<00.01>>00563000
                 SP2=REGSAVE+27,                               <<00.01>>00565000
                 ISR=REGSAVE+28,                               <<00.01>>00567000
                 BANKNO,SVBANK,                                         00569000
                 PAGENO;     <<PAGE NUMBER>>                            00571000
         ARRAY VCST(0:11):=                                    <<01.3A>>00573000
            0,   <<PROGEN>>                                    <<01.3A>>00575000
            0,   <<UCOP>>                                      <<01.3A>>00577000
            0,   <<DEVREC>>                                    <<01.3A>>00579000
            0,   <<MESSAGE>>                                   <<01.3A>>00581000
            0,   <<LOG>>                                       <<01.3A>>00583000
            0,   <<LOAD>>                                      <<01.3A>>00585000
            0,   <<MEMLOGP>>                                   <<01.3A>>00587000
            0,   <<PCREATE>>                                   <<01.3A>>00589000
            0,   <<MORGUE>>                                    <<01.3A>>00591000
            0,   <<CIINIT>>                                    <<01.3A>>00593000
            0,   <<TRACE1'>>                                   <<01.3A>>00595000
            0;   <<SPOOLING>>                                  <<01.3A>>00597000
                 ARRAY DBUFFER(0:100);   <<PRINT BUFFER>>               00599000
                 ARRAY TBUF(0:75);                                      00601000
                 BYTE ARRAY STRING(*)=TBUF(37);                         00603000
                 BYTE ARRAY BBUF(*)=DBUFFER;                            00605000
                 BYTE ARRAY PSTRING(*)=DBUFFER(64);                     00607000
                 BYTE ARRAY BSTRING(*)=DBUFFER(58);                     00609000
BYTE ARRAY MOUNTNEXTVOLUME(0:17):="MOUNT NEXT VOLUME ";        <<00221>>00611000
BYTE ARRAY IMPROPERVOLUME (0:15):="IMPROPER VOLUME ";          <<00221>>00613000
LOGICAL ARRAY MNV(*) = MOUNTNEXTVOLUME;                        <<00221>>00615000
LOGICAL ARRAY IMPV(*) = IMPROPERVOLUME;                        <<00221>>00617000
         ARRAY indxaray (0:2*(lstsysdst+4));                   <<03556>>00619000
LOGICAL DITFPG, DITNFPG;                                       <<02012>>00621000
                 ARRAY IOQIX(0:255);                                    00623000
                 ARRAY SIRPIN(*)=IOQIX;                        <<00221>>00625000
ARRAY PCBSTACK(0:255);                                         << WBT >>00627000
ARRAY ISFREEPCB(0:255):=256(FALSE);                            <<01791>>00629000
                 INTEGER X=X,S0=S-0,S1=S-1,S2=S-2,S3=S-3;               00631000
                 INTEGER S4=S-4,S5=S-5,S6=S-6,S7=S-7;                   00633000
                 BYTE POINTER PBUF:=@BBUF;                              00635000
                 ARRAY SCRBUF(0:100);                                   00637000
                 ARRAY MEMBUF(0:4800);                                  00639000
                 POINTER MEMBUFP:=@MEMBUF;                              00641000
DEFINE                                                         << WBT >>00643000
       CHECKMEMBUF=IF @MEMBUFP>(@MEMBUF+4780) THEN             << WBT >>00645000
                      MEMBUFOFL#,                              << WBT >>00647000
       MBTYPE     =MEMBUFP.(0:4)#,                             << WBT >>00649000
       MBENTNO    =MEMBUFP.(4:12)#,                            << WBT >>00651000
       MBBANK     =MEMBUFP(1)#,                                << WBT >>00653000
       MBADDR     =MEMBUFP(2)#,                                << WBT >>00655000
       MBCSTXNDX  =MEMBUFP(3)#;                                << WBT >>00657000
                 ARRAY COREBUF(0:4095);                                 00659000
BYTE ARRAY BCOREBUF(*)=COREBUF;                                <<03083>>00661000
LOGICAL FILE'REQUIRED;                                         <<03083>>00663000
ARRAY CHECKBUF(0:23);                                          <<03083>>00665000
BYTE ARRAY BCHECKBUF(*)=CHECKBUF;                              <<03083>>00667000
INTEGER CPUMACHINECODE;                                        <<03083>>00669000
EQUATE  MAX'DSTNUM = 1023;                                     <<04284>>00671000
BYTE ARRAY DST'TYPE(0:MAX'DSTNUM);                             <<04284>>00673000
DEFINE AFT03=CORE(AFTBASE-DOUBLE(INDX))#,                      <<03078>>00675000
       AFT02=CORE(AFTBASE-DOUBLE(INDX+1))#,                    <<03078>>00677000
       AFT01=CORE(AFTBASE-DOUBLE(INDX+2))#,                    <<03078>>00679000
       AFT00=CORE(AFTBASE-DOUBLE(INDX+3))#;                    <<03078>>00681000
                    LOGICAL ARRAY LCSTBLK(0:101):=101(%177777);<<01.02>>00683000
                    INTEGER ARRAY ICSTBLK(*)=LCSTBLK;          <<01.02>>00685000
                 DOUBLE LINKEDMEM; <<START OF LINKED MEM>>     <<WH.01>>00687000
DOUBLE MMPAGESIZE;     <<MEMORY MANAGER PAGE SIZE IN WORDS>>   << WBT >>00689000
DOUBLE SYSGLOBX;       <<START OF SYSGLOB EXTENSION>>          << WBT >>00691000
INTEGER RBTORSDISP,                                            <<CACHE>>00693000
        RBTOSRSDISP,                                           <<CACHE>>00695000
        RBTONLDISP,                                            <<CACHE>>00697000
        REGIONHSIZE,                                           <<CACHE>>00699000
        REGIONOHSIZE,                                          <<CACHE>>00701000
        REG'DIFF;                                              <<CACHE>>00703000
LOGICAL CACHE'SYSTEM;                                          <<CACHE>>00705000
                 DOUBLE MAXMEM;                                         00707000
                 INTEGER MAXBANK=MAXMEM,BANKNUM;               <<00.01>>00709000
                 DOUBLE DBADR; <<DB ADDR FOR DSTS>>            <<01.3A>>00711000
                 DOUBLE VERNO:=%1116D;                                  00713000
                 DOUBLE UPNO:=%1114D;                                   00715000
                 DOUBLE FNO:=%1115D;                                    00717000
                                                               <<01543>>00719000
              DEFINE                                           <<01543>>00721000
                 SYSGLOBX'VER                                  <<01543>>00723000
                    = DOUBLE( CORE(%377D) + %76 ) #,           <<01543>>00725000
                 SYSGLOBX'UPD                                  <<01543>>00727000
                    = DOUBLE( CORE(%377D) + %74 ) #,           <<01543>>00729000
                 SYSGLOBX'FIX                                  <<01543>>00731000
                    = DOUBLE( CORE(%377D) + %75 ) #;           <<01543>>00733000
                                                               <<01543>>00735000
                 DOUBLE CSTABP:=0D;                                     00737000
                 DOUBLE CSTXTABP:=1D;                                   00739000
                 DOUBLE CHRONOS;                                        00741000
                 DOUBLE TRLB:=%1012D;                                   00743000
                 INTEGER COREF,LPF,NUMREC;                              00745000
                 BYTE ARRAY LEVEL(0:7):="        ";  <<*****>> <<04665>>00747000
                 BYTE ARRAY BCOPYRIT(0:131):=                  <<00221>>00749000
                 "(C) HEWLETT-PACKARD CO. 1980",104(" ");      <<01833>>00751000
                 ARRAY COPYRITE(*)=BCOPYRIT;                  <<<01.02>>00753000
                 ARRAY LVL(*)=LEVEL;                          <<<01.02>>00755000
                 BYTE ARRAY NAM(0:9):=                        <<<01.02>>00757000
                 "DPAN4 VER.";                                 << WBT >>00759000
                 ARRAY DPN4(*)=NAM;                            << WBT >>00761000
                 BYTE ARRAY DPANIN(0:6):="MDUMP  ";            <<00.01>>00763000
                 BYTE ARRAY TAPE(0:4):="TAPE ";                <<00.01>>00765000
                 EQUATE MAGTAPE=24,SERDISC=%37;                <<00.01>>00767000
         BYTE ARRAY COREDUMP(0:20):="MDUMP          TAPE ";    <<00221>>00769000
                 BYTE ARRAY DISC(0:1):="1.";                            00771000
                 DEFINE ASB=ASSEMBLE#;                                  00773000
                 BYTE ARRAY LPN(0:9):="DPANLIST  ";                     00775000
                 BYTE ARRAY LPND(0:3):="LP  ";                          00777000
         BYTE ARRAY LOADMAP(0:15):="LOADMAP.PUB.SYS ";         <<01.3A>>00779000
                 LOGICAL LMAPFNUM:=0; <<LOAD MAP FILE NUMBER>> <<00221>>00781000
         BYTE ARRAY MAPNAME(0:16):="MPECHECK.PUB.SYS ";        <<MS.00>>00783000
                 LOGICAL PMAPFILE:=0; <<PMAP FILE NUMBER>>     <<00221>>00785000
                 LOGICAL ARRAY MPEMIT2N(0:17):=                <<00221>>00787000
                    "MPEMIT2.PUB.SYS ";                        <<00221>>00789000
                 LOGICAL MPEMIT2:=0;   <<MPEMIT2 FNUM>>        <<00221>>00791000
                 LOGICAL MPEFCODE;                             <<00221>>00793000
                 LOGICAL ARRAY PROCINDEX(0:195):=196(%177777); <<00221>>00795000
                    <<INDEXED BY CST, POINTER INTO PMAP FILE>> <<00221>>00797000
                 LOGICAL SAME'SYSTEM:=TRUE;   <<TILL SITE ID>> <<00221>>00799000
                 INTEGER LNSPERPG:=58;  <<LINES PER PAGE>>     <<00221>>00801000
DEFINE LDFNUM=LMAPFNUM#;  << FOR GSD RECODE >>                 <<00221>>00803000
DEFINE SAME'SYS=SAME'SYSTEM#; << FOR GSD RECODE >>             <<00221>>00805000
                 INTRINSIC FOPEN,FCLOSE,FREAD,FWRITE,FREADDIR,          00807000
                 WHO,PAUSE,READX,TERMINATE,ARITRAP;            <<03079>>00809000
                 INTRINSIC FWRITEDIR,FCONTROL,PRINT,ASCII,DASCII;       00811000
                 INTRINSIC FGETINFO,GETPRIVMODE,GETUSERMODE;   <<00.01>>00813000
INTRINSIC FSPACE,FCHECK,QUIT;                                  <<03083>>00815000
INTRINSIC FPOINT,BINARY;                                       <<MS.00>>00817000
                 INTEGER PAGE:=1;                                       00819000
                 INTEGER LINECOUNT:=0;                                  00821000
                 INTEGER CLOCK,CALENDAR,CDSTN,DSTNB,MACHINEID; <<00.01>>00823000
                 ARRAY COMPBUFF(0:15);                                  00825000
                 BYTE ARRAY CB(*)=COMPBUFF;                             00827000
                 ARRAY COMPBUFF2(0:15);                                 00829000
                 BYTE ARRAY CB2(*)=COMPBUFF2;                           00831000
    LOGICAL MSWAPS:=0;          <<NUMBER OF SWAPS COUNTER>>    <<00221>>00833000
    DOUBLE MFETCH:=0D;          <<NUMBER OF FETCHES>>          <<00221>>00835000
    LOGICAL MACTAG:=0;          <<ACTIVITY TAG>>               <<00221>>00837000
    BYTE ARRAY MSWLIN(0:49):="DPANSWAP",42(" ");               <<00221>>00839000
    LOGICAL ARRAY LMSWLIN(*)=MSWLIN;                           <<00221>>00841000
    LOGICAL DPANSWAP:=0;        <<DPAN SWAP FILE>>             <<00221>>00843000
    DOUBLE ARRAY DSTADDR(1:LSTSYSDST):=LSTSYSDST(0D);          <<00221>>00845000
    DOUBLE ARRAY DSTDEFIN(*)=DSTADDR(2);  <<DEFINE DST BASE>>  <<00221>>00847000
    DOUBLE ARRAY CSTDEFIN(*)=DSTADDR(1);  <<DEFINE CST BASE>>  <<00221>>00849000
    DOUBLE ARRAY PCBDEFIN(*)=DSTADDR(3);  <<DEFINE PCB BASE>>  <<00221>>00851000
    LOGICAL ARRAY DSTDEF(1:LSTSYSDST):=LSTSYSDST(0);           <<00221>>00853000
                 DEFINE SEGK=STAREG.(8:8)#;                             00855000
                DEFINE CC=STATUS.(6:2)#;                       <<01.02>>00857000
          EQUATE OLDSERIESII  = 0,                             <<00.01>>00859000
                 MODEL35      = 1,     << SERIES 3  >>         <<01377>>00861000
                 MODEL25      = 2,     << SERIES 33 >>         <<01377>>00863000
                 MODEL44      = 3,     << SERIES 44 >>         <<01296>>00865000
                 ICF55        = 4,     << SERIES 55 >>         <<04665>>00867000
                 VUFF'COL     = 0;     << OFFSET FOR VUF>>     <<04665>>00869000
                                                               <<01377>>00871000
          DEFINE SERIES'33'THRU'55                             <<01377>>00873000
             = ( MACHINEID=MODEL25 LOR MACHINEID=MODEL44       <<01296>>00875000
                 LOR MACHINEID=ICF55 ) #;                      <<01377>>00877000
                                                               <<01377>>00879000
                                                               <<01377>>00881000
<< Since the ILT format changed some time ago, we need to>>    <<03752>>00883000
<< check for this, even though it is unlikely old formats>>    <<03752>>00885000
<< will ever be processed. Thus we check word 0 of the   >>    <<03752>>00887000
<< ILT. In the old format, bits (8:8) held the DRT number>>    <<03752>>00889000
<< while in the new format word 0 is a CPVA word which   >>    <<03752>>00891000
<< would not usually contain a value exactly equal to the>>    <<03752>>00893000
<< DRT number of the host ILT. If this again becomes a   >>    <<03752>>00895000
<< problem, this define could  be changed to '( TRUE )', >>    <<03752>>00897000
<< after which only new ILT's will be processed.         >>    <<03752>>00899000
                                                               <<03752>>00901000
       DEFINE NEW'ILT'FORMAT =                                 <<03752>>00903000
        (INTEGER(CORE(LOCILT).(8:8)) <> DRTNO)#;               <<03752>>00905000
                                                               <<03752>>00907000
<<* * * MACHINE CONTEXT * * *>>                                <<00.01>>00909000
                                                               <<00.01>>00911000
DEFINE                                                         <<00.01>>00913000
   CNMACHINEID        = COREBUF(%1400).(8:8) #,                <<01172>>00915000
                                                               <<00.01>>00917000
<<MODEL 35>>                                                   <<00.01>>00919000
   CNSTARFISH         = COREBUF(%1400).(0:8) #,                <<02519>>00921000
   M35CONTENTS24      = COREBUF(%1401)       #,                <<00.01>>00923000
   M35SMREG           = COREBUF(%1402)       #,                <<00.01>>00925000
   M35SP1REG          = COREBUF(%1403)       #,                <<00.01>>00927000
   M35SP2REG          = COREBUF(%1404)       #,                <<00.01>>00929000
   M35DBREG           = COREBUF(%1405)       #,                <<00.01>>00931000
   M35DBANKREG        = COREBUF(%1406).(0:4) #,                <<00.01>>00933000
   M35PBANKREG        = COREBUF(%1406).(4:4) #,                <<00.01>>00935000
   M35SBANKREG        = COREBUF(%1406).(12:4)#,                <<00.01>>00937000
   M35ZREG            = COREBUF(%1407)       #,                <<00.01>>00939000
   M35DLREG           = COREBUF(%1410)       #,                <<00.01>>00941000
   M35XREG            = COREBUF(%1411)       #,                <<00.01>>00943000
   M35QREG            = COREBUF(%1412)       #,                <<00.01>>00945000
   M35CIREG           = COREBUF(%1413)       #,                <<00.01>>00947000
   M35PBREG           = COREBUF(%1414)       #,                <<00.01>>00949000
   M35PLREG           = COREBUF(%1415)       #,                <<00.01>>00951000
   M35PREG            = COREBUF(%1416)       #,                <<00.01>>00953000
   M35CPX1            = COREBUF(%1417)       #,                <<00.01>>00955000
   M35STATUSREG       = COREBUF(%1420)       #,                <<00.01>>00957000
   M35CPX2            = COREBUF(%1421).(0:8) #,                <<00.01>>00959000
   M35NUMBANKS        = COREBUF(%1421).(8:8) #,                <<00.01>>00961000
   CNDRT0             = COREBUF(%1422)       #,                <<02519>>00963000
   CNDRT1             = COREBUF(%1423)       #,                <<02519>>00965000
   CNDRT2             = COREBUF(%1424)       #,                <<02519>>00967000
   CNDRT3             = COREBUF(%1425)       #,                <<02519>>00969000
                                                               <<00.01>>00971000
                                                               <<00.01>>00973000
<<MODEL 25  AND  MODEL ICF/55>>                                <<03013>>00975000
   M25DUMPDEVICEDRT   = COREBUF(%1401)       #,                <<00.01>>00977000
   M25XREG            = COREBUF(%1402)       #,                <<00.01>>00979000
   M25DLREG           = COREBUF(%1403)       #,                <<00.01>>00981000
   M25DBANKREG        = COREBUF(%1404)       #,                <<00.01>>00983000
   M25DBREG           = COREBUF(%1405)       #,                <<00.01>>00985000
   M25QREG            = COREBUF(%1406)       #,                <<00.01>>00987000
   M25SREG            = COREBUF(%1407)       #,                <<00.01>>00989000
   M25SBANKREG        = COREBUF(%1410)       #,                <<00.01>>00991000
   M25ZREG            = COREBUF(%1411)       #,                <<00.01>>00993000
   M25STATUSREG       = COREBUF(%1412)       #,                <<00.01>>00995000
   M25PBANKREG        = COREBUF(%1413)       #,                <<00.01>>00997000
   M25PBREG           = COREBUF(%1414)       #,                <<00.01>>00999000
   M25PREG            = COREBUF(%1415)       #,                <<00.01>>01001000
   M25PLREG           = COREBUF(%1416)       #,                <<00.01>>01003000
   M25CIREG           = COREBUF(%1417)       #,                <<00.01>>01005000
   M25NUMPHYSICALBANKS= COREBUF(%1420)       #,                <<00.01>>01007000
   M25NIRREG          = COREBUF(%1421)       #,                <<00.01>>01009000
   M55NIRREG          = COREBUF(%1515)       #,                <<03013>>01011000
   M25ISR             = COREBUF(%1422)       #,                <<00.01>>01013000
   M25NUMBANKS        = COREBUF(%1423)       #,                <<03013>>01015000
   M55CPX1            = COREBUF(%1421)       #,                <<03013>>01017000
   M55CPX2            = COREBUF(%1422)       #;                <<03013>>01019000
 EQUATE NUM'RESPONSES = 29;                                             01021000
 LOGICAL ARRAY RESPONSES(0:NUM'RESPONSES-1):=                  <<01114>>01023000
          NUM'RESPONSES(TRUE);                                 <<01114>>01025000
 DEFINE PRINT'REGISTERS    = RESPONSES    #,                   <<01114>>01027000
        PRINT'CST          = RESPONSES(1) #,                   <<01114>>01029000
        PRINT'DST          = RESPONSES(2) #,                   <<01114>>01031000
        PRINT'PCB          = RESPONSES(3) #,                   <<01114>>01033000
        PRINT'STACKS       = RESPONSES(4) #,                   <<01114>>01035000
        PRINT'AVAIL        = RESPONSES(5) #,                   << WBT >>01037000
        PRINT'DRQT         = RESPONSES(6) #,                   << WBT >>01039000
        PRINT'VDSL         = RESPONSES(7) #,                   <<01114>>01041000
        PRINT'VDSM         = RESPONSES(8) #,                   <<01114>>01043000
        PRINT'DRT          = RESPONSES(9) #,                   <<01114>>01045000
        PRINT'ILT          = RESPONSES(10)#,                   <<01114>>01047000
        PRINT'LPDT         = RESPONSES(11)#,                   <<01114>>01049000
        PRINT'DIT          = RESPONSES(12)#,                   <<01114>>01051000
        PRINT'IOQ          = RESPONSES(13)#,                   <<01114>>01053000
        PRINT'SBUF         = RESPONSES(14)#,                   <<01114>>01055000
        PRINT'TBUF         = RESPONSES(15)#,                   <<01114>>01057000
        PRINT'TRL          = RESPONSES(16)#,                   <<01114>>01059000
        PRINT'SIR          = RESPONSES(17)#,                   <<01114>>01061000
        PRINT'MON          = RESPONSES(18)#,                   <<01114>>01063000
        PRINT'MEMORY       = RESPONSES(19)#,                   <<01114>>01065000
        FORMAT'MEMORY      = RESPONSES(20)#,                   <<01114>>01067000
        CODE'SEGMENTS      = RESPONSES(21)#,                   <<01114>>01069000
        FREE'AREAS         = RESPONSES(22)#,                   <<01114>>01071000
        PRINT'INDEX        = RESPONSES(23)#,                   << WBT >>01073000
        PRINT'SLL          = RESPONSES(24)#,                   <<03076>>01075000
        PRINT'ICS          = RESPONSES(25)#,                   <<03076>>01077000
        MINI'DUMP          = RESPONSES(26)#,                            01079000
        PRINT'CACHE        = RESPONSES(27)#,                            01081000
        CACHED'REGIONS     = RESPONSES(28)#;                            01083000
 EQUATE MAXIMUM'BANKS = 64;                                    <<01114>>01085000
 LOGICAL ARRAY PRINT'BANK(0:MAXIMUM'BANKS-1):=                 <<01114>>01087000
          MAXIMUM'BANKS(FALSE);                                <<01114>>01089000
 LOGICAL JSM;                                                  <<01114>>01091000
                                                                        01093000
DEFINE                                                         << WBT >>01095000
PCB00=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+00))#,                   << WBT >>01097000
PCB01=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+01))#,                   << WBT >>01099000
PCB02=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+02))#,                   << WBT >>01101000
PCB03=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+03))#,                   << WBT >>01103000
PCB04=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+04))#,                   << WBT >>01105000
PCB05=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+05))#,                   << WBT >>01107000
PCB06=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+06))#,                   << WBT >>01109000
PCB07=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+07))#,                   << WBT >>01111000
PCB08=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+08))#,                   << WBT >>01113000
PCB09=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+09))#,                   << WBT >>01115000
PCB10=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+10))#,                   << WBT >>01117000
PCB11=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+11))#,                   << WBT >>01119000
PCB12=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+12))#,                   << WBT >>01121000
PCB13=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+13))#,                   << WBT >>01123000
PCB14=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+14))#,                   << WBT >>01125000
PCB15=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+15))#;                   << WBT >>01127000
                                                               << WBT >>01129000
EQUATE                                                         << WBT >>01131000
SEGIDDATATYPE = 0,                                             << WBT >>01133000
SEGIDSLTYPE   = 1;  << PROGRAM TYPE = 2 OR 3 >>                << WBT >>01135000
DEFINE                                                         << WBT >>01137000
SEGIDTYPEFIELD    = (0:2)#,                                    << WBT >>01139000
SEGIDPBXFLAG      = (0:1)#,                                    << WBT >>01141000
SEGIDPBXFIELD     = (1:7)#,                                    << WBT >>01143000
SEGIDLOGSEGFIELD  = (8:8)#;                                    << WBT >>01145000
                                                               << WBT >>01147000
DEFINE                                                         <<01791>>01149000
                                                               <<01791>>01151000
NUMCONFIG   = CORE(TABLEBASE)#,                                <<01791>>01153000
NUMFREE     = CORE(TABLEBASE+2D)#,                             <<01791>>01155000
FIRSTFREEX  = CORE(TABLEBASE+3D)#,                             <<01791>>01157000
NEXTFREEX   = CORE(TABLEBASE+DOUBLE(FREEX+1))#;                <<01791>>01159000
                                                               <<01791>>01161000
                                                               <<01791>>01163000
INTRINSIC PRINTOP;                                                      01165000
                                                               <<04665>>01167000
$INCLUDE INCLVUF                                               <<04665>>01169000
                                                               <<04665>>01171000
PROCEDURE PRINT'FILE'INFO(FN);                                          01173000
      VALUE FN;                                                         01175000
      INTEGER FN;                                                       01177000
      OPTION EXTERNAL;                                                  01179000
                                                                        01181000
INTEGER PROCEDURE THISCPU;                                     <<HM.02>>01183000
OPTION EXTERNAL;                                               <<HM.02>>01185000
                                                                        01187000
                                                                        01189000
PROCEDURE BLANKBUF;                                                     01191000
      OPTION FORWARD;                                                   01193000
                                                                        01195000
 LOGICAL PROCEDURE GTCSTIDX;                                   <<01.3A>>01197000
      OPTION FORWARD;                                          <<01.3A>>01199000
                                                               <<01.3A>>01201000
PROCEDURE CHKLDMAP;                                            <<01.3A>>01203000
      OPTION FORWARD;                                          <<01.3A>>01205000
                                                               <<01.3A>>01207000
PROCEDURE CHECKSTACK(DSTNO);                                   <<03076>>01209000
VALUE DSTNO;                                                   <<03076>>01211000
LOGICAL DSTNO;                                                 <<03076>>01213000
      OPTION FORWARD;                                                   01215000
                                                                        01217000
                                                                        01219000
PROCEDURE ERROR;                                                        01221000
      OPTION FORWARD;                                                   01223000
                                                                        01225000
                                                                        01227000
PROCEDURE FORMATFCB(DSTNO);                                    <<03076>>01229000
VALUE DSTNO;                                                   <<03076>>01231000
LOGICAL DSTNO;                                                 <<03076>>01233000
OPTION FORWARD;                                                <<03076>>01235000
                                                               <<03077>>01237000
PROCEDURE GETDATE;                                                      01239000
      OPTION FORWARD;                                                   01241000
                                                                        01243000
LOGICAL PROCEDURE CORE(ADR);                                  <<<01.02>>01245000
      VALUE ADR;                                                        01247000
      DOUBLE ADR;                                                       01249000
      OPTION FORWARD;                                                   01251000
                                                                        01253000
PROCEDURE MEMBUFOFL;                                           << WBT >>01255000
   OPTION FORWARD;                                             << WBT >>01257000
                                                               << WBT >>01259000
LOGICAL PROCEDURE NAMECST(ENT);                                <<01.3A>>01261000
       VALUE ENT; LOGICAL ENT;                                 <<01.3A>>01263000
       OPTION FORWARD;                                         <<01.3A>>01265000
                                                               <<01.3A>>01267000
PROCEDURE NAMEPROC(A,B,C,D,E);                                 <<00221>>01269000
VALUE A,B,C,D,E;                                               <<00221>>01271000
LOGICAL A,B;                                                   <<00221>>01273000
INTEGER C,D,E;                                                 <<00221>>01275000
OPTION FORWARD;                                                <<00221>>01277000
                                                               <<00221>>01279000
PROCEDURE NAMEDST;                                                      01281000
      OPTION FORWARD;                                                   01283000
                                                                        01285000
                                                                        01287000
PROCEDURE NEWPAGE;                                                      01289000
      OPTION FORWARD;                                                   01291000
                                                               <<01791>>01293000
PROCEDURE MAKEFREEMAP(TABLEBASE, MAP, ENTRYSIZE, MAXENTNO,     <<01875>>01295000
                      TABLENAME);                              <<01875>>01297000
VALUE ENTRYSIZE, MAXENTNO; INTEGER ENTRYSIZE, MAXENTNO;        <<01791>>01299000
DOUBLE TABLEBASE; ARRAY MAP; BYTE ARRAY TABLENAME;             <<01875>>01301000
OPTION FORWARD;                                                <<01791>>01303000
                                                               <<01791>>01305000
                                                               << WBT >>01307000
LOGICAL PROCEDURE ONFREELIST(TABLEBASE, INDEX);                << WBT >>01309000
VALUE TABLEBASE, INDEX;                                        << WBT >>01311000
DOUBLE TABLEBASE; LOGICAL INDEX;                               << WBT >>01313000
OPTION FORWARD;                                                << WBT >>01315000
                                                                        01317000
PROCEDURE PCHEAD;                                                       01319000
      OPTION FORWARD;                                                   01321000
                                                                        01323000
PROCEDURE PDHEAD;                                                       01325000
      OPTION FORWARD;                                                   01327000
                                                                        01329000
PROCEDURE PFXMEM;                                                       01331000
      OPTION FORWARD;                                                   01333000
                                                                        01335000
PROCEDURE PHEAD1;                                                       01337000
      OPTION FORWARD;                                                   01339000
                                                                        01341000
PROCEDURE PHEAD2;                                                       01343000
      OPTION FORWARD;                                                   01345000
                                                                        01347000
PROCEDURE PIOQHEAD;                                                     01349000
      OPTION FORWARD;                                                   01351000
PROCEDURE PRINTICS;                                            <<03080>>01353000
      OPTION FORWARD;                                          <<03080>>01355000
                                                               <<03080>>01357000
                                                                        01359000
PROCEDURE PRINTLINE;                                                    01361000
      OPTION FORWARD;                                                   01363000
                                                                        01365000
PROCEDURE PRINTLPDT;                                                    01367000
      OPTION FORWARD;                                                   01369000
                                                                        01371000
PROCEDURE PRINTCST;                                                     01373000
      OPTION FORWARD;                                                   01375000
                                                                        01377000
                                                                        01379000
PROCEDURE PRINTSIR;                                                     01381000
      OPTION FORWARD;                                                   01383000
                                                                        01385000
                                                                        01387000
                                                                        01389000
PROCEDURE PRINTDIT;                                                     01391000
      OPTION FORWARD;                                                   01393000
                                                                        01395000
PROCEDURE PRINTDRT;                                                     01397000
      OPTION FORWARD;                                                   01399000
                                                                        01401000
PROCEDURE PRINTDST;                                                     01403000
      OPTION FORWARD;                                                   01405000
                                                               << WBT >>01407000
PROCEDURE PRINTFLAGS(F);                                       << WBT >>01409000
VALUE F; LOGICAL F;                                            << WBT >>01411000
OPTION FORWARD;                                                << WBT >>01413000
                                                                        01415000
PROCEDURE PRINTPCB;                                                     01417000
      OPTION FORWARD;                                                   01419000
                                                                        01421000
PROCEDURE PRINTINDEX;                                                   01423000
      OPTION FORWARD;                                                   01425000
                                                                        01427000
PROCEDURE PRINTILT;                                                     01429000
      OPTION FORWARD;                                                   01431000
                                                                        01433000
PROCEDURE PRINTNEWILT;                                         <<02012>>01435000
      OPTION FORWARD;                                          <<01296>>01437000
                                                               <<01296>>01439000
PROCEDURE PRINTIOQ;                                                     01441000
      OPTION FORWARD;                                                   01443000
                                                                        01445000
PROCEDURE PRINTMEMLOCS(BNK);                                   <<00221>>01447000
VALUE BNK;                                                     <<00221>>01449000
LOGICAL BNK;                                                   <<00221>>01451000
OPTION FORWARD;                                                <<00221>>01453000
                                                               <<00221>>01455000
                                                               <<00221>>01457000
PROCEDURE PRINTPXFILE(A,B);                                    <<00221>>01459000
VALUE A,B;                                                     <<00221>>01461000
LOGICAL A;                                                     <<00221>>01463000
DOUBLE B;                                                      <<00221>>01465000
OPTION FORWARD;                                                <<00221>>01467000
                                                               <<00221>>01469000
PROCEDURE PRINTREGS;                                                    01471000
      OPTION FORWARD;                                                   01473000
                                                                        01475000
PROCEDURE PRINTSBUF;                                                    01477000
      OPTION FORWARD;                                                   01479000
                                                               << WBT >>01481000
PROCEDURE PRINTSLL;                                            << WBT >>01483000
OPTION FORWARD;                                                << WBT >>01485000
                                                                        01487000
PROCEDURE PRINTSTACKS;                                         <<00221>>01489000
   OPTION FORWARD;                                             <<00221>>01491000
                                                                        01493000
PROCEDURE PRINTTBUF;                                                    01495000
      OPTION FORWARD;                                                   01497000
                                                                        01499000
PROCEDURE PRINTTRL;                                                     01501000
      OPTION FORWARD;                                                   01503000
                                                                        01505000
PROCEDURE PRINTVDSL;                                                    01507000
      OPTION FORWARD;                                                   01509000
                                                                        01511000
PROCEDURE PRINTVDSM;                                                    01513000
      OPTION FORWARD;                                                   01515000
                                                                        01517000
PROCEDURE PUTCHAR(WORD);                                       <<01.3A>>01519000
      VALUE WORD;                                              <<01.3A>>01521000
      LOGICAL WORD;                                            <<01.3A>>01523000
      OPTION FORWARD;                                          <<01.3A>>01525000
                                                               <<01.3A>>01527000
PROCEDURE PUTDNUM(DNUM);                                                01529000
      VALUE DNUM;                                                       01531000
      DOUBLE DNUM;                                                      01533000
      OPTION FORWARD;                                                   01535000
                                                                        01537000
PROCEDURE PUTDNUMP(DNUM);                                               01539000
      VALUE DNUM;                                                       01541000
      DOUBLE DNUM;                                                      01543000
      OPTION FORWARD;                                                   01545000
                                                                        01547000
PROCEDURE PUTNUM(NUM);                                                  01549000
      VALUE NUM;                                                        01551000
      INTEGER NUM;                                                      01553000
      OPTION FORWARD;                                                   01555000
                                                                        01557000
PROCEDURE PUTNUMP(NUM);                                                 01559000
      VALUE NUM;                                                        01561000
      INTEGER NUM;                                                      01563000
      OPTION FORWARD;                                                   01565000
                                                                        01567000
PROCEDURE PUTNZ(NUM, COL);                                     << WBT >>01569000
VALUE NUM, COL;                                                << WBT >>01571000
LOGICAL NUM;                                                   << WBT >>01573000
INTEGER COL;                                                   << WBT >>01575000
OPTION FORWARD;                                                << WBT >>01577000
                                                               << WBT >>01579000
PROCEDURE PUTSEGID(SEGID, COL);                                <<01791>>01581000
VALUE SEGID, COL; LOGICAL SEGID, COL;                          <<01791>>01583000
OPTION FORWARD;                                                <<01791>>01585000
                                                               <<01791>>01587000
PROCEDURE RECOVER'DATE(TBUF);                                  <<03083>>01589000
      ARRAY TBUF;                                              <<03083>>01591000
      OPTION FORWARD;                                          <<03083>>01593000
                                                               <<03083>>01595000
PROCEDURE SKIPLINES(NLINES);                                            01597000
      VALUE NLINES;                                                     01599000
      INTEGER NLINES;                                                   01601000
      OPTION FORWARD;                                                   01603000
                                                                        01605000
PROCEDURE SKIPOCTALDUMP(CURAD,NXT);                            <<01.3A>>01607000
      VALUE CURAD,NXT; DOUBLE CURAD,NXT;                       <<01.3A>>01609000
      OPTION FORWARD;                                          <<01.3A>>01611000
                                                               <<01.3A>>01613000
PROCEDURE SORTMEMBUF;                                                   01615000
      OPTION FORWARD;                                                   01617000
                                                               <<03083>>01619000
PROCEDURE TAPE'MODIFY'ERROR(MSGNUM,FILENUM);                   <<03083>>01621000
  VALUE MSGNUM;                                                <<03083>>01623000
  INTEGER MSGNUM,                                              <<03083>>01625000
          FILENUM;                                             <<03083>>01627000
  OPTION FORWARD;                                              <<03083>>01629000
                                                                        01631000
PROCEDURE TAPETODISK;                                                   01633000
      OPTION FORWARD;                                                   01635000
PROCEDURE VERIFYTBL;                                           <<00221>>01637000
OPTION FORWARD;                                                <<00221>>01639000
                                                               <<00221>>01641000
DOUBLE PROCEDURE VERIFYP(DSTNO,SYSDBP);                        <<01.02>>01643000
      VALUE DSTNO,SYSDBP;                                               01645000
      DOUBLE SYSDBP;                                                    01647000
      INTEGER DSTNO;                                                    01649000
      OPTION FORWARD;                                                   01651000
                                                              <<MRJE>>  01653000
PROCEDURE DO'MRJE'DITS;                                       <<MRJE>>  01655000
  OPTION FORWARD;                                             <<MRJE>>  01657000
                                                              <<MRJE>>  01659000
PROCEDURE DODSDIT( LDV, TYPE );                                <<01199>>01661000
VALUE LDV, TYPE;                                               <<01199>>01663000
INTEGER LDV, TYPE;                                             <<01199>>01665000
OPTION FORWARD;                                                <<01199>>01667000
                                                               <<01199>>01669000
PROCEDURE WARNING;                                             <<01.02>>01671000
OPTION FORWARD;                                                <<01.02>>01673000
                                                               <<01.02>>01675000
PROCEDURE NOFORMT';                                            <<00221>>01677000
OPTION FORWARD;                                                <<01.02>>01679000
                                                               <<01.02>>01681000
PROCEDURE FILCSTBLK;                                           <<01.02>>01683000
OPTION FORWARD;                                                <<01.02>>01685000
                                                               <<01.02>>01687000
PROCEDURE PRINTXCST;                                           <<01.02>>01689000
OPTION FORWARD;                                                <<01.02>>01691000
                                                               <<01.02>>01693000
PROCEDURE PCXHEAD;                                             <<01.02>>01695000
OPTION FORWARD;                                                <<01.02>>01697000
PROCEDURE CSTENTRY(CURAD,CKSUM,SKIP);                          <<03076>>01699000
DOUBLE CURAD;                                                  <<03076>>01701000
LOGICAL CKSUM;                                                 <<03076>>01703000
LOGICAL SKIP;                                                  <<03076>>01705000
OPTION FORWARD;                                                <<03076>>01707000
                                                               <<03076>>01709000
PROCEDURE DSTENTRY(DSTNO,SKIP);                                <<03076>>01711000
LOGICAL DSTNO;                                                 <<03076>>01713000
LOGICAL SKIP;                                                  <<03076>>01715000
OPTION FORWARD;                                                <<03076>>01717000
                                                               <<03076>>01719000
PROCEDURE FILLMEMBUF(BANKNUM);                                 <<03076>>01721000
VALUE BANKNUM;                                                 <<03076>>01723000
LOGICAL BANKNUM;                                               <<03076>>01725000
OPTION FORWARD;                                                <<03076>>01727000
PROCEDURE FORMATSTACK(DSTNO);                                  <<03076>>01729000
VALUE DSTNO;                                                   <<03076>>01731000
LOGICAL DSTNO;                                                 <<03076>>01733000
OPTION FORWARD;                                                <<03076>>01735000
                                                               <<03076>>01737000
DOUBLE PROCEDURE DSTTOADDR(DSTNO);                             <<03076>>01739000
VALUE DSTNO;                                                   <<03076>>01741000
LOGICAL DSTNO;                                                 <<03076>>01743000
OPTION FORWARD;                                                <<03076>>01745000
                                                                        01747000
PROCEDURE PRINT'OCTAL'DIT                                      <<03752>>01749000
   (DIT'START'ADDR, RELATIVE'INDEX, DIT'LENGTH);               <<03752>>01751000
      VALUE DIT'START'ADDR, RELATIVE'INDEX, DIT'LENGTH;        <<03752>>01753000
      DOUBLE DIT'START'ADDR;                                   <<03752>>01755000
      LOGICAL RELATIVE'INDEX;                                  <<03752>>01757000
      INTEGER DIT'LENGTH;                                      <<03752>>01759000
      OPTION FORWARD;                                          <<03752>>01761000
                                                               <<03752>>01763000
PROCEDURE TEST'DRT'INFO(MINDRT,MAXDRT,VALID'DRTS,PFLAG);                01765000
   VALUE PFLAG;                                                         01767000
   INTEGER MINDRT,MAXDRT;                                               01769000
   LOGICAL VALID'DRTS,PFLAG;                                            01771000
   OPTION FORWARD;                                                      01773000
                                                                        01775000
PROCEDURE PRINTDRQT;                                                    01777000
   OPTION FORWARD;                                                      01779000
                                                                        01781000
PROCEDURE SEARCH'CBTS(STACKADDR,DLREG,STACKDST);                        01783000
   DOUBLE DLREG,STACKADDR;                                              01785000
   LOGICAL STACKDST;                                                    01787000
   OPTION FORWARD;                                                      01789000
                                                                        01791000
PROCEDURE CURR'PROCESS(STACKADDR,DSTNO,LOCPCB,INDX,PCBSIZE);            01793000
   INTEGER INDX,PCBSIZE;                                                01795000
   DOUBLE STACKADDR,LOCPCB;                                             01797000
   LOGICAL DSTNO;                                                       01799000
   OPTION FORWARD;                                                      01801000
                                                                        01803000
PROCEDURE CATEGORIZE'DST;                                               01805000
   OPTION FORWARD;                                                      01807000
                                                                        01809000
PROCEDURE PRINT'DFS'DATA'SEG'LIST;                                      01811000
   OPTION FORWARD;                                                      01813000
                                                                        01815000
$PAGE "OCTALDUMP: Print formatted core dump data"                       01817000
$CONTROL SEGMENT=UTIL                                          <<01.3A>>01819000
PROCEDURE OCTALDUMP(STADR,ENADR,TABLEBASE);                    << WBT >>01821000
      VALUE STADR,ENADR,TABLEBASE;                             << WBT >>01823000
      DOUBLE STADR,ENADR,TABLEBASE;                            << WBT >>01825000
      OPTION VARIABLE;                                         << WBT >>01827000
                                                                        01829000
COMMENT                                                                 01831000
                                                                        01833000
Purpose:                                                                01835000
     this procedure will format and print octal data from "start"       01837000
     to "stop"  8x8 2 columns across.if 16 even contigious              01839000
     locations are duplicated more than once a duplication              01841000
     message is printed.                                                01843000
                                                                        01845000
Input parameters:                                                       01847000
                                                                        01849000
Output parameters:                                                      01851000
                                                                        01853000
Globals Referenced:                                                     01855000
                                                                        01857000
Globals Altered:                                                        01859000
                                                                        01861000
Data Structures:                                                        01863000
                                                                        01865000
Algorithm:                                                              01867000
                                                                        01869000
;                                                                       01871000
       BEGIN                                                            01873000
   ENTRY DUMPTABLE;                                            << WBT >>01875000
          DOUBLE LINESTART1,LINESTART2,LINEDUP;                         01877000
            INTEGER IX2,CWORD;                                <<<01.02>>01879000
            LOGICAL IX1,IX3;                                  <<<01.02>>01881000
          LOGICAL DUPLICATION;                                          01883000
         DOUBLE LINEBUMP,LINECT;                               <<01.3A>>01885000
         LOGICAL IX1S,IX1T;                                    <<01.3A>>01887000
   TABLEBASE:=0D;                                              << WBT >>01889000
DUMPTABLE:                                                     << WBT >>01891000
          IF ENADR > MAXMEM THEN ENADR:=MAXMEM;                         01893000
      IF ENADR < STADR THEN GO ENDUMP;     <<ALLOW ONE WORD>>  <<00221>>01895000
         IF CHARFLAG THEN <<CHECK FOR DUMP LIMITS>>            <<01.3A>>01897000
         BEGIN                                                 <<01.3A>>01899000
            LINEBUMP:=0D;<<PRINT ADDR FOR CHARS>>              <<01.3A>>01901000
            IX1S:=12;                                          <<01.3A>>01903000
            IX1T:=12;                                          <<01.3A>>01905000
            LINECT:=12D;                                       <<01.3A>>01907000
         END ELSE                                              <<01.3A>>01909000
         BEGIN                                                 <<01.3A>>01911000
            LINEBUMP:=8D;<<SET LIMITS FOR OCTAL>>              <<01.3A>>01913000
            IX1S:=8;                                           <<01.3A>>01915000
            IX1T:=16;                                          <<01.3A>>01917000
            LINECT:=16D;                                       <<01.3A>>01919000
         END;                                                  <<01.3A>>01921000
          LINESTART1:=STADR;                                            01923000
          IX2 := 0;                                                     01925000
TEST2:    IX1:=0;  @PBUF:=@BBUF;  DUPLICATION:=FALSE;                   01927000
                                                                        01929000
         LINESTART2:=LINESTART1+LINEBUMP;                      <<01.3A>>01931000
          TOS:=LINESTART1-TABLEBASE;                           << WBT >>01933000
          CWORD:=TOS;                                                   01935000
          DEL;                                                          01937000
          PUTNUM(CWORD);                                                01939000
          @PBUF:=@PBUF-1;                                               01941000
         IF CHARFLAG THEN  <<INCLUDE DB REL ADDRESS>>          <<01.3A>>01943000
         BEGIN                                                 <<01.3A>>01945000
              TOS:=(LINESTART1-STARTADR-DBADR);                <<00221>>01947000
            CWORD:=TOS; <<LOW ORDER 16 BITS>>                  <<01.3A>>01949000
            DEL;        <<HI ORDER 16 BITS>>                   <<01.3A>>01951000
            PBUF:="(";                                         <<01.3A>>01953000
            @PBUF:=@PBUF+1;                                    <<01.3A>>01955000
            PUTNUM(CWORD);<<DB REL ADDRESS>>                   <<01.3A>>01957000
            @PBUF:=@PBUF-1;                                    <<01.3A>>01959000
            MOVE PBUF:=")";                                    <<01.3A>>01961000
            @PBUF:=@PBUF+1;                                    <<01.3A>>01963000
         END;                                                  <<01.3A>>01965000
          PBUF:=":";                                                    01967000
          @PBUF:=@PBUF+2;                                               01969000
          DO                                                            01971000
             BEGIN                                                      01973000
                COMPBUFF(IX1):=CORE(LINESTART1+DOUBLE(IX1));            01975000
                PUTNUM(COMPBUFF(IX1));                                  01977000
                IX1:=IX1+1;                                             01979000
             IF (LINESTART1+DOUBLE(IX1))>ENADR THEN            <<01.3A>>01981000
             IF CHARFLAG THEN                                  <<01.3A>>01983000
                IX1:=IX1S <<ASCII CHARACTERS>>                 <<01.3A>>01985000
                ELSE GO PLINE;                                 <<01.3A>>01987000
             END                                                        01989000
       UNTIL IX1=IX1S;                                         <<01.3A>>01991000
       @PBUF:=@BBUF+9+INTEGER(IX1S)*7;                         <<01.3A>>01993000
       IF CHARFLAG THEN <<DOING CHARACTERS>>                   <<01.3A>>01995000
       BEGIN                                                   <<01.3A>>01997000
          @PBUF:=@PBUF+8;                                      <<01.3A>>01999000
          IX1:=0;<<START OVER FOR CHARS>>                      <<01.3A>>02001000
       END;                                                    <<01.3A>>02003000
          TOS:=LINESTART2-TABLEBASE;                           << WBT >>02005000
          CWORD:=TOS;                                                   02007000
          DEL;                                                          02009000
          PUTNUM(CWORD);                                                02011000
          @PBUF:=@PBUF-1;                                               02013000
          PBUF:=":";                                                    02015000
     IF CHARFLAG THEN                                          <<01.3A>>02017000
      @PBUF:=@PBUF+1 <<CHARS NEXT TO ":">>                     <<01.3A>>02019000
      ELSE                                                     <<01.3A>>02021000
          @PBUF:=@PBUF+2;                                               02023000
          DO                                                            02025000
             BEGIN                                                      02027000
                COMPBUFF(IX1):=CORE(LINESTART1+DOUBLE(IX1));            02029000
            IF CHARFLAG THEN                                   <<01.3A>>02031000
             PUTCHAR(LOGICAL(COMPBUFF(IX1)))                   <<01.3A>>02033000
            ELSE                                               <<01.3A>>02035000
                PUTNUM(COMPBUFF(IX1));                                  02037000
                IX1:=IX1+1;                                             02039000
                IF (LINESTART1+DOUBLE(IX1)) >ENADR THEN GO PLINE;       02041000
             END                                                        02043000
     UNTIL IX1=IX1T;                                           <<01.3A>>02045000
PLINE:    PRINTLINE;  <<GO PRINT LINE>>                                 02047000
          IF (LINESTART1+DOUBLE(IX1)) >ENADR THEN GO ENDUMP;            02049000
     LINEDUP:=LINESTART1+LINECT;<<TEST FOR DUP>>               <<01.3A>>02051000
COMPARE:  IX3:=0;                                                       02053000
          DO                                                            02055000
             BEGIN                                                      02057000
                IF (LINEDUP+DOUBLE(IX3)) > MAXMEM THEN GO TEST1;        02059000
                COMPBUFF2(IX3):=CORE(LINEDUP+DOUBLE(IX3));              02061000
                IX3:=IX3+1;                                             02063000
        END UNTIL IX3=IX1T;                                    <<01.3A>>02065000
     IF CB <> CB2,(2*INTEGER(IX1T)) THEN GO TEST1;             <<01.3A>>02067000
          DUPLICATION:=TRUE;                                            02069000
     LINEDUP:=LINEDUP+LINECT;<<BUMP TO COMP NXT LINE>>         <<01.3A>>02071000
          IF LINEDUP > ENADR THEN GO PRINTDUP;                          02073000
          GO TO COMPARE;                                                02075000
TEST1:    IF DUPLICATION=TRUE THEN GO PRINTDUP;                         02077000
CONT1:    IX2:=IX2+1;                                                   02079000
          LINESTART1:=LINEDUP;                                          02081000
          IF LINESTART1 > ENADR THEN GO ENDUMP;                         02083000
          IF IX2=8 THEN                                                 02085000
             BEGIN                                                      02087000
               IF NOT CHARFLAG THEN     <<NO SKIP IF CHAR>>    <<00221>>02089000
                SKIPLINES(1); <<SKIP LINE AFTER PRINT 8>>               02091000
                IX2:=0;                                                 02093000
             END;                                                       02095000
          GO TO TEST2;                                                  02097000
PRINTDUP:  <<PRINT LINES XXXXXX-XXXXXX SAME AS ABOVE>>                  02099000
         BLANKBUF;                                                      02101000
     IF LINEDUP > ENADR THEN LINEDUP:=(LINEDUP-LINECT);        <<01.3A>>02103000
     IF LINEDUP = (LINESTART1+LINECT) THEN GO CONT1;           <<01.3A>>02105000
          MOVE BBUF                                                     02107000
          :="LINES XXXXXX - XXXXXX SAME AS ABOVE ";                     02109000
          @PBUF:=@PBUF+6;                                               02111000
     TOS:=LINESTART1+LINECT-TABLEBASE;                         << WBT >>02113000
          CWORD:=TOS;                                                   02115000
          DEL;                                                          02117000
          PUTNUM(CWORD);                                                02119000
          @PBUF:=@PBUF+2;                                               02121000
          TOS:=LINEDUP-1D-TABLEBASE;                           << WBT >>02123000
          CWORD:=TOS;                                                   02125000
          DEL;                                                          02127000
          PUTNUM(CWORD);                                                02129000
          PRINTLINE;                                                    02131000
          IX2:=7;                                                       02133000
          GO TO CONT1 <<CONTINUE>>;                                     02135000
ENDUMP:                                                                 02137000
       END;                                                             02139000
                                                                        02141000
$PAGE "SKIPOCTALDUMP: Note range of addresses not printed"              02143000
$CONTROL SEGMENT=UTIL                                                   02145000
PROCEDURE SKIPOCTALDUMP(CURAD,NEXTADR);                        <<01.3A>>02147000
VALUE CURAD,NEXTADR; DOUBLE CURAD,NEXTADR;                     <<01.3A>>02149000
COMMENT                                                                 02151000
                                                                        02153000
Purpose:                                                                02155000
     Print message noting that a range of addresses has been            02157000
     skipped.  Provides parallelism with OCTALDUMP.                     02159000
                                                                        02161000
Input parameters:                                                       02163000
     CURAD: Sktarting address                                           02165000
     NEXTADR: Ending address                                            02167000
                                                                        02169000
Output parameters:                                                      02171000
                                                                        02173000
Globals Referenced:                                                     02175000
                                                                        02177000
Globals Altered:                                                        02179000
                                                                        02181000
Data Structures:                                                        02183000
                                                                        02185000
Algorithm:                                                              02187000
                                                                        02189000
;  <<end procedure header comment>>                                     02191000
BEGIN                                                          <<01.3A>>02193000
                                                               <<01.3A>>02195000
LOGICAL SCR1=Q-6;                                              <<01.3A>>02197000
LOGICAL SCR3=Q-4;                                              <<01.3A>>02199000
                                                               <<01.3A>>02201000
   IF CURAD>NEXTADR THEN RETURN;                               <<01924>>02203000
MOVE BBUF:=                                                    <<01.3A>>02205000
"**** (       TO        NOT PRINTED) ****";                    <<01.3A>>02207000
@PBUF:=@BBUF+6;                                                <<01.3A>>02209000
PUTNUMP(SCR1);                                                 <<01.3A>>02211000
@PBUF:=@BBUF+16;                                               <<01.3A>>02213000
PUTNUMP(SCR3);                                                 <<01.3A>>02215000
PRINTLINE;                                                     <<01.3A>>02217000
END<<SKIPOCTALDUMP>>;                                          <<01.3A>>02219000
                                                                        02221000
$PAGE "PUTCHAR: Write 2 characters to PBUF"                             02223000
$CONTROL SEGMENT=UTIL                                                   02225000
PROCEDURE PUTCHAR(WORD);                                       <<01.3A>>02227000
COMMENT                                                                 02229000
                                                                        02231000
Purpose:                                                                02233000
     Screen out strange characters and replace them with a '.'          02235000
     This procedure puts a pair of characters into                      02237000
     the output line and advances @pbuf.  Any invalid                   02239000
     characters are replaced by a ".".                                  02241000
                                                                        02243000
Input parameters:                                                       02245000
     WORD: Contains 2 byte size characters                              02247000
                                                                        02249000
Output parameters: none                                                 02251000
                                                                        02253000
Globals Referenced:                                                     02255000
     @PBUF: pointer to PBUF output buffer.                              02257000
                                                                        02259000
Globals Altered:                                                        02261000
     @PBUF is incremented by 2.                                         02263000
     2 characters are written to PBUF                                   02265000
                                                                        02267000
Data Structures:                                                        02269000
                                                                        02271000
Algorithm:                                                              02273000
     Check each byte separately, if its < %40 or > %176                 02275000
     its probably strange, so write a '.'.                              02277000
     Otherwise, write the character as is                               02279000
                                                                        02281000
;                                                                       02283000
                                                               <<01.3A>>02285000
   VALUE WORD;                                                 <<01.3A>>02287000
   LOGICAL WORD;                                               <<01.3A>>02289000
   BEGIN                                                       <<01.3A>>02291000
     IF ((WORD.(0:8) < %40) OR (WORD.(0:8) > %176))            <<01.3A>>02293000
     THEN PBUF:="." ELSE PBUF:=BYTE(WORD.(0:8));               <<01.3A>>02295000
     @PBUF:=@PBUF+1;                                           <<01.3A>>02297000
     IF ((WORD.(8:8)<%40) OR (WORD.(8:8) > %176))              <<01.3A>>02299000
     THEN PBUF:="." ELSE PBUF:=BYTE(WORD.(8:8));               <<01.3A>>02301000
     @PBUF:=@PBUF+1;                                           <<01.3A>>02303000
   END;                                                        <<01.3A>>02305000
                                                                        02307000
$PAGE "NAMEDST: Describe DST given DST number"                          02309000
$CONTROL SEGMENT=UTIL                                                   02311000
PROCEDURE NAMEDST;                                                      02313000
COMMENT                                                                 02315000
                                                                        02317000
Purpose:                                                                02319000
     This procedure will name the dst entrys by their function          02321000
                                                                        02323000
Input parameters:                                                       02325000
                                                                        02327000
Output parameters:                                                      02329000
                                                                        02331000
Globals Referenced:                                                     02333000
     MBENTNO is used to pass in the number of the DST to be             02335000
             described                                                  02337000
                                                                        02339000
Globals Altered:                                                        02341000
     PBUF output buffer gets description of DST                         02343000
     @PBUF is incremented according to length of description            02345000
                                                                        02347000
Data Structures:                                                        02349000
                                                                        02351000
Algorithm:                                                              02353000
     Blank out PBUF(1:32), then use a big case statement to             02355000
     give the DST the appropriate name.                                 02357000
                                                                        02359000
;                                                                       02361000
   BEGIN                                                                02363000
     MOVE PBUF   := " ";  << BLANK OUT >>                      <<MS.00>>02365000
     MOVE PBUF(1):= PBUF,(32); << OUTPUT BUFFER >>             <<MS.00>>02367000
   CASE MBENTNO OF                                             <<01833>>02369000
      BEGIN                                                             02371000
         BEGIN     <<0>>                                                02373000
         END;                                                           02375000
         BEGIN     <<1>>                                                02377000
            MOVE PBUF:="(CODE SEGMENT TABLE)";                          02379000
            @PBUF:=@PBUF+20;                                            02381000
         END;                                                           02383000
         BEGIN     <<2>>                                                02385000
            MOVE PBUF:="(DATA SEGMENT TABLE)";                          02387000
            @PBUF:=@PBUF+20;                                            02389000
         END;                                                           02391000
         BEGIN     <<3>>                                                02393000
            MOVE PBUF:="(PROCESS CONTROL BLOCK)";                       02395000
            @PBUF:=@PBUF+23;                                            02397000
         END;                                                           02399000
         BEGIN     <<4>>                                                02401000
            MOVE PBUF:="(CST EXTENSION)";                               02403000
            @PBUF:=@PBUF+16;                                            02405000
         END;                                                           02407000
         BEGIN     <<5>>                                                02409000
            MOVE PBUF:="(SYSTEM GLOBAL AREA)";                          02411000
            @PBUF:=@PBUF+21;                                            02413000
         END;                                                           02415000
         BEGIN     <<6>>                                                02417000
            MOVE PBUF:="(FIXED LOW CORE)";                              02419000
            @PBUF:=@PBUF+18;                                            02421000
         END;                                                           02423000
         BEGIN     <<7>>                                                02425000
            MOVE PBUF:="(INTERRUPT CONTROL STACK)";                     02427000
            @PBUF:=@PBUF+26;                                            02429000
         END;                                                           02431000
         BEGIN     <<10>>                                               02433000
            MOVE PBUF:="(SYSTEM BUFFERS)";                              02435000
            @PBUF:=@PBUF+17;                                            02437000
           CHARFLAG:=TRUE;                                     <<01.3A>>02439000
         END;                                                           02441000
         BEGIN     <<11>>                                               02443000
            MOVE PBUF:="(UCOP REQUEST QUEUE)";                          02445000
            @PBUF:=@PBUF+21;                                            02447000
         END;                                                           02449000
         BEGIN     <<12>>                                               02451000
            MOVE PBUF:="(PROCESS-PROCESS COMMUNICATION TABLE)";         02453000
            @PBUF:=@PBUF+38;                                            02455000
         END;                                                           02457000
         BEGIN     <<13>>                                               02459000
            MOVE PBUF:="(I/O QUEUE)";                                   02461000
            @PBUF:=@PBUF+12;                                            02463000
         END;                                                           02465000
         BEGIN     <<14>>                                               02467000
            MOVE PBUF:="(TERMINAL BUFFERS)";                            02469000
            @PBUF:=@PBUF+19;                                            02471000
           CHARFLAG:=TRUE;                                     <<01.3A>>02473000
         END;                                                           02475000
         BEGIN     <<15>>                                               02477000
            MOVE PBUF:="(LOGICAL-PHYSICAL DEVICE TABLE)";               02479000
            @PBUF:=@PBUF+32;                                            02481000
         END;                                                           02483000
         BEGIN     <<16>>                                               02485000
            MOVE PBUF:="(LOGICAL DEVICE AND CLASS TABLE)";              02487000
            @PBUF:=@PBUF+33;                                            02489000
           CHARFLAG:=TRUE;                                     <<01.3A>>02491000
         END;                                                           02493000
         BEGIN     <<17>>                                               02495000
            MOVE PBUF:="(DRIVER LINKAGE TABLE)";                        02497000
            @PBUF:=@PBUF+23;                                            02499000
         END;                                                           02501000
         BEGIN     <<20>>                                               02503000
            MOVE PBUF:="(I/O RESOURCE TABLES)";                <<01.02>>02505000
            @PBUF:=@PBUF+23;                                            02507000
         END;                                                           02509000
         BEGIN     <<21>>                                               02511000
           MOVE PBUF := "(SECONDARY MSG TABLE)";               <<03556>>02513000
           @PBUF := @PBUF + 22;                                <<03556>>02515000
         END;                                                           02517000
         BEGIN     <<22>>                                               02519000
            MOVE PBUF:="(LOADER SEGMENT TABLE)";                        02521000
            @PBUF:=@PBUF+23;                                            02523000
           CHARFLAG:=TRUE;                                     <<01.3A>>02525000
         END;                                                           02527000
         BEGIN     <<23>>                                               02529000
            MOVE PBUF:="(TIMER REQUEST LIST)";                          02531000
            @PBUF:=@PBUF+21;                                            02533000
         END;                                                           02535000
         BEGIN     <<24>>                                               02537000
            MOVE PBUF:="(DIRECTORY)";                                   02539000
            @PBUF:=@PBUF+12;                                            02541000
           CHARFLAG:=TRUE;                                     <<01.3A>>02543000
         END;                                                           02545000
         BEGIN     <<25>>                                               02547000
            MOVE PBUF:="(DIRECTORY SPACE)";                             02549000
            @PBUF:=@PBUF+18;                                            02551000
         END;                                                           02553000
         BEGIN     <<26>>                                               02555000
            MOVE PBUF:="(RIN TABLE)";                                   02557000
            @PBUF:=@PBUF+12;                                            02559000
         END;                                                           02561000
         BEGIN     <<27>>                                               02563000
            MOVE PBUF:="(SWAPTABLE)";                          << WBT >>02565000
            @PBUF:=@PBUF+12;                                   << WBT >>02567000
         END;                                                           02569000
         BEGIN     <<30>>                                               02571000
            MOVE PBUF:="(JOB PROCESS COUNT)";                           02573000
            @PBUF:=@PBUF+20;                                            02575000
         END;                                                           02577000
         BEGIN     <<31>>                                               02579000
            MOVE PBUF:="(JOB MASTER TABLE)";                            02581000
            @PBUF:=@PBUF+19;                                            02583000
           CHARFLAG:=TRUE;                                     <<01.3A>>02585000
         END;                                                           02587000
         BEGIN     <<32>>                                               02589000
            MOVE PBUF:="(TAPE LABEL TABLE)";                   <<01.3A>>02591000
            @PBUF:=@PBUF+19;                                   <<01.3A>>02593000
            CHARFLAG:=TRUE;                                    <<01.3A>>02595000
         END;                                                           02597000
         BEGIN     <<33>>                                               02599000
            MOVE PBUF:="(LOG TABLE)";                          << WBT >>02601000
            @PBUF:=@PBUF+12;                                   << WBT >>02603000
           CHARFLAG:=TRUE;                                     <<01.3A>>02605000
         END;                                                           02607000
         BEGIN     <<34>>                                               02609000
            MOVE PBUF:="(REPLY INFORMATION TABLE)";                     02611000
            @PBUF:=@PBUF+26;                                            02613000
           CHARFLAG:=TRUE;                                     <<01.3A>>02615000
         END;                                                           02617000
         BEGIN     <<35>>                                               02619000
            MOVE PBUF:="(VOLUME TABLE)";                                02621000
            @PBUF:=@PBUF+15;                                            02623000
           CHARFLAG:=TRUE;                                     <<01.3A>>02625000
         END;                                                           02627000
         BEGIN     <<36>>                                               02629000
            MOVE PBUF:="(BREAKPOINT TABLE)";                            02631000
            @PBUF:=@PBUF+19;                                            02633000
         END;                                                           02635000
         BEGIN     <<37>>                                               02637000
            MOVE PBUF:="(LOG BUFFER 1)";                                02639000
            @PBUF:=@PBUF+15;                                            02641000
           CHARFLAG:=TRUE;                                     <<01.3A>>02643000
         END;                                                           02645000
         BEGIN     <<40>>                                               02647000
            MOVE PBUF:="(LOG BUFFER 2)";                                02649000
            @PBUF:=@PBUF+15;                                            02651000
           CHARFLAG:=TRUE;                                     <<01.3A>>02653000
         END;                                                           02655000
         BEGIN     <<41>>                                               02657000
            MOVE PBUF:="(LOG ID TABLE)";                       << WBT >>02659000
            @PBUF:=@PBUF+15;                                   << WBT >>02661000
           CHARFLAG:=TRUE;                                     <<01.3A>>02663000
         END;                                                           02665000
         BEGIN     <<42>>                                               02667000
            MOVE PBUF := "(ASSOCIATION TABLE)";                <<01664>>02669000
            @PBUF := @PBUF + 19;                               <<01664>>02671000
            CHARFLAG := TRUE;                                  <<01664>>02673000
         END;                                                           02675000
         BEGIN     <<43>>                                               02677000
            MOVE PBUF:="(CST BLOCK)";                                   02679000
            @PBUF:=@PBUF+12;                                            02681000
         END;                                                           02683000
         BEGIN     <<44>>                                               02685000
            MOVE PBUF:="(JOB CUTOFF TABLE)";                            02687000
            @PBUF:=@PBUF+19;                                            02689000
         END;                                                           02691000
         BEGIN     <<45>>                                               02693000
            MOVE PBUF:="(SYSTEM JIT)";                                  02695000
            @PBUF:=@PBUF+13;                                            02697000
           CHARFLAG:=TRUE;                                     <<01.3A>>02699000
         END;                                                           02701000
         BEGIN     <<46>>                                               02703000
            MOVE PBUF:="(SPECIAL REQUEST TABLE)";              << WBT >>02705000
            @PBUF:=@PBUF+24;                                   << WBT >>02707000
         END;                                                           02709000
         BEGIN     <<47>>                                               02711000
            MOVE PBUF:="(VIRTUAL DISK SPACE TABLE)";           << WBT >>02713000
            @PBUF:=@PBUF+27;                                   << WBT >>02715000
         END;                                                           02717000
         BEGIN     <<50>>                                               02719000
         END;                                                           02721000
         BEGIN     <<51>>                                               02723000
         MOVE PBUF:="(ARSBM TABLE)";                           << WBT >>02725000
         @PBUF:=@PBUF+14;                                      << WBT >>02727000
         END;                                                           02729000
         BEGIN     <<52>>                                               02731000
            MOVE PBUF:="(ILT)";                                <<02012>>02733000
            @PBUF:=@PBUF+6;                                    <<02012>>02735000
         END;                                                           02737000
         BEGIN     <<53>>                                               02739000
            MOVE PBUF:="(SIR TABLE)";                                   02741000
            @PBUF:=@PBUF+12;                                            02743000
         END;                                                           02745000
         BEGIN <<54>>                                          <<01.02>>02747000
         MOVE PBUF:="(FILE MULTI-ACCESS VECTOR)";              <<00221>>02749000
         @PBUF:=@PBUF+27;                                      <<00221>>02751000
           CHARFLAG:=TRUE;                                     <<01.3A>>02753000
         END;                                                  <<01.02>>02755000
         BEGIN <<55>>                                          <<01.02>>02757000
         MOVE PBUF:="(INPUT DEVICE DIRECTORY)";                <<00221>>02759000
         @PBUF:=@PBUF+25;                                      <<00221>>02761000
           CHARFLAG:=TRUE;                                     <<SP.SZ>>02763000
         END;                                                  <<01.02>>02765000
         BEGIN <<56>>                                          <<01.02>>02767000
         MOVE PBUF:="(OUTPUT DEVICE DIRECTORY)";               <<00221>>02769000
         @PBUF:=@PBUF+26;                                      <<00221>>02771000
           CHARFLAG:=TRUE;                                     <<SP.SZ>>02773000
         END;                                                  <<01.02>>02775000
         BEGIN <<57>>                                          <<01.02>>02777000
         MOVE PBUF:="(WELCOME MESSAGE #1)";                    <<00221>>02779000
         @PBUF:=@PBUF+22;                                      <<00221>>02781000
           CHARFLAG:=TRUE;                                     <<01.3A>>02783000
         END;                                                  <<01.02>>02785000
         BEGIN <<60>>                                          <<01.02>>02787000
         MOVE PBUF:="(WELCOME MESSAGE #2)";                    <<00221>>02789000
         @PBUF:=@PBUF+22;                                      <<00221>>02791000
           CHARFLAG:=TRUE;                                     <<01.3A>>02793000
         END;                                                  <<01.02>>02795000
         BEGIN <<61>>                                          <<01.02>>02797000
         MOVE PBUF:="(CS SYSTEM SEGMENT)";                     <<00221>>02799000
         @PBUF:=@PBUF+21;                                      <<00221>>02801000
         END;                                                  <<01.02>>02803000
         BEGIN <<62>>                                          <<01.02>>02805000
         MOVE PBUF:="(JOB-PROCESS CROSS REFERENCE)";           <<00221>>02807000
         @PBUF:=@PBUF+29;                                      <<00221>>02809000
         END;                                                  <<01.02>>02811000
         BEGIN <<63>>                                          <<01.02>>02813000
            MOVE PBUF:="(SYSTEM JDT)";                         <<01.02>>02815000
            @PBUF:=@PBUF+13;                                   <<01.02>>02817000
         END;                                                  <<01.02>>02819000
         BEGIN <<64>>                                          <<01.02>>02821000
         MOVE PBUF:="(COMMAND INTERPRETER LOG-ON DST)";        <<00221>>02823000
         @PBUF:=@PBUF+32;                                      <<00221>>02825000
           CHARFLAG:=TRUE;                                     <<01.3A>>02827000
         END;                                                  <<01.02>>02829000
         BEGIN <<65>>                                          <<01.02>>02831000
            MOVE PBUF:="(MOUNTED VOLUME TAB.)";                <<01.02>>02833000
            @PBUF:=@PBUF+22;                                   <<01.02>>02835000
           CHARFLAG:=TRUE;                                     <<01.3A>>02837000
         END;                                                  <<01.02>>02839000
         BEGIN <<66>>                                          <<01.02>>02841000
            MOVE PBUF:="(PRI. VOL. USER TABLE)";               << WBT >>02843000
            @PBUF:=@PBUF+23;                                   << WBT >>02845000
           CHARFLAG:=TRUE;                                     <<01.3A>>02847000
         END;                                                  <<01.02>>02849000
         BEGIN            <<67>>                               << WBT >>02851000
            MOVE PBUF:="(AVAILABLE REGION LIST)";              << WBT >>02853000
            @PBUF:=@PBUF+24;                                   << WBT >>02855000
         END;                                                  << WBT >>02857000
         BEGIN            <<70>>                               << WBT >>02859000
            MOVE PBUF:="(DISC REQUEST TABLE)";                 << WBT >>02861000
            @PBUF:=@PBUF+21;                                   << WBT >>02863000
         END;                                                  << WBT >>02865000
         BEGIN            <<71>>                               << WBT >>02867000
            MOVE PBUF:="(MSG HBR TABLE)";                      << WBT >>02869000
            @PBUF:=@PBUF+16;                                   << WBT >>02871000
         END;                                                  << WBT >>02873000
         BEGIN            <<72>>                               << WBT >>02875000
            MOVE PBUF:="(PRIMARY MSG TABLE)";                  << WBT >>02877000
            @PBUF:=@PBUF+20;                                   << WBT >>02879000
         END;                                                  << WBT >>02881000
         BEGIN            <<73>>                               << WBT >>02883000
            MOVE PBUF:="(MEASUREMENT INFO TABLE)";             << WBT >>02885000
            @PBUF:=@PBUF+25;                                   << WBT >>02887000
         END;                                                  << WBT >>02889000
         BEGIN            <<74>>                               << WBT >>02891000
            MOVE PBUF:="(SECONDARY MSG TABLE)";                << WBT >>02893000
            @PBUF:=@PBUF+22;                                   << WBT >>02895000
         END;                                                  << WBT >>02897000
         BEGIN            <<75>>                               << WBT >>02899000
         END;                                                  << WBT >>02901000
         BEGIN            <<76>>                               << WBT >>02903000
         END;                                                  << WBT >>02905000
         BEGIN            <<77>>                               << WBT >>02907000
         END;                                                  << WBT >>02909000
      END;                                                     <<01.02>>02911000
   END<<NAMEDST>>;                                             <<01.02>>02913000
                                                                        02915000
$PAGE "GTCSTIDX: Prepare CST labels for CHKLDMAP"                       02917000
$CONTROL SEGMENT=INIT                                                   02919000
LOGICAL PROCEDURE GTCSTIDX;                                             02921000
COMMENT                                                                 02923000
                                                                        02925000
Purpose:                                                                02927000
     Load global array VCST for use by CHKLDMAP                         02929000
                                                                        02931000
Input parameters: none                                                  02933000
                                                                        02935000
Output parameters: returns true upon successful completion              02937000
                                                                        02939000
Globals Referenced:                                                     02941000
                                                                        02943000
Globals Altered: VCST(1:11)                                             02945000
                                                                        02947000
Data Structures:                                                        02949000
                                                                        02951000
Algorithm:                                                              02953000
     It's really unclear why this isn't just a subroutine of            02955000
     CHKLDMAP, since thats the only thing that calls it.                02957000
     It looks at some low core which somehow characterizes              02959000
     the loadmap of the dump system for comparison with that of         02961000
     the machine DPAN is running on.  This low core info is             02963000
     placed in global array VCST.  It seems to always return            02965000
     a value of TRUE.                                                   02967000
                                                                        02969000
;                                                                       02971000
BEGIN                                                          <<01.3A>>02973000
<<THIS PROCEDURE OBTAINS THE EXTERNAL CST LABEL OF CERTAIN>>   <<01.3A>>02975000
<<SYSTEM PROCESSES AND PLACES THEM IN AN ARRAY FOR LATER USE>> <<01.3A>>02977000
                                                               <<01.3A>>02979000
DOUBLE SCRATCH;                                                <<01.3A>>02981000
LOGICAL ARRAY SCR0(*)=SCRATCH;                                 <<01.3A>>02983000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<01.3A>>02985000
                                                               <<01.3A>>02987000
GTCSTIDX:=FALSE;                                               <<01.3A>>02989000
SCRATCH:=0D;                                                   <<01.3A>>02991000
SCR1:=CORE(%1141D);<<PROGEN LOGICAL PROCESS>>                  <<01.3A>>02993000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>02995000
VCST:=(CORE(SCRATCH)&LSR(8));                                  <<01.3A>>02997000
SCR1:=CORE(%1143D);<<UCOP LOGICAL PROCESS>>                    <<01.3A>>02999000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03001000
VCST(1):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03003000
SCR1:=CORE(%1145D);<<DEVREC>>                                  <<01.3A>>03005000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03007000
VCST(2):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03009000
SCR1:=CORE(%1146D);<<MESSAGE LOGICAL PROCESS>>                 <<01.3A>>03011000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03013000
VCST(3):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03015000
SCR1:=CORE(%1150D);<<LOG LOGICAL PROCESS>>                     <<01.3A>>03017000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03019000
VCST(4):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03021000
SCR1:=CORE(%1151D);<<LOAD LOGICAL PROCESS>>                    <<01.3A>>03023000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03025000
VCST(5):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03027000
SCR1:=CORE(%1154D);<<MEMLOGP LOGICAL PROCESS>>                 <<01.3A>>03029000
SCR1:=(SCR1+PCBFLG)+7;                                         <<01.3A>>03031000
VCST(6):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>03033000
SCR1:=CORE(%1122D);<<PCREATE EXTERNAL LABEL>>                  <<01.3A>>03035000
VCST(7):=SCR1 LAND %377;                                       <<01.3A>>03037000
SCR1:=CORE(%1155D);<<MORGUE EXTERNAL LABEL(TERMINATE)>>        <<01.3A>>03039000
VCST(8):=SCR1 LAND %377;                                       <<01.3A>>03041000
SCR1:=CORE(%1157D);<<CIINIT EXTERNAL LABEL>>                   <<01.3A>>03043000
VCST(9):=SCR1 LAND %377;                                       <<01.3A>>03045000
SCR1:=CORE(%1162D);<<TRACE1' EXTERNAL LABEL>>                  <<01.3A>>03047000
VCST(10):=SCR1 LAND %377;                                      <<01.3A>>03049000
SCR1:=CORE(%1165D);<<SPOOLING EXTERNAL LABEL>>                 <<01.3A>>03051000
VCST(11):=SCR1 LAND %377;                                      <<01.3A>>03053000
GTCSTIDX:=TRUE;                                                <<01.3A>>03055000
END<<GTCSTIDX>>;                                               <<01.3A>>03057000
                                                                        03059000
$PAGE "CHKLDMAP: Compare dumped system with LOADMAP.PUB.SYS"            03061000
PROCEDURE CHKLDMAP;                                            <<01.3A>>03063000
COMMENT                                                                 03065000
                                                                        03067000
Purpose:                                                                03069000
  This procedure attempts to verify the external labels                 03071000
  obtained from the dump in procedure "GTCSTIDX" with the               03073000
  ascii equivalent in the file "LOADMAP.PUB.SYS" for the                03075000
  current file on this system!                                          03077000
                                                                        03079000
Input parameters:                                                       03081000
                                                                        03083000
Output parameters:                                                      03085000
                                                                        03087000
Globals Referenced:                                                     03089000
                                                                        03091000
Globals Altered:                                                        03093000
     SAME'SYS                                                           03095000
                                                                        03097000
Data Structures:                                                        03099000
     List of tables accessed as well as descriptions of tables          03101000
     used internally.                                                   03103000
                                                                        03105000
Algorithm:                                                              03107000
     Called by TAPE'TO'DISK, to decide if the system DPAN is            03109000
     running on has a LOADMAP that can be used with the dump            03111000
     file.  Compares LOADMAP and VCST array (set up by                  03113000
     SGTCSTID) and sets global SAME'SYS.                                03115000
                                                                        03117000
;                                                                       03119000
BEGIN                                                          <<01.3A>>03121000
                                                               <<01.3A>>03123000
                                                               <<01.3A>>03125000
INTEGER CNT := 6;     <<CHECK ONLY LABLES NOT PROCESSES>>      <<00750>>03127000
LOGICAL TEMP:=4;                                               <<01.3A>>03129000
LOGICAL TEMP1;                                                 <<01.3A>>03131000
ARRAY TMPBUF(0:63);                                            <<01.3A>>03133000
BYTE ARRAY BTMP(*)=TMPBUF;                                     <<01.3A>>03135000
BYTE POINTER BYYT;                                             <<01.3A>>03137000
BYTE ARRAY MPE3(0:20);                                         <<00221>>03139000
                                                               <<01.3A>>03141000
SAME'SYSTEM:=FALSE;  <<UNTIL PROVEN TRUE >>                    <<00221>>03143000
IF NOT GTCSTIDX THEN GO FINI;                                  <<01.3A>>03145000
LDFNUM:=FOPEN(LOADMAP,%3,0);                                   <<03083>>03147000
IF <> THEN GO FINI;                                            <<01.3A>>03149000
FREADDIR(LDFNUM,TMPBUF,-20,4D);                                <<01114>>03151000
IF <> THEN GO TO FINI;                                         <<01114>>03153000
DBUFFER(72) := CORE(VERNO);     <<VERSION ID>>                 <<01114>>03155000
DBUFFER(70) := CORE(UPNO);      <<UPDATE ID >>                 <<01114>>03157000
DBUFFER(71) := CORE(FNO);       << FIX ID   >>                 <<01114>>03159000
IF BTMP( 7) <> BBUF(144),(2) OR                                <<01114>>03161000
   BTMP(10) <> BBUF(140),(2) OR                                <<01114>>03163000
   BTMP(13) <> BBUF(142),(2) THEN GO TO FINI;                  <<01114>>03165000
FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));<<GET RECORD ZERO>>    <<01.3A>>03167000
IF <> THEN GO FINI;                                            <<01.3A>>03169000
SERIES := 1;   << THIS DPAN WILL NEVER WORK FOR     >>         << WBT >>03171000
               << A SERIES ONE DUMP.                >>         << WBT >>03173000
WHILE (CNT:=CNT+1)<=%13 DO                                     <<01.3A>>03175000
BEGIN                                                          <<01.3A>>03177000
  TEMP:=VCST(CNT);                                             <<01.3A>>03179000
  IF SERIES=0 THEN TEMP1:=TEMP ELSE                            <<01.3A>>03181000
  TEMP1:=(TEMP MOD 50)+4;                                      <<01.3A>>03183000
  FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP1));                    <<01.3A>>03185000
  IF <> THEN GO FINI;                                          <<01.3A>>03187000
  IF SERIES=0 THEN TEMP1:=4 ELSE                               <<01.3A>>03189000
  TEMP1:=((TEMP/50)*32)+4;                                     <<01.3A>>03191000
  @BYYT:=LOGICAL(@BTMP)+TEMP1;                                 <<01.3A>>03193000
  CASE (CNT-7) OF                                              <<00750>>03195000
  BEGIN                                                        <<01.3A>>03197000
    <<WITH THE ADVENT OF THE RESEGMENTED VERSION OF MPE>>      <<03754>>03199000
    <<THE NAMES OF ALMOST ALL SEGMENTS WERE CHANGED.   >>      <<03754>>03201000
    <<THE FOLLOWING STATEMENTS HAVE BEEN MODIFIED TO   >>      <<03754>>03203000
    <<CHECK FOR EITHER THE OLD NAMES OR THE NEW NAMES. >>      <<03754>>03205000
    IF BYYT <> "PCREATE" AND                                   <<03754>>03207000
       BYYT <> "PROCSEG'CREATE" THEN RETURN;                   <<03754>>03209000
    IF BYYT <> "MORGUE" AND                                    <<03754>>03211000
       BYYT <> "MOR'RIN'ABDP" THEN RETURN;                     <<03754>>03213000
    IF BYYT <> "CIINIT" AND                                    <<03754>>03215000
       BYYT <> "CI2" THEN RETURN;                              <<03754>>03217000
      ;                                                        << WBT >>03219000
      ;                                                        << WBT >>03221000
  END<<OF CASE>>;                                              <<01.3A>>03223000
END;                                                           <<01.3A>>03225000
SAME'SYS:=TRUE;                                                <<01.3A>>03227000
RETURN;                                                        <<01114>>03229000
                                                               <<01.3A>>03231000
FINI:                                                          <<01.3A>>03233000
FCLOSE(LDFNUM,0,0);                                            <<01114>>03235000
LDFNUM := 0;                                                   <<01114>>03237000
END<<CHKLDMAP>>;                                               <<01.3A>>03239000
                                                                        03241000
$PAGE "CHECKSTACK(DSTNO): Verify stack qualities, print header"         03243000
$CONTROL SEGMENT=UTIL                                                   03245000
COMMENT                                                                 03247000
                                                                        03249000
Purpose                                                                 03251000
     Given a DST number, attempts to verify whether it is      <<03076>>03253000
     indeed a stack, and if so, whether its markers are valid. <<03076>>03255000
     It then prints the basic stack marker information.        <<03076>>03257000
     Two global variables save this information for later      <<03076>>03259000
     use by FORMATSTACK: STACKFLAG for whether it is a stack,  <<03076>>03261000
     and MARKERS'OK for whether the markers seem reasonable.   <<03076>>03263000
     If more than just the markers is to be formatted,         <<03076>>03265000
     FORMATSTACK can be called right after CHECKSTACK.         <<03076>>03267000
                                                                        03269000
Input parameters:                                                       03271000
                                                                        03273000
Output parameters:                                                      03275000
                                                                        03277000
Globals Referenced:                                                     03279000
                                                                        03281000
Globals Altered:                                                        03283000
     STACKFLAG passed to FORMATSTACK                                    03285000
     MARKERS'OK passed to FORMATSTACK                                   03287000
                                                                        03289000
Data Structures:                                                        03291000
                                                                        03293000
Algorithm:                                                              03295000
                                                                        03297000
;                                                                       03299000
                                                               <<03076>>03301000
                                                               <<03076>>03303000
PROCEDURE CHECKSTACK(DSTNO);                                   <<03076>>03305000
VALUE DSTNO;                                                   <<03076>>03307000
LOGICAL DSTNO;                                                 <<03076>>03309000
BEGIN                                                          <<03076>>03311000
                                                               <<03076>>03313000
DOUBLE SCRATCH,SCRATCH2,SCRATCH3,SCRATCH4;                     <<03076>>03315000
LOGICAL INITQ;                                                 <<03076>>03317000
DOUBLE SCRATCH5;                                               <<03076>>03319000
INTEGER DELTQ,WORK3;                                           <<03076>>03321000
LOGICAL WORK1,WORK2,WORK4;                                     <<03076>>03323000
LOGICAL ARRAY SCR0(*)=SCRATCH2;                                <<03076>>03325000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<03076>>03327000
LOGICAL ARRAY SCR2(*)=INITQ;                                   <<03076>>03329000
LOGICAL ARRAY SCR3(*)=SCR2(1);                                 <<03076>>03331000
LOGICAL QI;                                                    <<03076>>03333000
                                                               <<03076>>03335000
BLANKBUF;                                                               03337000
STACKFLAG:=FALSE;  <<UNTIL PROVEN GUILTY>>                     <<03076>>03339000
CHARFLAG:=TRUE;    <<PRINT ASCII IN OCTALDUMP>>                <<03076>>03341000
SCRATCH:=DSTTOADDR(DSTNO);  <<BANK+ADDR OF DST>>               <<03076>>03343000
DSTNB:=DSTNO;                                                  <<03076>>03345000
WORK3:=CORE(4D);   <<GET CURRENT PROCESS>>                     <<03076>>03347000
TOS:=0;                                                        <<03076>>03349000
TOS:=WORK3;                                                    <<03076>>03351000
SCRATCH2:=TOS;                                                 <<03076>>03353000
WORK4:=CORE(SCRATCH2+3D);  <<CURR PCB DST#>>                   <<03076>>03355000
CDSTN:=WORK4.(1:10);                                           <<03076>>03357000
                                                               <<03076>>03359000
BYPASSA:                                                       <<03076>>03361000
     WORK2:=CORE(DSTDEFIN+DOUBLE(4*DSTNB+1));<<WORD 1 OF DST>> <<03076>>03363000
     IF WORK2.(3:1)=0 THEN GO QUITX;  << STACK BIT >>          <<03076>>03365000
     SKIPLINES(2);                                             <<03076>>03367000
     MOVE BBUF(23):="******    PCBX AND STACK MARKERS FOR";    <<03076>>03369000
     MOVE BBUF(60):="DST      (PCB    )    ******";            <<03076>>03371000
     @PBUF:=@BBUF+61;                                          <<03076>>03373000
     PUTNUMP(DSTNB);                                           <<03076>>03375000
     WORK3:=0;                                                 <<03076>>03377000
     TOS:=0;                                                   <<03076>>03379000
     TOS:=CORE(3D);                                            <<03076>>03381000
     SCRATCH3:=TOS;     <<LOC PCB>>                            <<03076>>03383000
     IF SCRATCH3 < 1D THEN GO BIPASS;                          <<03076>>03385000
     WORK2:=CORE(SCRATCH3);     <<# ENTRYS IN PCB>>            <<03076>>03387000
     IF LOGICAL(WORK2) >255 THEN GO BIPASS;                    <<03076>>03389000
      FOR WORK3:=1 UNTIL (INTEGER (WORK2)) DO                  <<03076>>03391000
      IF NOT ISFREEPCB(WORK3) THEN                             <<03076>>03393000
     BEGIN                                                     <<03076>>03395000
       WORK4:=CORE(SCRATCH3+DOUBLE(WORK3*16+3));               <<03076>>03397000
     WORK4:=WORK4.(1:10);                                      <<03076>>03399000
      IF DSTNB=INTEGER(WORK4) THEN GO BIPASS;                  <<03076>>03401000
     END;                                                      <<03076>>03403000
     GO QUITX;                                                 <<03076>>03405000
BIPASS:                                                        <<03076>>03407000
     STACKFLAG:=TRUE;      <<IT IS A STACK>>                   <<03076>>03409000
     @PBUF:=@BBUF+70;                                          <<03076>>03411000
     PUTNUMP(WORK3);  << PIN# OF DST >>                        <<03076>>03413000
     PRINTLINE;                                                <<03076>>03415000
     IF DSTNB=CDSTN THEN                                       <<03076>>03417000
       BEGIN                                                   <<03076>>03419000
       MOVE BBUF(39):="**** CURRENT  PROCESS ****";            <<03076>>03421000
       INDXARAY((LSTSYSDST+1)*2+1):=PAGENO;                    <<03076>>03423000
       PRINTLINE;                                              <<03076>>03425000
       END;                                                    <<03076>>03427000
     SKIPLINES(2);                                             <<03076>>03429000
                                                               <<03076>>03431000
MOVE BBUF:="SEG REL   SEG REL    JMAT     JPCNT    JOB INPUT"; <<03076>>03433000
     MOVE BBUF(51):="JOB OUTPUT  JDT DST  JIT DST";            <<03076>>03435000
     MOVE BBUF(122):="JCUT";                                   <<03076>>03437000
     PRINTLINE;                                                <<03076>>03439000
MOVE BBUF:="DL        DB         INDEX    INDEX    LOG DEV#";  <<03076>>03441000
     MOVE BBUF(51):="LOG DEV #   INDEX    INDEX    JOB TYPE";  <<03076>>03443000
     MOVE BBUF(92):="DUPLICAT  INTERACT  INIT Q    INDEX";     <<03076>>03445000
     PRINTLINE;                                                <<03076>>03447000
     <<SCRATCH CONTAINS DATA SEGMENT ADDRESS>>                 <<03076>>03449000
     WORK2:=CORE(SCRATCH);     <<SEG REL DL>>                  <<03076>>03451000
     @PBUF:=@BBUF;                                             <<03076>>03453000
     PUTNUM(WORK2);                                            <<03076>>03455000
     WORK2:=CORE(SCRATCH+1D);     <<SEG REL DB>>               <<03076>>03457000
     @PBUF:=@BBUF+10;                                          <<03076>>03459000
     PUTNUM(WORK2);                                            <<03076>>03461000
     DBADR:=DOUBLE(WORK2);<<DB ADDRESS FOR DUMP>>              <<03076>>03463000
     WORK2:=CORE(SCRATCH+3D);                                  <<03076>>03465000
     WORK3:=WORK2.(0:8);     <<JMAT INDEX>>                    <<03076>>03467000
     @PBUF:=@BBUF+20;                                          <<03076>>03469000
     PUTNUMP(WORK3);                                           <<03076>>03471000
     WORK2:=WORK2.(8:8);     <<JOB INPUT LDEV>>                <<03076>>03473000
     @PBUF:=@BBUF+38;                                          <<03076>>03475000
     ASCII(WORK2,-10,BBUF(43));    <<LDEV IN DECIMAL>>         <<03076>>03477000
     WORK2:=CORE(SCRATCH+4D);                                  <<03076>>03479000
     WORK3:=WORK2.(0:8);     <<JPCNT INDEX>>                   <<03076>>03481000
     @PBUF:=@BBUF+30;                                          <<03076>>03483000
     PUTNUMP(WORK3);                                           <<03076>>03485000
     WORK2:=WORK2.(8:8);     <<JOB OUTPUT LDEV>>               <<03076>>03487000
     @PBUF:=@BBUF+51;                                          <<03076>>03489000
     ASCII(WORK2,-10,BBUF(56));   <<LDEV IN DECIMAL>>          <<03076>>03491000
     WORK2:=CORE(SCRATCH+5D);     <<JDT DST INDEX>>            <<03076>>03493000
     @PBUF:=@BBUF+62;                                          <<03076>>03495000
     PUTNUMP(WORK2);                                           <<03076>>03497000
     WORK2:=CORE(SCRATCH+6D);                                  <<03076>>03499000
     WORK3 := WORK2.(6:10);  << JIT DST INDEX. >>              <<03076>>03501000
     @PBUF:=@BBUF+72;                                          <<03076>>03503000
     PUTNUMP(WORK3);                                           <<03076>>03505000
     CASE * WORK2.(2:2) OF     <<TY>>                          <<03076>>03507000
     BEGIN                                                     <<03076>>03509000
       BEGIN     <<0>>                                         <<03076>>03511000
         MOVE BBUF(82):="UNDEF";                               <<03076>>03513000
       END;                                                    <<03076>>03515000
       BEGIN     <<1>>                                         <<03076>>03517000
         MOVE BBUF(82):="#S";                                  <<03076>>03519000
         ASCII(CORE(SCRATCH+%33D).(2:14),10,BBUF(84));         <<03076>>03521000
       END;                                                    <<03076>>03523000
       BEGIN     <<2>>                                         <<03076>>03525000
         MOVE BBUF(82):="#J";                                  <<03076>>03527000
         ASCII(CORE(SCRATCH+%33D).(2:14),10,BBUF(84));         <<03076>>03529000
       END;                                                    <<03076>>03531000
       BEGIN     <<3>>                                         <<03076>>03533000
         MOVE BBUF(82):="TASK";                                <<03076>>03535000
       END;                                                    <<03076>>03537000
     END;                                                      <<03076>>03539000
     IF WORK2.(4:1)=1 THEN MOVE BBUF(95):="YES" ELSE           <<03076>>03541000
     MOVE BBUF(95):="NO";                                      <<03076>>03543000
     IF WORK2.(5:1)=1 THEN MOVE BBUF(104):="YES" ELSE          <<03076>>03545000
     MOVE BBUF(104):="NO";                                     <<03076>>03547000
     WORK2:=CORE(SCRATCH+11D);     <<INITIAL Q>>               <<03076>>03549000
     SCRATCH5:=SCRATCH+DOUBLE(WORK2)+DBADR;  <<ABS INIT Q>>    <<03076>>03551000
     @PBUF:=@BBUF+112;                                         <<03076>>03553000
     PUTNUM(WORK2);                                            <<03076>>03555000
     WORK2:=CORE(SCRATCH+7D);     <<JCUT INDEX>>               <<03076>>03557000
     WORK2:=WORK2.(0:8);                                       <<03076>>03559000
     @PBUF:=@BBUF+121;                                         <<03076>>03561000
     PUTNUMP(WORK2);                                           <<03076>>03563000
     PRINTLINE;                                                <<03076>>03565000
     SKIPLINES(2);                                             <<03076>>03567000
                                                               <<03076>>03569000
MOVE BBUF:="ADDRESS    BANK         X       DELTA P   STATUS"; <<03076>>03571000
         MOVE BBUF(52):="DELTA Q     SEGMENT";                 <<03076>>03573000
     IF PMAPFILE <> 0 THEN                                     <<03076>>03575000
         MOVE BBUF(86):="OFFSET/PROCEDURE         MOD/PRODUCT";<<03076>>03577000
     PRINTLINE;                                                <<03076>>03579000
     SKIPLINES(1);                                             <<03076>>03581000
     MARKERS'OK:=FALSE;    <<ASSUME BAD MARKERS>>              <<03076>>03583000
     WORK2:=CORE(SCRATCH+1D);     <<SET TO PRINT STACK>>       <<03076>>03585000
      IF INTEGER(WORK2) < 1 THEN GO QUIT;                      <<03076>>03587000
     WORK3:=CORE(SCRATCH+9D);                                  <<03076>>03589000
     IF WORK3 <1 THEN GO QUIT;                                 <<03076>>03591000
     <<POINTER TO FIRST DELTA Q>>                              <<03076>>03593000
     SCRATCH2:=SCRATCH+DOUBLE(WORK2)+DOUBLE(WORK3-2);          <<03076>>03595000
     STACKSREG:=SCRATCH2;  <<STACK S REGISTER, SAME AS Q>>     <<03076>>03597000
     IF DSTNB=CDSTN THEN                                       <<03076>>03599000
     BEGIN                << CURRENT STACK >>                  <<03076>>03601000
       QI := CORE(5D);                                         <<03076>>03603000
       IF ZBANKREG = 0 AND                                     <<03076>>03605000
          SREG > QI AND SREG < LOGICAL(CORE(6D)) THEN          <<03076>>03607000
         BEGIN        << ON ICS AT TIME OF DUMP    >>          <<03076>>03609000
          TOS := CORE(DOUBLE(QI) - 5D);  << SBANK FROM ICS >>  <<03076>>03611000
          TOS := CORE(DOUBLE(QI) - 6D) +                       <<03076>>03613000
                 CORE(DOUBLE(QI) - 4D);  << S FROM ICS     >>  <<03076>>03615000
          STACKSREG := TOS;                                    <<03076>>03617000
          SCRATCH2 := STACKSREG - 2D;    << Q := S - 2     >>  <<03076>>03619000
         END                                                   <<03076>>03621000
         ELSE                                                  <<03076>>03623000
          BEGIN       << NOT ON ICS AT TIME OF DUMP >>         <<03076>>03625000
           TOS := ZBANKREG;                                    <<03076>>03627000
           TOS := QREG;                                        <<03076>>03629000
           SCRATCH2 := TOS;                                    <<03076>>03631000
           TOS := ZBANKREG;                                    <<03076>>03633000
           TOS := SREG;                                        <<03076>>03635000
           STACKSREG := TOS;                                   <<03076>>03637000
          END;                                                 <<03076>>03639000
     END;                                                      <<03076>>03641000
     STACKMARKER:=SCRATCH2;   <<REMEMBER TOP MARKER>>          <<03076>>03643000
     INITQ:=CORE(SCRATCH+10D);                                 <<03076>>03645000
                                                               <<03076>>03647000
     WHILE SCRATCH2 > SCRATCH5 DO   <<MARKER ABOVE INIT Q>>    <<03076>>03649000
     BEGIN                                                     <<03076>>03651000
       IF SCRATCH2 < 3D THEN GO QUIT;                          <<03076>>03653000
       @PBUF:=@BBUF;                                           <<03076>>03655000
       TOS:=SCRATCH2;                                          <<03076>>03657000
       WORK2:=TOS;                                             <<03076>>03659000
       WORK3:=TOS;                                             <<03076>>03661000
       PUTNUM(WORK2);     <<ADDRESS>>                          <<03076>>03663000
         @PBUF:=@BBUF + 8; <<DUMP BANK NUMBER>>                <<03076>>03665000
       PUTNUMP(WORK3);     <<BANK>>                            <<03076>>03667000
       WORK2:=CORE(SCRATCH2-3D);     <<X>>                     <<03076>>03669000
       @PBUF:=@BBUF+22;                                        <<03076>>03671000
       PUTNUM(WORK2);                                          <<03076>>03673000
       WORK2:=CORE(SCRATCH2-2D);     <<DELTA P>>               <<03076>>03675000
       WORK3:=WORK2;           <<SAVE THE DELTA P>>            <<03076>>03677000
       @PBUF:=@BBUF+32;                                        <<03076>>03679000
       PUTNUM(WORK2);                                          <<03076>>03681000
       WORK2:=CORE(SCRATCH2-1D);                               <<03076>>03683000
       @PBUF:=@BBUF+42;                                        <<03076>>03685000
       PUTNUM(WORK2);     <<STATUS>>                           <<03076>>03687000
       @PBUF:=@BBUF+60;                                        <<03076>>03689000
       WORK2:=WORK2.(8:8);                                     <<03076>>03691000
       IF WORK2 > %277 THEN        <<USER SEGMENT>>            <<03076>>03693000
         BEGIN                                                 <<03076>>03695000
           PUTNUMP(WORK2);                                     <<03076>>03697000
           MOVE PBUF:=" USER SEGMENT";                         <<03076>>03699000
         END                                                   <<03076>>03701000
        ELSE                                                   <<03076>>03703000
         BEGIN                     <<CST SEGMENT>>             <<03076>>03705000
           PUTNUMP(WORK2);                                     <<03076>>03707000
           NAMECST(WORK2);         <<NAME FROM LOADMAP>>       <<03076>>03709000
           NAMEPROC(WORK2,WORK3,86,112,115);  <<NAME IT>>      <<03076>>03711000
         END;                                                  <<03076>>03713000
       DELTQ:=CORE(SCRATCH2);                                  <<03076>>03715000
       @PBUF:=@BBUF+52;                                        <<03076>>03717000
       PUTNUM(DELTQ);                                          <<03076>>03719000
       PRINTLINE;                                              <<03076>>03721000
       IF DELTQ < 1 THEN GO QUIT;                              <<03076>>03723000
       SCRATCH2:=SCRATCH2-DOUBLE(DELTQ);                       <<03076>>03725000
     END;                                                      <<03076>>03727000
     IF SCRATCH2 = SCRATCH5 THEN MARKERS'OK:=TRUE;  <<GOOD>>   <<03076>>03729000
     @PBUF:=@BBUF+9;                                           <<03076>>03731000
QUIT:                                                          <<03076>>03733000
     SKIPLINES(2);     <<STACK MARKER PRINTED>>                <<03076>>03735000
     RETURN;                                                   <<03076>>03737000
QUITX:                 <<NOT A STACK, OR NOT PRINTABLE>>       <<03076>>03739000
   END;                                                        <<03076>>03741000
                                                                        03743000
$PAGE "DSTTOADDR(DSTNO): Find address of given DST"                     03745000
$CONTROL SEGMENT=UTIL                                          <<03076>>03747000
DOUBLE PROCEDURE DSTTOADDR(DSTNO);                             <<03076>>03749000
VALUE DSTNO;                                                   <<03076>>03751000
LOGICAL DSTNO;                                                 <<03076>>03753000
COMMENT                                                                 03755000
                                                                        03757000
Purpose:                                                                03759000
     Given a DST # as input, looks it up in the DST table,     <<03076>>03761000
     and returns a doubleword bank+address.                    <<03076>>03763000
     A check is made to see if the requested DST is actually   <<04154>>03765000
     present in memory.  If not, an address of 0 is returned.  <<04154>>03767000
     Condition code is returned as follows:                    <<04154>>03769000
                                                               <<04154>>03771000
        CCE - segment present, address returned                <<04154>>03773000
        CCG - segment absent, address of zero returned         <<04154>>03775000
        CCL - not returned                                     <<04154>>03777000
                                                               <<04154>>03779000
                                                                        03781000
Input parameters:                                                       03783000
                                                                        03785000
Output parameters:                                                      03787000
                                                                        03789000
Globals Referenced:                                                     03791000
                                                                        03793000
Globals Altered:                                                        03795000
                                                                        03797000
Data Structures:                                                        03799000
                                                                        03801000
Algorithm:                                                              03803000
                                                                        03805000
;                                                                       03807000
                                                               <<03076>>03809000
BEGIN                                                          <<03076>>03811000
DOUBLE DSTENTRY;  <<ADR OF DSTNO IN DST TABLE>>                <<03076>>03813000
DOUBLE DSTADDR;   <<ADDR OF DST>>                              <<03076>>03815000
                                                               <<03076>>03817000
CC:=CCE;   <<ASSUME SEGMENT IS PRESENT>>                       <<04154>>03819000
DSTENTRY:=DOUBLE(DSTNO*4)+DSTDEFIN; <<ENTRY#OFFSET+TABLE BASE>><<03076>>03821000
IF CORE(DSTENTRY).(0:1) = 1  AND                               <<04154>>03823000
   CORE(DSTENTRY+1D).(1:1)  = 0 THEN BEGIN                     <<04154>>03825000
   <<THE SPECIFIED DST IS NOT IN MEMORY>>                      <<04154>>03827000
   DSTTOADDR:=0D;                                              <<04154>>03829000
   CC:=CCG;                                                    <<04154>>03831000
   RETURN; END;                                                <<04154>>03833000
TOS:=CORE(DSTENTRY+2D);             <<BANKNO OF DST>>          <<03076>>03835000
TOS:=CORE(DSTENTRY+3D);             <<ADDR OF DST>>            <<03076>>03837000
DSTADDR:=TOS;                       << POP BANK+ADDR >>        <<03076>>03839000
DSTTOADDR:=DSTADDR;                 << RETURN VALUE >>         <<03076>>03841000
END;  <<DOUBLE PROCEDURE DSTTOADDR(DSTNO)>>                    <<03076>>03843000
                                                                        03845000
$PAGE "NAMECST(CSTENTRY): use LOADMAP.PUB.SYS to name CSTentry"         03847000
$CONTROL SEGMENT=UTIL                                                   03849000
LOGICAL PROCEDURE NAMECST(CSTENTRY);                           <<01.3A>>03851000
VALUE CSTENTRY;                                                <<01.3A>>03853000
LOGICAL CSTENTRY;                                              <<01.3A>>03855000
COMMENT                                                                 03857000
                                                                        03859000
Purpose:                                                                03861000
     this procedure will name the cst entry                             03863000
     according to the entry in the file                                 03865000
     loadmap.pub.sys.                                                   03867000
     the cst name is returned at pbuf, 17 bytes                         03869000
     There is currently some problem with accessing the loadmap         03871000
     when it is appended to the tape.                                   03873000
                                                                        03875000
Input parameters:                                                       03877000
                                                                        03879000
Output parameters:                                                      03881000
                                                                        03883000
Globals Referenced:                                                     03885000
                                                                        03887000
Globals Altered:                                                        03889000
     NAMECST flags successful naming                                    03891000
     PBUF and @PBUF are buffer for returned name                        03893000
                                                                        03895000
Data Structures:                                                        03897000
                                                                        03899000
Algorithm:                                                              03901000
                                                                        03903000
;                                                                       03905000
BEGIN                                                          <<01.3A>>03907000
                                                               <<01.3A>>03909000
LOGICAL TEMP;                                                  <<01.3A>>03911000
ARRAY TMPBUF(0:63);                                            <<01.3A>>03913000
       BYTE ARRAY BTMPBUF(*)=TMPBUF;                           <<00221>>03915000
DEFINE BTMP=BTMPBUF#; << FOR GSD RECODING >>                   <<00221>>03917000
BYTE POINTER BYYT;                                             <<01.3A>>03919000
                                                               <<01.3A>>03921000
NAMECST:=FALSE;                                                <<01.3A>>03923000
IF SAME'SYS THEN <<DUMPED = THIS SYSTEM>>                      <<01.3A>>03925000
        IF CSTENTRY < %301 THEN    <<IN RANGE SEGMENT>>        <<00221>>03927000
          BEGIN                                                <<00221>>03929000
            IF LMAPFNUM <> 0 THEN                              << WBT >>03931000
  BEGIN                                                        <<01.3A>>03933000
    IF SERIES=0 THEN TEMP:=CSTENTRY ELSE                       <<01.3A>>03935000
    TEMP:=(CSTENTRY MOD 50)+4;                                 <<01.3A>>03937000
    FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));                   <<01.3A>>03939000
    IF <> THEN RETURN;                                         <<01.3A>>03941000
    IF SERIES=0 THEN TEMP:=4 ELSE                              <<01.3A>>03943000
    TEMP:=((CSTENTRY/50)*32)+4;                                <<01.3A>>03945000
    @BYYT:=LOGICAL(@BTMP)+TEMP;                                <<01.3A>>03947000
MOVIT:                                                         <<01.3A>>03949000
                                                               <<01.3A>>03951000
    MOVE PBUF:=BYYT WHILE ANS,0;                               <<01.3A>>03953000
    @BYYT:=TOS;                                                <<01.3A>>03955000
    @PBUF:=TOS;<<SAVE POINTER ADDRESSES>>                      <<01.3A>>03957000
    IF BYYT="'" THEN                                           <<01.3A>>03959000
    BEGIN                                                      <<01.3A>>03961000
      PBUF:="'";                                               <<01.3A>>03963000
      @PBUF:=@PBUF+1;                                          <<01.3A>>03965000
      @BYYT:=@BYYT+1;                                          <<01.3A>>03967000
      GO MOVIT;                                                <<01.3A>>03969000
    END;                                                       <<01.3A>>03971000
    IF BYYT=" (" THEN                                          <<01.3A>>03973000
    BEGIN                                                      <<01.3A>>03975000
      MOVE PBUF:=BYYT,(6);<<MOVE 6 MORE BYTES>>                <<00221>>03977000
      @PBUF:=@PBUF+6;                                          <<00221>>03979000
    END;                                                       <<00221>>03981000
         <<IF PMAPFILE<>0 AND PROCINDEX(CSTENTRY)=0 THEN>>     <<02012>>03983000
         <<PBUF:="?";>>                                        <<02012>>03985000
         @PBUF:=@PBUF+1;                                       << WBT >>03987000
    NAMECST:=TRUE;                                             <<00221>>03989000
              END;                 <<ACCESSING LOADMAP>>       <<00221>>03991000
          END;                                                 <<00221>>03993000
   END;                                                        <<00221>>03995000
                                                                        03997000
$PAGE "NAMEPROC: Name procedure in given segment"                       03999000
$CONTROL SEGMENT=UTIL                                                   04001000
PROCEDURE NAMEPROC(SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL);          <<00221>>04003000
  VALUE SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL;                      <<00221>>04005000
  LOGICAL SEGMENT,DELTAP;                                      <<00221>>04007000
  INTEGER DPCOL,MDCOL,PDCOL;    <<COLUMNS FOR OUTPUT>>         <<00221>>04009000
COMMENT                                                                 04011000
                                                                        04013000
Purpose:                                                                04015000
<<            NAME PROCEDURE                       >>          <<00221>>04017000
<<     THIS PROCEDURE WILL NAME THE PROCEDURE IN   >>          <<00221>>04019000
<<     THE SPECIFIED SEGMENT ALONG WITH THE DELTA  >>          <<00221>>04021000
<<     P, THE SOURCE MODULE NUMBER, AND THE PRODUCT>>          <<00221>>04023000
<<     NUMBER.  THIS INFORMATION IS OBTAINED FROM  >>          <<00221>>04025000
<<     THE FILE MPEPMAP.PUB.SYS.  IF THE FILE IS   >>          <<00221>>04027000
<<     NOT ON THE SYSTEM, NOTHINS IS PRINTED.  IF  >>          <<00221>>04029000
<<     THE FILE IS ON THE SYSTEM, THE HEADER RECORD>>          <<00221>>04031000
<<     THAT CONTAINS THE VERSION AND FIX MUST MATCH>>          <<00221>>04033000
<<     THE VERSION AND FIX ON THE SYSTEM.  ALSO,   >>          <<00221>>04035000
<<     THE SEGMENT LENGTHS MUST MATCH IN THE CST   >>          <<00221>>04037000
<<     AND IN THE FILE.                            >>          <<00221>>04039000
It seems that this code has fallen into disuse since there is           04041000
no rigorous maintainance of the MPEPMAP file from system to             04043000
system. Perhaps this procedure could use the SL instead.                04045000
                                                                        04047000
Input parameters:                                                       04049000
                                                                        04051000
Output parameters:                                                      04053000
                                                                        04055000
Globals Referenced:                                                     04057000
                                                                        04059000
Globals Altered:                                                        04061000
                                                                        04063000
Data Structures:                                                        04065000
                                                                        04067000
Algorithm:                                                              04069000
                                                                        04071000
;                                                                       04073000
                                                               <<00221>>04075000
  BEGIN                        <<NAME THE PROCEDURE>>          <<00221>>04077000
   INTEGER J;                  <<COUNTER>>                     <<00221>>04079000
   LOGICAL I,K,CORRECT;        <<FOR ASSEMBLING RELATIVE P>>   <<00221>>04081000
   LOGICAL ININFLAG;           <<HANDLE SPECIAL ININ>>         <<00221>>04083000
   LOGICAL ARRAY LNLINE(0:39);          <<FOR FREADDIR>>       <<00221>>04085000
   BYTE ARRAY NLINE(*)=LNLINE; <<LINE BUFFER>>                 <<00221>>04087000
   BYTE ARRAY OLINE(*)=LNLINE(20); <<OLD LINE BUFFER>>         <<00221>>04089000
   DOUBLE PMAPREC;             <<RECORD POINTER>>              <<00221>>04091000
   IF PROCINDEX(SEGMENT)+1 > 1 THEN                            <<00221>>04093000
    BEGIN                      <<SEGMENT MAP IS IN THE FILE>>  <<00221>>04095000
     PMAPREC:=DOUBLE(PROCINDEX(SEGMENT))+1D;    <<START SCAN>> <<00221>>04097000
     CORRECT:=0;              <<ASSUME NORMAL SEGMENT>>        <<00221>>04099000
     ININFLAG:= (SEGMENT = 1); <<IS ININ IF SEGMENT#=1>>       <<00221>>04101000
     NLINE:=" "; MOVE NLINE(1):=NLINE,(79);    <<BLANK>>       <<00221>>04103000
     I:=0;                      <<INITIAL FOUND DELTA P>>      <<00221>>04105000
     DO                                                        <<00221>>04107000
      BEGIN                    <<TILL END OF LIST>>            <<00221>>04109000
       K:=I;                   <<REMEMBER VERIFIED BASE ADDR>> <<00221>>04111000
       IF NLINE(18) <> OLINE(18),(6) THEN                      <<00221>>04113000
         MOVE OLINE:=NLINE,(40);       <<SAVE THE CANDIDATE>>  <<00221>>04115000
       FREADDIR(PMAPFILE,LNLINE,-40,PMAPREC);  <<GET REC>>     <<00221>>04117000
       IF <> THEN GO DONE;     <<IF PAST END>>                 <<00221>>04119000
       PMAPREC:=PMAPREC+1D;    <<FOR NEXT RECORD>>             <<00221>>04121000
       I:=0;    J:=0;     <<TEMP P, COUNTER>>                  <<00221>>04123000
       DO                                                      <<00221>>04125000
        BEGIN             <<CONVERT DELTA P TEXT>>             <<00221>>04127000
         I:=(I&LSL(3)) + (LOGICAL(NLINE(18+J)).(13:3));<<CONV> <<00221>>04129000
        END  UNTIL (J:=J+1) = 6;   <<PROC BASE TO I IN BINARY> <<00221>>04131000
       IF ININFLAG THEN        <<SPECIAL IF SEG=ININ>>         <<00221>>04133000
        IF I>0 THEN            <<FIRST SEGMENT IN ININ??>>     <<00221>>04135000
         BEGIN                 <<YES, COMPUTE CORRECTION>>     <<00221>>04137000
          CORRECT:=I;          <<THIS IS FOR PLABELS>>         <<00221>>04139000
          ININFLAG:=FALSE;     <<DISABLE THIS CHECK>>          <<00221>>04141000
         END;                  <<COMPUTE CORRECTION>>          <<00221>>04143000
       I:=I-CORRECT;           <<CORRECT FOR ININ AS NEEDED>>  <<00221>>04145000
      END                                                      <<00221>>04147000
       UNTIL (NLINE <> " " OR I > DELTAP);  <<LARGER ADDRESS>> <<00221>>04149000
DONE:               <<PROCEDURE NAME AND INFO IN OLINE>>       <<00221>>04151000
                                                               <<00221>>04153000
      I:=DELTAP-K;       <<RELATIVE DELTA P IN PROCEDURE>>     <<00221>>04155000
      @PBUF:=@BBUF+DPCOL;     <<WHERE DELTA P GOES>>           <<00221>>04157000
                                                               <<00221>>04159000
      PUTNUMP(I);        <<PUT RELATIVE DELTA P>>              <<00221>>04161000
      MOVE PBUF:=OLINE(1),(16);  <<MOVE THE NAME>>             <<00221>>04163000
      IF MDCOL > 0 THEN MOVE BBUF(MDCOL):=OLINE(32),(2);       <<00221>>04165000
      IF PDCOL > 0 THEN                                        <<00221>>04167000
       BEGIN                 <<DESIRE PRODUCT NAME>>           <<00221>>04169000
        I:=PDCOL+2;           <<PRODUCT NUMBER>>               <<00221>>04171000
        MOVE BBUF(PDCOL):="HP";  <<PREFIX>>                    <<00221>>04173000
        MOVE BBUF(I):=OLINE(34),(6);    <<PRODUCT NUMBER>>     <<00221>>04175000
        IF BBUF(I)="32002" THEN                                <<00221>>04177000
         MOVE BBUF(PDCOL):="MPE    ";       <<WAS MPE>>        <<00221>>04179000
        IF BBUF(I)="30131" THEN                                <<00221>>04181000
         MOVE BBUF(PDCOL):="CS     ";       <<COMMUNICATIONS>> <<00221>>04183000
        IF BBUF(I)="3219"  THEN                                <<00221>>04185000
         MOVE BBUF(PDCOL):="DS3000 ";       <<DISTRIBUTED 3K>> <<00221>>04187000
        IF BBUF(I)="32195" THEN                                <<00221>>04189000
         MOVE BBUF(PDCOL):="DS1000 ";       <<DISTRIBUTED 1K>> <<00221>>04191000
        IF BBUF(I)="32192" THEN                                <<00221>>04193000
         MOVE BBUF(PDCOL):="MRJE   ";       <<HASP MRJE>>      <<00221>>04195000
        IF BBUF(I)="32215" THEN                                <<00221>>04197000
         MOVE BBUF(PDCOL):="IMAGE  ";       <<IMAGE>>          <<00221>>04199000
        IF BBUF(I)="32208" THEN                                <<00221>>04201000
         MOVE BBUF(PDCOL):="KSAM   ";       <<KSAM>>           <<00221>>04203000
       END;                                                    <<00221>>04205000
    END;                                 <<SEGMENT IN MAP>>    <<00221>>04207000
  END;                           <<NAME SEGMENT>>              <<00221>>04209000
                                                                        04211000
$PAGE "VERIFYTBL: Compute base addresses for system DSTs"               04213000
$CONTROL SEGMENT=INIT                                          <<00221>>04215000
COMMENT                                                                 04217000
                                                                        04219000
Purpose:                                                                04221000
<<           COMPUTE BASE ADDRESS FOR SEGMENTS         >>      <<00221>>04223000
<<     THIS PROCEDURE COMPUTES THE BASE ADDRESS FOR    >>      <<00221>>04225000
<<     THE SYSTEM DST SEGMENTS.  THE DST, LOW CORE     >>      <<00221>>04227000
<<     AND SYSTEM GLOBAL LOCATIONS ARE USED TO VERIFY  >>      <<00221>>04229000
<<     THAT THE CORRECT ADDRESS IS ASSUMED.  IF A      >>      <<00221>>04231000
<<     DESCREPENCY EXISTS, A MESSAGE WILL BE PRINTED   >>      <<00221>>04233000
<<     AND A COMBINATION MAJORITY ALGORITHM AND        >>      <<00221>>04235000
<<     VALIDATED TABLE ENTRY SIZE WILL BE USED TO      >>      <<00221>>04237000
<<     SELECT A LIKELY ADDRESS TO BE USED IN PRODUCING >>      <<00221>>04239000
<<     THE DPAN DUMP.                                  >>      <<00221>>04241000
                                                               <<00221>>04243000
<<     THE ARRAY DSTDEF IS UPDATED AND CONTAINS ENCODED>>      <<00221>>04245000
<<      INFORMATION AS FOLLOWS:                        >>      <<00221>>04247000
<<    BIT      MEANING                                 >>      <<00221>>04249000
<<     15    PRESENT AND DEFINED                       >>      <<00221>>04251000
<<     14    ALL POINTERS TO DST AGREE                 >>      <<00221>>04253000
<<     13    DST POINTER OK                            >>      <<00221>>04255000
<<     12    SYSGLOB POINTER OK                        >>      <<00221>>04257000
<<     11    LOW CORE POINTER OK                       >>      <<00221>>04259000
<<     10    ASSUMED LOCATION OK                       >>      <<00221>>04261000
<<      9    **RESERVED**                              >>      <<00221>>04263000
<<      8    TABLE FORMATTED WITH NO ERRORS            >>      <<00221>>04265000
<<      7    ENTRY SIZE VERIFIED AND IS OK             >>      <<00221>>04267000
<<      6    ENTRY SIZE IS WRONG                       >>      <<00221>>04269000
                                                                        04271000
Input parameters:                                                       04273000
                                                                        04275000
Output parameters:                                                      04277000
                                                                        04279000
Globals Referenced:                                                     04281000
                                                                        04283000
Globals Altered:                                                        04285000
                                                                        04287000
Data Structures:                                                        04289000
                                                                        04291000
Algorithm:                                                              04293000
                                                                        04295000
;                                                                       04297000
                                                               <<00221>>04299000
                                                               <<00221>>04301000
PROCEDURE VERIFYTBL;                                           <<00221>>04303000
    BEGIN                  <<PROCEDURE VERIFYTBL>>             <<00221>>04305000
      LOGICAL ARRAY DSTGLOB(0:LSTSYSDST) = PB:=  <<SYSGLOB>>   <<00221>>04307000
          0,1,2,3,0,0,0,0,             <<00-07>>               <<00221>>04309000
          6,0,0,5,%16,%10,0,0,         <<10-17>>               <<00221>>04311000
          %55,0,0,%12,0,0,0,0,         <<20-27>>               << WBT >>04313000
          %15,0,0,0,0,0,0,0,           <<30-37>>               << WBT >>04315000
          0,0,0,%51,%13,0,0,%26,       <<40-47>>               << WBT >>04317000
          %41,0,0,%14,0,0,0,0,         <<50-57>>               << WBT >>04319000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>04321000
          %31,0,0,0,0;                 <<70-74>>               <<01924>>04323000
      LOGICAL ARRAY DSTNTRYLOC(0:LSTSYSDST)=PB:= <<SIZE LOCN>> <<00221>>04325000
          0,3,3,3,0,0,0,0,             <<00-07>>               <<00221>>04327000
          3,0,0,3,3,1,0,0,             <<10-17>>               <<00221>>04329000
          0,0,0,3,0,0,0,0,             <<20-27>>               << WBT >>04331000
          0,0,0,0,0,0,0,0,             <<30-37>>               <<00221>>04333000
          0,0,0,0,0,0,0,0,             <<40-47>>               <<00221>>04335000
          0,0,0,0,0,0,0,0,             <<50-57>>               <<00221>>04337000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>04339000
          %3,0,0,0,0;                  <<70-74>>               <<01924>>04341000
      LOGICAL ARRAY DSTNTRYSIZ(0:LSTSYSDST)=PB:=<<ENTRY SIZE>> <<00221>>04343000
          0,4,4,%20,0,0,0,0,           <<00-07>>               <<00221>>04345000
          %201,0,0,%13,%20,%2,0,0,     <<10-17>>               <<00221>>04347000
          0,0,0,4,0,0,0,0,             <<20-27>>               << WBT >>04349000
          0,0,0,0,0,0,0,0,             <<30-37>>               <<00221>>04351000
          0,0,0,0,0,0,0,0,             <<40-47>>               <<00221>>04353000
          0,0,0,0,0,0,0,0,             <<50-57>>               <<00221>>04355000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>04357000
          %20,0,0,0,0;                     <<70-74>>           <<01924>>04359000
      SWITCH CHKDEF:=DEF0,DEF1,DEF1,DEF2,DEF1,DEF2,DEF2,DEF3,  <<00221>>04361000
                     DEF1,DEF2,DEF2,DEF3,DEF2,DEF3,DEF3;       <<00221>>04363000
      LOGICAL ARRAY GUESSMASK(0:63) = PB:=                     <<00221>>04365000
          0,0,0,0, 1,0,0,0, 2,0,0,0, 1,2,0,0,                  <<00221>>04367000
          4,0,0,0, 1,4,0,0, 2,4,0,0, 1,2,4,0,                  <<00221>>04369000
          8,0,0,0, 1,8,0,0, 2,8,0,0, 1,2,8,0,                  <<00221>>04371000
          4,8,0,0, 1,4,8,0, 2,4,8,0, 1,2,4,8;                  <<00221>>04373000
                                                               <<00221>>04375000
      EQUATE DSTMAXCNT=%12;         <<NUMBER TO CHECK USE ON>> <<00221>>04377000
      ENTRY VERIFYUSE;              <<PRINT OUT UTILIZATION>>  <<00221>>04379000
                                                               <<00221>>04381000
      LOGICAL I,J,K,L,NMAX,DSTNDX,FLAGS,FIRSTFLAG;             << WBT >>04383000
      DOUBLE  ARRAY SCRATCH(0:4);                              <<00221>>04385000
      DOUBLE ARRAY SCRATCH1(*)=SCRATCH(1);                     <<00221>>04387000
      DOUBLE ARRAY SCRATCH2(*)=SCRATCH(2);                     <<00221>>04389000
      DOUBLE ARRAY SCRATCH3(*)=SCRATCH(3);                     <<00221>>04391000
      DOUBLE ARRAY SCRATCH4(*)=SCRATCH(4);                     <<00221>>04393000
      DOUBLE ARRAY SCRATCH0(0:3);     <<WORKING FOR COMPARE>>  <<00221>>04395000
      DOUBLE ARRAY SCRATCHA(*)=SCRATCH0;                       <<00221>>04397000
      DOUBLE ARRAY SCRATCHB(*)=SCRATCH0(1);                    <<00221>>04399000
      DOUBLE ARRAY SCRATCHC(*)=SCRATCH0(2);                    <<00221>>04401000
      LOGICAL ARRAY LSCRATCH(*)=SCRATCH; <<REDEFINE>>          <<00221>>04403000
      LOGICAL ARRAY SCRATCH1H(*)=LSCRATCH(2);  <<BANK OF DST>> <<00221>>04405000
      LOGICAL ARRAY SCRATCH1L(*)=LSCRATCH(3); <<OFFSET>>       <<00221>>04407000
      LOGICAL ARRAY DEFN(0:3);         <<RECORD DEFINITIONS>>  <<00221>>04409000
                                                               <<00221>>04411000
      LOGICAL BAD'DEF;                 <<BAD DEFINITION #>>    <<00221>>04413000
    LOGICAL WORKFLAG;        <<WORKING DST FLAG>>              <<00221>>04415000
    DOUBLE XADDR;              <<TEMP FOR SPLITTING>>          <<00221>>04417000
    LOGICAL ARRAY BADDR(*)=XADDR;  <<BANK AND OFFSET>>         <<00221>>04419000
                                                               <<00221>>04421000
$PAGE                                                          <<00221>>04423000
SUBROUTINE PUTADDR(DADDR);     <<PUT BANK AND OFFSET ADDRESS>> <<00221>>04425000
  VALUE DADDR;                                                 <<00221>>04427000
  DOUBLE DADDR;                                                <<00221>>04429000
    BEGIN         <<PRINT THE BANK AND OFFSET>>                <<00221>>04431000
     @PBUF:=@PBUF-4;           <<BANK IS ONLY TWO DIGITS>>     <<00221>>04433000
     XADDR:=DADDR;             <<GET THE ADDRESS>>             <<00221>>04435000
     BADDR:=BADDR.(10:6);      <<BANK ADDRESS>>                <<00221>>04437000
     PUTNUMP(BADDR);           <<OUTPUT BANK ADDRESS>>         <<00221>>04439000
     PUTNUM(BADDR(1));         <<OFFSET IN BANK>>              <<00221>>04441000
    END;          <<PRINT BANK AND OFFSET>>                    <<00221>>04443000
$PAGE                                                          <<00221>>04445000
         BEGIN                      <<VERIFYTBL>>              <<00221>>04447000
   <<FIND PAGE SIZE AND START OF LINKED MEMORY>>               << WBT >>04449000
   SYSGLOBX:=DOUBLE(CORE(%1377D)+%1000);                       << WBT >>04451000
   MMPAGESIZE:=DOUBLE(CORE(SYSGLOBX+5D));                      << WBT >>04453000
           FIRSTFLAG:=TRUE;        <<FIRST TIME IF AN ERROR>>  <<00221>>04455000
           DSTNDX:=2;              <<VERIFY DST FIRST>>        <<00221>>04457000
           BAD'DEF:=0;             <<NO BAD ONE NOW>>          <<00221>>04459000
           DO                                                  <<00221>>04461000
            BEGIN                  <<LOAD ADDRESSES FOR ALL>>  <<00221>>04463000
             IF DSTNDX = 2 THEN                                <<00221>>04465000
              BEGIN                <<IS DST, SPECIAL CASE>>    <<00221>>04467000
                             <<ASSUME DST FOLLOWS SYSGLOB EXT>><<01172>>04469000
               SCRATCH4:=DOUBLE(CORE(%1377D))+%1200D;          <<01172>>04471000
               SCRATCH3:=DOUBLE(CORE(2D));  <<FROM LOW CORE>>  <<00221>>04473000
               SCRATCH2:=DOUBLE(CORE(                          <<00221>>04475000
                 DOUBLE(%1000+DSTGLOB(2)))+%1000);<<SYSGLOB>>  <<00221>>04477000
               IF SCRATCH3 = SCRATCH2  THEN                    <<00221>>04479000
                BEGIN              <<ADDRESS IS OK FOR DST>>   <<00221>>04481000
                 SCRATCH:=SCRATCH2;<<REMEMBER GLOBAL>>         <<00221>>04483000
                 SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D)); <<DST> <<00221>>04485000
                 IF SCRATCH1 = SCRATCH3 THEN                   <<00221>>04487000
                   WORKFLAG:=%37   <<SO ALL OK>>               <<00221>>04489000
                 ELSE                                          <<00221>>04491000
                  BEGIN            <<TRY %1400 - - LONG SHOT>> <<00221>>04493000
                   BAD'DEF:=1;      <<DST IS BAD>>             <<00221>>04495000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH4+%13D));      <<01172>>04497000
                   IF SCRATCH1 = SCRATCH4 THEN WORKFLAG:=%45   <<01172>>04499000
                                        ELSE WORKFLAG:=0;      <<00221>>04501000
                  END;             <<TRY %1400 - - LONG SHOT>> <<00221>>04503000
                END                <<ADDRESS IS OK FOR DST>>   <<00221>>04505000
               ELSE                                            <<00221>>04507000
                BEGIN              <<LOW CORE <> SYSGLOB>>     <<00221>>04509000
                  IF SCRATCH3 = SCRATCH4 THEN                  <<01172>>04511000
                  BEGIN          <<GUESS LOW CORE, THEN GLOB>> <<00221>>04513000
                   BAD'DEF:=2;      <<GLOBAL IS BAD>>          <<00221>>04515000
                   SCRATCH:=SCRATCH3;  <<GET FROM LOW CORE>>   <<00221>>04517000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D));      <<00221>>04519000
                   IF SCRATCH1 = SCRATCH3 THEN WORKFLAG:=%25   <<00221>>04521000
                    ELSE                                       <<00221>>04523000
                     BEGIN         <<LAST CHANCE IS SYSGLOB>>  <<00221>>04525000
                      SCRATCH1:=DOUBLE(CORE(SCRATCH2+%13D));   <<00221>>04527000
                      IF SCRATCH1=SCRATCH2 THEN WORKFLAG:=%11  <<00221>>04529000
                                             ELSE WORKFLAG:=0; <<00221>>04531000
                      BAD'DEF:=IF WORKFLAG THEN 3 ELSE 2;      <<00221>>04533000
                     END;          <<LAST CHANCE IS SYSGLOB>>  <<00221>>04535000
                  END            <<GUESS LOW CORE, THEN GLOB>> <<00221>>04537000
                 ELSE                                          <<00221>>04539000
                  BEGIN      <<GUESS SYSGLOB, THEN LOW CORE>>  <<00221>>04541000
                   BAD'DEF:=3;      <<LOW CORE IS BAD>>        <<00221>>04543000
                   SCRATCH:=SCRATCH2;  <<LOAD FROM GLOBAL>>    <<00221>>04545000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH2+%13D));      <<00221>>04547000
                   IF SCRATCH1 = SCRATCH2 THEN WORKFLAG:=%15   <<00221>>04549000
                    ELSE                                       <<00221>>04551000
                     BEGIN         <<LAST CHANCE IS LOW CORE>> <<00221>>04553000
                      SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D));   <<00221>>04555000
                      IF SCRATCH1=SCRATCH3 THEN WORKFLAG:=%21  <<00221>>04557000
                                             ELSE WORKFLAG:=0; <<00221>>04559000
                     END;          <<LAST CHANCE IS LOW CORE>> <<00221>>04561000
                  END;       <<GUESS SYSGLOB, THEN LOW CORE>>  <<00221>>04563000
                END;               <<LOW CORE <> SYSGLOB>>     <<00221>>04565000
              END                  <<IS DST, SPECIAL CASE>>    <<00221>>04567000
             ELSE                                              <<00221>>04569000
              BEGIN                <<ALL SEGMENTS EXCEPT DST>> <<00221>>04571000
               SCRATCH1:=0D;       <<NOT PRESENT YET>>         <<00221>>04573000
               SCRATCH2:=0D;       <<ASSUME NO SYSDB>>         <<00221>>04575000
               SCRATCH3:=0D;       <<LOW CORE>>                <<00221>>04577000
               SCRATCH4:=0D;       <<ASSUMED VALUE>>           <<00221>>04579000
               SCRATCHA:=0D;                                   <<00221>>04581000
               SCRATCHB:=0D;                                   <<00221>>04583000
               SCRATCHC:=0D;                                   <<00221>>04585000
               IF DSTNDX < %10 THEN                            <<00221>>04587000
                CASE DSTNDX OF                                 <<00221>>04589000
                 BEGIN        <<POSSIBLE LOW CORE OR ASSUMED>> <<00221>>04591000
                  ;    <<0>>                                   <<00221>>04593000
                  SCRATCH3:=DOUBLE(CORE(0D)); <<CST LOW CORE>> <<00221>>04595000
                  ;    <<DST IS SPECIAL CASE>>                 <<00221>>04597000
                  SCRATCH3:=DOUBLE(CORE(3D)); <<PCB LOW CORE>> <<00221>>04599000
                  ;    <<NO HELP FOR CSTX>>                    <<00221>>04601000
                  SCRATCH4:=%1000D;            <<SYSGLOB>>     <<00221>>04603000
                  SCRATCH4:=0D;                <<LOW CORE>>    <<00221>>04605000
                  SCRATCH3:=DOUBLE(CORE(5D))-%100D; <<ICS>>    << WBT >>04607000
                 END;         <<POSSIBLE LOW CORE OR ASSUMED>> <<00221>>04609000
               IF DSTGLOB(DSTNDX) <> 0 THEN                    <<00221>>04611000
                SCRATCH2:=DOUBLE(CORE(%1000D+                  <<00221>>04613000
                       DOUBLE(DSTGLOB(DSTNDX)))+%1000);        <<00221>>04615000
                                                               <<00221>>04617000
               SCRATCH:=DSTADDR(2)+DOUBLE(DSTNDX*4); <<DST>>   <<00221>>04619000
               IF DSTDEF(2) THEN        <<DEFINED DST>>        <<00221>>04621000
               IF CORE(SCRATCH).(0:1) = 0 LAND                 <<00221>>04623000
                  (CORE(SCRATCH).(1:15) <> 0 LAND              <<00221>>04625000
                   CORE(SCRATCH+3D) <> 0 )    THEN             <<00221>>04627000
               BEGIN          <<DEFINED IN DST>>               <<00221>>04629000
                SCRATCH1H:=CORE(SCRATCH+2D);  <<BANK>>         << WBT >>04631000
                SCRATCH1L:=CORE(SCRATCH+3D);       <<OFFSET>>  <<00221>>04633000
               END;           <<DEFINED IN DST>>               <<00221>>04635000
            <<** CHECK AND VERIFY DST DEFINITION>>             <<00221>>04637000
               J:=0;   I:=1;    <<SCANNERS>>                   <<00221>>04639000
               FLAGS:=0;        <<DEFINITION SOURCES>>         <<00221>>04641000
               DO                                              <<00221>>04643000
               BEGIN        <<CHECK DST, GLOB, LOW, ASSUMED>>  <<00221>>04645000
                FLAGS:=FLAGS&LSR(1);   <<UPDATE BIT MASK>>     <<00221>>04647000
               IF SCRATCH(I)<>0D THEN                          <<00221>>04649000
                BEGIN            <<HAVE A POINTER>>            <<00221>>04651000
                 SCRATCH0(J):=SCRATCH(I);  <<SAVE GUESS>>      <<00221>>04653000
                 DEFN(J):=I;    <<RECORD WHAT GUESS IS>>       <<00221>>04655000
                 J:=J+1;         <<UPDATE FOR NEXT GUESS>>     <<00221>>04657000
                 FLAGS:=FLAGS+%40;  <<REMEMBER THIS IS HERE>>  <<00221>>04659000
                END;             <<HAVE A POINTER>>            <<00221>>04661000
               END UNTIL (I:=I+1)>4;  <<ALL LOOKED AT>>        <<00221>>04663000
                                                               <<00221>>04665000
               IF DSTNDX=6 THEN FLAGS:=%44;                    <<00221>>04667000
                                                               <<00221>>04669000
               I:=DSTNTRYSIZ(DSTNDX);  <<ENTRY SIZE>>          <<00221>>04671000
               J:=DSTNTRYLOC(DSTNDX);  <<ENTRY LOCN>>          <<00221>>04673000
               BAD'DEF:=0;             <<NOT BAD YET>>         <<00221>>04675000
               GOTO CHKDEF(FLAGS&LSR(2));   <<SWITCH>>         <<00221>>04677000
$PAGE                                                          <<00221>>04679000
DEF0:    <<TABLE IS NOT DEFINED ANYWHERE>>                     <<00221>>04681000
              SCRATCH:=0D;       <<DUMMY ADDRESS>>             <<00221>>04683000
              WORKFLAG:=0;       <<NOT DEFINED>>               <<00221>>04685000
              GOTO DEFX;         <<GO CLEAN UP>>               <<00221>>04687000
                                                               <<00221>>04689000
DEF1:    <<TABLE IS DEFINED FROM ONE SOURCE>>                  <<00221>>04691000
              WORKFLAG:=FLAGS + 3; <<DEFINED AND PTRS AGREE>>  <<00221>>04693000
              SCRATCH:=SCRATCHA;     <<REMEMBER DEFINITION>>   <<00221>>04695000
              IF J<>0 THEN                                     <<00221>>04697000
               BEGIN            <<CAN VERIFY ENTRY SIZE>>      <<00221>>04699000
                K:=CORE(SCRATCHA+DOUBLE(J&LSR(1)));            <<00221>>04701000
                K:=IF J THEN K.(8:8) ELSE K.(0:8);             <<00221>>04703000
                WORKFLAG.(6:2):=IF K=I THEN 1 ELSE 2;          <<00221>>04705000
               END;             <<CAN VERIFY ENTRY SIZE>>      <<00221>>04707000
              GOTO DEFX;                                       <<00221>>04709000
                                                               <<00221>>04711000
DEF2:    <<TABLE IS DEFINED IN TWO SOURCES>>                   <<00221>>04713000
              WORKFLAG:=FLAGS;   <<REMEMBER DEFN FIELDS>>      <<00221>>04715000
              IF SCRATCHA=SCRATCHB THEN  <<MATCH??>>           <<00221>>04717000
               BEGIN             <<POINTERS DO AGREE>>         <<00221>>04719000
                WORKFLAG:=WORKFLAG+3;  <<DEFINED AND AGREE>>   <<00221>>04721000
                SCRATCH:=SCRATCHA;     <<REMEMBER VALUE>>      <<00221>>04723000
                IF J<>0 THEN                                   <<00221>>04725000
                 BEGIN           <<CHECK OUT ENTRYSIZE>>       <<00221>>04727000
                  K:=CORE(SCRATCHA+DOUBLE(J&LSR(1)));          <<00221>>04729000
                  K:=IF J THEN K.(8:8) ELSE K.(0:8);           <<00221>>04731000
                  WORKFLAG.(6:2):=IF K=I THEN 1 ELSE 2;        <<00221>>04733000
                 END;            <<CHECK OUT ENTRYSIZE>>       <<00221>>04735000
               END               <<POINTERS DO AGREE>>         <<00221>>04737000
              ELSE                                             <<00221>>04739000
               BEGIN             <<POINTERS DISAGREE>>         <<00221>>04741000
                IF J<>0 THEN                                   <<00221>>04743000
                BEGIN            <<TRY BY ENTRY SIZE>>         <<00221>>04745000
                K:=CORE(SCRATCHA+DOUBLE(J&LSR(1)));            <<00221>>04747000
                K:=IF J THEN K.(8:8) ELSE K.(0:8);             <<00221>>04749000
                L:=CORE(SCRATCHB+DOUBLE(J&LSR(1)));            <<00221>>04751000
                L:=IF J THEN L.(8:8) ELSE L.(0:8);             <<00221>>04753000
                IF I=L LOR I=K THEN                            <<00221>>04755000
                 BEGIN           <<THERE IS A CANDIDATE>>      <<00221>>04757000
                  IF I=K THEN                                  <<00221>>04759000
                   BEGIN         <<TAKE FIRST GUESS>>          <<00221>>04761000
                    WORKFLAG.(10:4):=GUESSMASK(FLAGS);         <<00221>>04763000
                    SCRATCH:=SCRATCHA;   <<TAKE GUESS>>        <<00221>>04765000
                    BAD'DEF:=DEFN(1);    <<REMEMBER BAD ONE>>  <<00221>>04767000
                   END           <<TAKE FIRST GUESS>>          <<00221>>04769000
                  ELSE                                         <<00221>>04771000
                   BEGIN         <<TAKE SECOND GUESS>>         <<00221>>04773000
                    WORKFLAG.(10:4):=GUESSMASK(FLAGS+1);       <<00221>>04775000
                    SCRATCH:=SCRATCHB;  <<TAKE GUESS>>         <<00221>>04777000
                    BAD'DEF:=DEFN;     <<REMEMBER BAD ONE>>    <<00221>>04779000
                   END;          <<TAKE SECOND GUESS>>         <<00221>>04781000
                  WORKFLAG.(14:2):=1;   <<DEFINED,DISAGREE>>   <<00221>>04783000
                  WORKFLAG.(6:2):=1;    <<SIZE OK>>            <<00221>>04785000
                 END             <<THERE IS A CANDIDATE>>      <<00221>>04787000
                ELSE                                           <<00221>>04789000
                 BEGIN           <<NO APPARENT CANDIDATE>>     <<00221>>04791000
                  WORKFLAG:=%1000;    <<ENTRY SIZE ERROR>>     <<00221>>04793000
                  SCRATCH:=0D;        <<NO VALUE>>             <<00221>>04795000
                  BAD'DEF:=-1;         <<ALL ARE BAD>>         <<00221>>04797000
                 END;            <<NO APPARENT CANDIDATE>>     <<00221>>04799000
                END              <<TRY BY ENTRY SIZE>>         <<00221>>04801000
               ELSE                                            <<00221>>04803000
                BEGIN            <<NO WAY TO TELL, PUNT>>      <<00221>>04805000
                 WORKFLAG:=%0;   <<NO DEFN, NO VERIFICATION>>  <<00221>>04807000
                 SCRATCH:=0D;    <<VALUE TO RECORD>>           <<00221>>04809000
                 BAD'DEF:=-1;    <<ALL ARE BAD>>               <<00221>>04811000
                END;             <<NO WAY TO TELL, PUNT>>      <<00221>>04813000
               END;              <<POINTERS DISAGREE>>         <<00221>>04815000
             GOTO DEFX;                                        <<00221>>04817000
                                                               <<00221>>04819000
DEF3:    <<TABLE IS DEFINED FROM THREE SOURCES>>               <<00221>>04821000
             WORKFLAG:=FLAGS;                                  <<00221>>04823000
             IF SCRATCHA=SCRATCHB AND SCRATCHB=SCRATCHC THEN   <<00221>>04825000
              BEGIN        <<THEY ALL AGREE>>                  <<00221>>04827000
               WORKFLAG:=WORKFLAG+3;                           <<00221>>04829000
               IF J<>0 THEN                                    <<00221>>04831000
                BEGIN        <<TRY TO VALIDATE ENTRY SIZE>>    <<00221>>04833000
                 K:=CORE(SCRATCHA+DOUBLE(J&LSR(1)));           <<00221>>04835000
                 K:=IF J THEN K.(8:8) ELSE K.(0:8);            <<00221>>04837000
                 WORKFLAG.(6:2):=IF I=K THEN 1 ELSE 2;         <<00221>>04839000
                END;         <<TRY TO VALIDATE ENTRY SIZE>>    <<00221>>04841000
               SCRATCH:=SCRATCHA;    <<REMEMBER GUESS>>        <<00221>>04843000
              END          <<THEY ALL AGREE>>                  <<00221>>04845000
             ELSE                                              <<00221>>04847000
              BEGIN        <<TRY A MAJORITY>>                  <<00221>>04849000
               IF   SCRATCHA=SCRATCHB  LOR                     <<00221>>04851000
                    SCRATCHB=SCRATCHC LOR                      <<00221>>04853000
                    SCRATCHA=SCRATCHC  THEN                    <<00221>>04855000
                BEGIN        <<HAVE A MAJORITY, USE IT>>       <<00221>>04857000
                 WORKFLAG:=1;   <<DEFINED>>                    <<00221>>04859000
                 IF SCRATCHA = SCRATCHB LOR                    <<00221>>04861000
                    SCRATCHA = SCRATCHC THEN                   <<00221>>04863000
                  BEGIN      <<USE FIRST GUESS>>               <<00221>>04865000
                   SCRATCH:=SCRATCHA;   <<RECORD GUESS>>       <<00221>>04867000
                   BAD'DEF:=DEFN(1);    <<REMEMBER BAD ONE>>   <<00221>>04869000
                   WORKFLAG.(10:4):=GUESSMASK(FLAGS);          <<00221>>04871000
                  END        <<USE FIRST GUESS>>               <<00221>>04873000
                 ELSE                                          <<00221>>04875000
                  BEGIN      <<USE SECOND GUESS>>              <<00221>>04877000
                   SCRATCH:=SCRATCHB;   <<RECORD GUESS>>       <<00221>>04879000
                   BAD'DEF:=DEFN;       <<REMEMBER BAD ONE>>   <<00221>>04881000
                   WORKFLAG.(10:4):=GUESSMASK(FLAGS+1);        <<00221>>04883000
                  END;       <<USE SECOND GUESS>>              <<00221>>04885000
                 IF J<>0 THEN                                  <<00221>>04887000
                  BEGIN      <<VALIDATE ENTRY SIZE>>           <<00221>>04889000
                   K:=CORE(SCRATCH+DOUBLE(J&LSR(1)));          <<00221>>04891000
                   K:=IF J THEN K.(8:8) ELSE K.(0:8);          <<00221>>04893000
                   WORKFLAG.(6:2):=IF I=K THEN 1 ELSE 2;       <<00221>>04895000
                  END;       <<VALIDATE ENTRY SIZE>>           <<00221>>04897000
                END          <<HAVE A MAJORITY, USE IT>>       <<00221>>04899000
               ELSE                                            <<00221>>04901000
                BEGIN        <<THREE DIFFERENT VALUES>>        <<00221>>04903000
                 WORKFLAG:=0;                                  <<00221>>04905000
                 SCRATCH:=0D;                                  <<00221>>04907000
                 BAD'DEF:=-1;    <<ALL ARE BAD>>               <<00221>>04909000
                END;         <<THREE DIFFERENT VALUES>>        <<00221>>04911000
              END;           <<TRY A MAJORITY>>                <<00221>>04913000
              GOTO DEFX;                                       <<00221>>04915000
                                                               <<00221>>04917000
DEFX:                                                          <<00221>>04919000
              END;                 <<ALL SEGMENTS EXCEPT DST>> <<00221>>04921000
             DSTADDR(DSTNDX):=SCRATCH;                         <<00221>>04923000
             DSTDEF(DSTNDX):=WORKFLAG;    <<SAVE FOR REF>>     <<00221>>04925000
         IF DSTNDX=2 THEN                                      <<01791>>04927000
           BEGIN TOS:=SCRATCH; DSTFLG:=TOS; DEL; END;          <<01791>>04929000
             IF BAD'DEF <> 0 THEN                              <<00221>>04931000
              BEGIN           <<ERROR ON DST>>                 <<00221>>04933000
               IF 1 <= INTEGER(DSTNDX) <= 3 THEN               <<01080>>04935000
                 BAD'DST(DSTNDX-1) := TRUE;                    <<01080>>04937000
               IF FIRSTFLAG THEN                               <<00221>>04939000
                BEGIN         <<FIRST BAD ONE, PRINT HEADER>>  <<00221>>04941000
                 FIRSTFLAG:=FALSE;                             <<00221>>04943000
                 NEWPAGE;     <<NEW PAGE>>                     <<00221>>04945000
                 MOVE BBUF(40):=                               <<00221>>04947000
               "****** SYSTEM TABLE DEFINITION ERRORS ******"; <<00221>>04949000
                 PRINTLINE;                                    <<00221>>04951000
                 SKIPLINES(2);                                 <<00221>>04953000
                 MOVE BBUF:="DST     DST DEFINITION";          <<00221>>04955000
       MOVE BBUF(45):="  (DST)    ";   <<DST DEFINITION>>      <<00221>>04957000
       MOVE BBUF(57):="(SYS GLOB) ";   <<SYS GLOB DEFN>>       <<00221>>04959000
       MOVE BBUF(69):="(LOW CORE) ";   <<LOW CORE DEFN>>       <<00221>>04961000
       MOVE BBUF(81):=" (ASSUMED) ";   <<ASSUMED VALUE>>       <<00221>>04963000
       MOVE BBUF(92):="(DEFINITION)   SOURCE OF ERROR";        <<00221>>04965000
                 PRINTLINE;                                    <<00221>>04967000
                 SKIPLINES(1);                                 <<00221>>04969000
                END;          <<FIRST BAD ONE, PRINT HEADER>>  <<00221>>04971000
               @PBUF:=@BBUF-3;                                 <<00221>>04973000
               PUTNUMP(DSTNDX);                                <<00221>>04975000
               @PBUF:=@PBUF+3;                                 <<00221>>04977000
               MEMBUFP:=DSTNDX;     <<SAVE FOR FORMATTING>>    <<00221>>04979000
NAMEDST; <<NAME THE SEGMENT TABLE>>                            <<00221>>04981000
               @PBUF:=@BBUF+45;                                <<00221>>04983000
               IF SCRATCH1<>0D THEN PUTADDR(SCRATCH1);         <<00221>>04985000
               @PBUF:=@BBUF+57;                                <<00221>>04987000
               IF SCRATCH2<>0D THEN PUTADDR(SCRATCH2);         <<00221>>04989000
               @PBUF:=@BBUF+69;                                <<00221>>04991000
               IF SCRATCH3<>0D THEN PUTADDR(SCRATCH3);         <<00221>>04993000
               @PBUF:=@BBUF+81;                                <<00221>>04995000
               IF SCRATCH4<>0D THEN PUTADDR(SCRATCH4);         <<00221>>04997000
               @PBUF:=@BBUF+93;                                <<00221>>04999000
               IF SCRATCH<>0D LAND WORKFLAG THEN               <<00221>>05001000
                 PUTADDR(SCRATCH);                             <<00221>>05003000
               @PBUF:=@BBUF+105;   <<USE LOCATIONS>>           <<00221>>05005000
               CASE BAD'DEF+1 OF                               <<00221>>05007000
                BEGIN            <<TELL WHAT IS USED>>         <<00221>>05009000
                 MOVE PBUF:="** CANNOT DEFINE TABLE **";       <<00221>>05011000
                 ;     <<0>>                                   <<00221>>05013000
                 MOVE PBUF:="BAD VALUE FROM DST";              <<00221>>05015000
                 MOVE PBUF:="BAD VALUE FROM SYS GLOBAL";       <<00221>>05017000
                 MOVE PBUF:="BAD VALUE FROM LOW CORE";         <<00221>>05019000
                 MOVE PBUF:="BAD ASSUMED ADDRESS VALUE";       <<00221>>05021000
                END;             <<TELL WHAT IS USED>>         <<00221>>05023000
               IF WORKFLAG.(15:1)=0 THEN                       <<00221>>05025000
                MOVE PBUF:="TABLE CANNOT BE DEFINED   ";       <<00221>>05027000
               PRINTLINE;        <<PRINT THE LINE>>            <<00221>>05029000
              END;               <<ERROR IN DEFINITION>>       <<00221>>05031000
                                                               <<00221>>05033000
                                                               <<00221>>05035000
             CASE DSTNDX OF                                    <<00221>>05037000
              BEGIN       <<SPECIAL BEGINNING SEQUENCE>>       <<00221>>05039000
               ;    <<0>>                                      <<00221>>05041000
               DSTNDX:=2;      <<1  NEXT INDEX IS 3>>          <<00221>>05043000
               DSTNDX:=0;      <<2  NEXT INDEX IS 1>>          <<00221>>05045000
              END;        <<SPECIAL BEGINNING SEQUENCE>>       <<00221>>05047000
                                                               <<00221>>05049000
            END                    <<LOAD ADDRESSES FOR ALL>>  <<00221>>05051000
             UNTIL (DSTNDX:=DSTNDX+1)>LSTSYSDST;               <<00221>>05053000
         END;                       <<VERIFYTBL>>              <<00221>>05055000
VERIFYUSE:                                                     <<00221>>05057000
    END;                   <<PROCEDURE VERIFYTBL>>             <<00221>>05059000
                                                                        05061000
$PAGE "CORE: Retrieve data from core dump file"                         05063000
$CONTROL SEGMENT=UTIL                                                   05065000
COMMENT                                                                 05067000
                                                                        05069000
Purpose:                                                                05071000
<<     THIS PROCEDURE RETURNS THE CONTENTS OF CORE LOCATION ADR.   >>   05073000
<<     IF THE BLOCK OF DATA IS NOT PRESENT A CALL IS MADE TO THE   >>   05075000
<<     FILE SYSTEM TO REPLACE THE 4096 WORD BLOCK WITH THE ONE     >>   05077000
<<     CONTAINING THE SPECIFIED ADR.                               >>   05079000
                                                               <<00221>>05081000
<<    THE MEMORY SWAP LOG FILE THAT IS WRITTEN OUT WITH    >>  <<00221>>05083000
<<     EACH SWAP HAS THE FOLLOWING FORMAT:                 >>  <<00221>>05085000
<<       1-10 SWAP TAG (NUMBERED FROM 1 UPWARDS)           >>  <<00221>>05087000
<<      11-12 BANK NUMBER OF THE LOCATION REQUESTED        >>  <<00221>>05089000
<<         13  BLANK                                       >>  <<00221>>05091000
<<      14-19 MEMORY LOCATION REQUESTED                    >>  <<00221>>05093000
<<         20  BLANK                                       >>  <<00221>>05095000
<<      21-22 BLOCK REQUESTED                              >>  <<00221>>05097000
<<         23  BLANK                                       >>  <<00221>>05099000
<<      24-25 BLOCK PRESENT                                >>  <<00221>>05101000
<<         26  BLANK                                       >>  <<00221>>05103000
<<      27-36 NUMBER OF FETCHES FROM PREVIOUS BLOCK        >>  <<00221>>05105000
<<      37-38  BLANK                                       >>  <<00221>>05107000
<<      39-40 DPAN SEGMENT NUMBER THAT REQUESTED LOCATION  >>  <<00221>>05109000
<<         41 "."                                          >>  <<00221>>05111000
<<      42-47 DPAN DELTA P WITHIN A SEGMENT                >>  <<00221>>05113000
<<         48  BLANK                                       >>  <<00221>>05115000
<<      49-50 ACTIVITY TAG.  USER DEFINED WITHIN DPAN.     >>  <<00221>>05117000
                                                                        05119000
Input parameters:                                                       05121000
                                                                        05123000
Output parameters:                                                      05125000
                                                                        05127000
Globals Referenced:                                                     05129000
                                                                        05131000
Globals Altered:                                                        05133000
                                                                        05135000
Data Structures:                                                        05137000
                                                                        05139000
Algorithm:                                                              05141000
                                                                        05143000
;                                                                       05145000
                                                               <<00221>>05147000
LOGICAL PROCEDURE CORE(ADR);                                  <<<01.02>>05149000
       VALUE ADR;                                                       05151000
       DOUBLE ADR;                                                      05153000
       BEGIN                                                            05155000
         INTEGER SNDX;      <<FOR SWAP MONTORING>>             <<00221>>05157000
         LOGICAL DLTAP=Q-2; <<FOR ERROR>>                      <<00221>>05159000
         LOGICAL STAT=Q-1;  <<FOR ERROR>>                      <<00221>>05161000
         LOGICAL XSAVE,SSAVE;<<FOR SAVING XREG,BANK>>          <<00221>>05163000
          INTEGER LOC=X;                                                05165000
          OWN INTEGER S:=-1;                                            05167000
          INTEGER BANKNUMBER=ADR;                              <<00.01>>05169000
          BANKNO:=BANKNUMBER;                                  <<00.01>>05171000
          IF ADR>MAXMEM THEN                                            05173000
          BEGIN                                                         05175000
BADSTUF:                                                                05177000
            MOVE BBUF:="PGM ERROR INVALID ADDRESS  XXXXXX";             05179000
            @PBUF:=@BBUF+27;                                            05181000
            PUTDNUM(ADR);                                               05183000
            MOVE PBUF:="    DPAN DELTA P=";                    <<00221>>05185000
            @PBUF:=@PBUF+18;                                   <<00221>>05187000
            PUTNUM(DLTAP);                                     <<00221>>05189000
            MOVE PBUF:="    DPAN SEGMENT=";                    <<00221>>05191000
            @PBUF:=@PBUF+18;                                   <<00221>>05193000
            PUTNUM(STAT.(10:6)-1);                             <<00221>>05195000
           IF SERIES'33'THRU'55 THEN PRINTLINE;                <<01377>>05197000
            CORE:=0;                                                    05199000
            GO BOUT;                                                    05201000
          END;                                                          05203000
          IF ADR < 0D THEN GO BADSTUF;                                  05205000
          TOS:=ADR;                                                     05207000
          LOC:=S0.(4:12);                                               05209000
          TOS:=TOS&DLSR(12);                                            05211000
          DELB;                                                         05213000
          IF S0<>S THEN << NOT PRESENT READ IT IN >>                    05215000
             BEGIN                                                      05217000
                SSAVE:=S;       <<SAVE OLD BLOCK NUMBER>>      <<00221>>05219000
                S:=TOS;                                                 05221000
                SNDX:=S;       <<FOR SWAP MONITORING>>         <<00221>>05223000
                FREADDIR(COREF,COREBUF,4096,DOUBLE(S));                 05225000
                IF <> THEN                                              05227000
                BEGIN                                                   05229000
                   MOVE DBUFFER:="CC <> ON FREAD TO DISK";              05231000
                   PRINTLINE;                                           05233000
                   PRINT'FILE'INFO(COREF);                              05235000
                   ERROR;                                               05237000
                END;                                                    05239000
              XSAVE:=LOC;    <<SAVE OFFSET>>                   <<00221>>05241000
              IF DPANSWAP <> 0 THEN                            <<00221>>05243000
               BEGIN                <<MONITORING SWAPS>>       <<00221>>05245000
                MSWLIN:=" ";  MOVE MSWLIN(1):=MSWLIN,(49);     <<00221>>05247000
                MSWAPS:=MSWAPS+1;  <<NEXT TAG>>                <<00221>>05249000
                ASCII(MSWAPS,-10,MSWLIN(9));                   <<00221>>05251000
                ASCII(BANKNO,-10,MSWLIN(11));                  <<00221>>05253000
                ASCII(SSAVE,-10,MSWLIN(24));                   <<00221>>05255000
                ASCII(SNDX,-10,MSWLIN(21));                    <<00221>>05257000
                ASCII(XSAVE,8,MSWLIN(13));                     <<00221>>05259000
                ASCII(STAT.(10:6)-1,8,MSWLIN(34));  <<STATUS>> <<00221>>05261000
                MOVE MSWLIN(34):="    ";                       <<00221>>05263000
                DASCII(MFETCH,8,MSWLIN(25));                   <<00221>>05265000
                MSWLIN(25):=" ";                               <<00221>>05267000
                ASCII(DLTAP,8,MSWLIN(41));                     <<00221>>05269000
                ASCII(MACTAG,10,MSWLIN(49));                   <<00221>>05271000
                FWRITE(DPANSWAP,LMSWLIN,-50,0);                <<00221>>05273000
                MFETCH:=0D;             <<NUMBER OF FETCHES>>  <<00221>>05275000
               END;                 <<SWAP IS MONITORED>>      <<00221>>05277000
              LOC:=XSAVE;    <<RESTORE OFFSET>>                <<00221>>05279000
             END;                                                       05281000
              MFETCH:=MFETCH+1D;     <<ANOTHER FETCH DONE>>    <<00221>>05283000
          CORE:=COREBUF(LOC);                                           05285000
BOUT:                                                                   05287000
      END;                                                              05289000
                                                                        05291000
$PAGE "DCORE: Look up and return doubleword from core"                  05293000
$CONTROL SEGMENT=UTIL                                                   05295000
COMMENT                                                                 05297000
                                                                        05299000
Purpose:                                                                05301000
     Simplify access to core dump file.  See also CORE.                 05303000
                                                                        05305000
Input parameters:                                                       05307000
                                                                        05309000
Output parameters:                                                      05311000
                                                                        05313000
Globals Referenced:                                                     05315000
                                                                        05317000
Globals Altered:                                                        05319000
                                                                        05321000
Data Structures:                                                        05323000
                                                                        05325000
Algorithm:                                                              05327000
                                                                        05329000
;                                                                       05331000
DOUBLE PROCEDURE DCORE(ADR);                                   << WBT >>05333000
VALUE ADR; DOUBLE ADR;                                         << WBT >>05335000
BEGIN                                                          << WBT >>05337000
   TOS:=CORE(ADR);                                             << WBT >>05339000
   TOS:=CORE(ADR+1D);                                          << WBT >>05341000
   DCORE:=TOS;                                                 << WBT >>05343000
END;                                                           << WBT >>05345000
                                                                        05347000
$PAGE "SYSGLOB(ADR): Return sysglob relative core dump data"            05349000
$CONTROL SEGMENT=UTIL                                                   05351000
LOGICAL PROCEDURE SYSGLOB(ADR);                                << WBT >>05353000
COMMENT                                                                 05355000
                                                                        05357000
Purpose:                                                                05359000
     Simplify access to core dump data.  See also CORE.                 05361000
                                                                        05363000
Input parameters:                                                       05365000
                                                                        05367000
Output parameters:                                                      05369000
                                                                        05371000
Globals Referenced:                                                     05373000
                                                                        05375000
Globals Altered:                                                        05377000
                                                                        05379000
Data Structures:                                                        05381000
                                                                        05383000
Algorithm:                                                              05385000
                                                                        05387000
;                                                                       05389000
   VALUE ADR; LOGICAL ADR;                                     << WBT >>05391000
   BEGIN                                                       << WBT >>05393000
      ENTRY SYSDB;                                             << WBT >>05395000
      SYSDB:                                                   << WBT >>05397000
      SYSGLOB:=CORE(DOUBLE(%1000+ADR));                        << WBT >>05399000
   END;                                                        << WBT >>05401000
                                                                        05403000
$PAGE "ONFREELIST(TABLEBASE,INDEX): is entry on free list?"             05405000
$CONTROL SEGMENT=UTIL                                                   05407000
COMMENT                                                                 05409000
                                                                        05411000
Purpose:                                                                05413000
                                                               << WBT >>05415000
THIS PROCEDURE DETERMINES WHETHER A TABLE ENTRY IS             << WBT >>05417000
ON THE FREE ENTRY LIST OF THE TABLE.  INDEX IS THE             << WBT >>05419000
INDEX OF THE ENTRY IN QUESTION, AND TABLEBASE IS THE           << WBT >>05421000
TABLE BASE                                                     << WBT >>05423000
     Used by PRINTCST and INTERACTIVE'DIALOG                            05425000
                                                                        05427000
Input parameters:                                                       05429000
                                                                        05431000
Output parameters:                                                      05433000
                                                                        05435000
Globals Referenced:                                                     05437000
                                                                        05439000
Globals Altered:                                                        05441000
                                                                        05443000
Data Structures:                                                        05445000
                                                                        05447000
Algorithm:                                                              05449000
                                                                        05451000
;                                                                       05453000
LOGICAL PROCEDURE ONFREELIST(TABLEBASE, INDEX);                << WBT >>05455000
                                                               << WBT >>05457000
VALUE TABLEBASE, INDEX;                                        << WBT >>05459000
DOUBLE TABLEBASE;                                              << WBT >>05461000
LOGICAL INDEX;                                                 << WBT >>05463000
                                                               << WBT >>05465000
BEGIN                                                          << WBT >>05467000
                                                               << WBT >>05469000
   LOGICAL LISTLENGTH, FREEX;                                  << WBT >>05471000
                                                               << WBT >>05473000
   ONFREELIST := TRUE;                                         << WBT >>05475000
   LISTLENGTH := NUMFREE;                                      << WBT >>05477000
   IF LISTLENGTH > NUMCONFIG THEN LISTLENGTH := NUMCONFIG;     << WBT >>05479000
                                                               << WBT >>05481000
   FREEX := FIRSTFREEX;                                        << WBT >>05483000
   WHILE LISTLENGTH>0 AND FREEX<>0 DO                          << WBT >>05485000
      BEGIN                                                    << WBT >>05487000
      IF FREEX=INDEX THEN RETURN;                              << WBT >>05489000
      FREEX:=NEXTFREEX;                                        << WBT >>05491000
      LISTLENGTH:=LISTLENGTH-1;                                << WBT >>05493000
      END;                                                     << WBT >>05495000
                                                               << WBT >>05497000
   ONFREELIST := FALSE;                                        << WBT >>05499000
   END;                                                        << WBT >>05501000
                                                                        05503000
$PAGE "VERIFYP: Verify agreement of system DB and DST pointers"         05505000
$CONTROL SEGMENT=UTIL                                                   05507000
COMMENT                                                                 05509000
                                                                        05511000
Purpose:                                                                05513000
<<             VERIFY DST/SYSDB POINTER                          >>     05515000
<<    THIS PROCEDURE WILL VERIFY THAT THE SYSTEM DB AND DST      >>     05517000
<<    POINTERS AGREE.                                             >>    05519000
<<IF THEY DO NOT AGREE, THEN A SERIES OF RANGE TESTS ARE>>     <<01.02>>05521000
<<PERFORMED SUCH THAT THE MOST LIKELY ABSOLUTE ADDRESS>>       <<01.02>>05523000
<<IS PASSED BACK AS THE VALUE TO USE FOR THE TABLE. IF >>      <<01.02>>05525000
<<NONE CAN BE FOUND, THEN A ZERO WILL BE RETURNED.>>           <<01.02>>05527000
<<THE CONDITION CODES PASSED BACK ARE AS FOLLOWS: >>           <<01.02>>05529000
<<   CCL=ABS. VALUE RETURNED IS FROM SYSGLOB      >>           <<01.02>>05531000
<<   CCG=ABS. VALUE RETURNED IS FROM DST TABLE    >>           <<01.02>>05533000
<<   CCE=ABS. VALUE IS A GOOD COMPARE AND ABS. SYSDB VALUE>>   <<01.02>>05535000
<<            IS BEING RETURNED.                      >>       <<01.02>>05537000
<<NOTE: IF CCL/CCG IS RETURNED, A DOUBLE ZERO MAY ALSO>>       <<01.02>>05539000
<<BE RETURNED...THUS YOU MUST CHECK THE CC AND THE VALUE>>     <<01.02>>05541000
                                                                        05543000
Input parameters:                                                       05545000
                                                                        05547000
Output parameters:                                                      05549000
                                                                        05551000
Globals Referenced:                                                     05553000
                                                                        05555000
Globals Altered:                                                        05557000
                                                                        05559000
Data Structures:                                                        05561000
                                                                        05563000
Algorithm:                                                              05565000
                                                                        05567000
;                                                                       05569000
DOUBLE PROCEDURE VERIFYP(DSTNO,SYSDBP);                        <<01.02>>05571000
VALUE DSTNO,SYSDBP;                                            <<01.02>>05573000
DOUBLE SYSDBP;                                                 <<01.02>>05575000
INTEGER DSTNO;                                                 <<01.02>>05577000
BEGIN                                                          <<01.02>>05579000
  IF DSTDEF(DSTNO) THEN                                        <<00221>>05581000
   BEGIN                  <<TABLE IS DEFINED>>                 <<00221>>05583000
    VERIFYP:=DSTADDR(DSTNO);   <<RETURN VALUE>>                <<00221>>05585000
    IF DSTDEF(DSTNO).(14:1) THEN CC:=CCE  <<ALL AGREE>>        <<00221>>05587000
                            ELSE CC:=CCL; <<DISAGREE>>         <<00221>>05589000
   END                    <<TABLE IS DEFINED>>                 <<00221>>05591000
                                                               <<00221>>05593000
  ELSE                                                         <<00221>>05595000
   BEGIN                  <<NOT DEFINED>>                      <<00221>>05597000
    VERIFYP:=0D;    <<RETURN A ZERO>>                          <<00221>>05599000
    CC:=CCG;                                                   <<00221>>05601000
   END;                   <<NOT DEFINED>>                      <<00221>>05603000
                                                               <<00221>>05605000
END;                     <<VERIFYP>>                           <<00221>>05607000
                                                                        05609000
$PAGE "WARNING: Print warning message"                                  05611000
$CONTROL SEGMENT=UTIL                                                   05613000
COMMENT                                                                 05615000
                                                                        05617000
Purpose:                                                                05619000
<<THIS PROCEDURE PRINTS A WARNING OF TWO FORMS>>               <<01.02>>05621000
                                                                        05623000
Input parameters:                                                       05625000
                                                                        05627000
Output parameters:                                                      05629000
                                                                        05631000
Globals Referenced:                                                     05633000
                                                                        05635000
Globals Altered:                                                        05637000
                                                                        05639000
Data Structures:                                                        05641000
                                                                        05643000
Algorithm:                                                              05645000
                                                                        05647000
;                                                                       05649000
PROCEDURE WARNING;                                             <<01.02>>05651000
BEGIN                                                          <<01.02>>05653000
                                                               <<01.02>>05655000
LOGICAL FLAG:=FALSE;                                           <<01.02>>05657000
ENTRY NOFORMT';                                                <<00221>>05659000
                                                               <<01.02>>05661000
<<BEGIN BODY OF PROCEDURE>>                                    <<01.02>>05663000
IF FLAG THEN                                                   <<01.02>>05665000
NOFORMT':                                                      <<00221>>05667000
   FLAG:=TRUE;                                                 <<01.02>>05669000
SKIPLINES(1);                                                  <<01.02>>05671000
MOVE DBUFFER:="**** WARNING! ";                                <<01.02>>05673000
IF FLAG THEN                                                   <<01.02>>05675000
BEGIN                                                          <<01.02>>05677000
   MOVE DBUFFER(7):=                                           <<01.02>>05679000
"UNABLE TO FORMAT TABLE. ADDRESS POINTERS INVALID ****";       <<03752>>05681000
END ELSE                                                       <<01.02>>05683000
BEGIN                                                          <<01.02>>05685000
   MOVE DBUFFER(7):=                                           <<01.02>>05687000
"ADDRESS POINTERS DO NOT AGREE. ATTEMPTING TO CONTINUE****";   <<01.02>>05689000
END;                                                           <<01.02>>05691000
PRINTLINE;                                                     <<01.02>>05693000
SKIPLINES(1);                                                  <<01.02>>05695000
END<<WARNING/NOFORMT'>>;                                       <<00221>>05697000
                                                                        05699000
$PAGE  "MODIFY'TAPE: Copy extra system files on dump tape"              05701000
$CONTROL SEGMENT=INIT                                                   05703000
PROCEDURE MODIFY'TAPE(TAPEF,FILE'REQUIRED);                    <<03083>>05705000
COMMENT                                                                 05707000
                                                                        05709000
Purpose:                                                                05711000
The reading in of the LOADMAP file does not seem to work 12/82.         05713000
          THIS PROCEDURE WAS DESIGNED TO PERFORM ONE OF THE    <<03083>>05715000
          FOLLOWING TASKS:                                     <<03083>>05717000
          1.  ADD NECESSARY SYSTEM FILES TO MEMORY DUMP TAPE   <<03083>>05719000
              IF THEY ARE NOT PRESENT -- AS DETERMINED BY      <<03083>>05721000
              SUBROUTINE CHECK'TAPE'FILES OF TAPE'TO'DISC.     <<03083>>05723000
          2.  COPY SYSTEM FILES INTO TEMPORARY DISC FILES IF   <<03083>>05725000
              THEY ARE CORRECTLY PRESENT ON THE TAPE AND       <<03083>>05727000
              PREPARE DPAN4 TO USE THESE FILES IN PLACE OF     <<03083>>05729000
              CURRENT SYSTEM FILES THEY REPRESENT.             <<03083>>05731000
                                                               <<03083>>05733000
          THE PROCEDURE USES THE LOGICAL FILES'REQUIRED TO     <<03083>>05735000
          SET IN THE CHECK'TAPE'SUBROUTINE TO DETERMINE FILE   <<03083>>05737000
          REQUIREMENTS AND PROCESS THE TAPE ACCORDINGLY.       <<03083>>05739000
                                                               <<03083>>05741000
          SUBROUTINE DISC'TO'TAPE IS THE COPYING LOOP FOR THE  <<03083>>05743000
            TRANSFER OF RECORDS FROM DISC TO TAPE AND IS USED  <<03083>>05745000
            IN THE TAPE COMPLETION PROCESS.                    <<03083>>05747000
                                                               <<03083>>05749000
          SUBROUTINE FILES'TO'DISC IS THE COPYING LOOP FOR     <<03083>>05751000
            THE TRANSFER OF RECORDS FROM TAPE FILES TO DISC.   <<03083>>05753000
            THE SUBROUTINE IS USED WHEN THE FILES ARE ALREADY  <<03083>>05755000
            PRESENT ON TAPE AND ARE TO BE USED IN PLACE OF     <<03083>>05757000
            CURRENT SYSTEM FILES.                              <<03083>>05759000
                                                               <<03083>>05761000
          SUBROUTINE CHECK'UNOPENED'FILE IS CALLED WHEN ONE    <<03083>>05763000
            OF THE SYSTEM FILES NORMALLY COPIED TO TAPE IS     <<03083>>05765000
            NOT PRESENT ON THE SYSTEM.  THE SUBROUTINE INFORMS <<03083>>05767000
            THE USER OF THIS AND WRITES CHECK RECORD TO TAPE   <<03083>>05769000
                                                                        05771000
Input parameters:                                                       05773000
                                                                        05775000
Output parameters:                                                      05777000
                                                                        05779000
Globals Referenced:                                                     05781000
                                                                        05783000
Globals Altered:                                                        05785000
                                                                        05787000
Data Structures:                                                        05789000
                                                                        05791000
Algorithm:                                                              05793000
                                                                        05795000
;                                                                       05797000
INTEGER TAPEF;                                                 <<03083>>05799000
LOGICAL FILE'REQUIRED;                                         <<03083>>05801000
BEGIN                                                          <<03083>>05803000
                                                               <<03083>>05805000
 INTEGER DFILENUM,                                             <<03083>>05807000
         RLENGTH,                                              <<03083>>05809000
         REC'LENGTH,                                           <<03083>>05811000
         FILECODE,                                             <<03083>>05813000
         FILECOUNT;                                            <<03083>>05815000
 ARRAY   FILEBUF(0:127);                                       <<03083>>05817000
 BYTE ARRAY FILENAME(0:19);                                    <<03083>>05819000
 BYTE ARRAY BFILEBUF(*)=FILEBUF;                               <<03083>>05821000
 LOGICAL FILEOPTIONS,                                          <<03083>>05823000
         EOF;                                                  <<03083>>05825000
                                                               <<03083>>05827000
 SUBROUTINE DISC'TO'TAPE;                                      <<03083>>05829000
 BEGIN                                                         <<03083>>05831000
   EOF:=FALSE;                                                 <<03083>>05833000
   WHILE EOF=FALSE DO                                          <<03083>>05835000
     BEGIN                                                     <<03083>>05837000
     RLENGTH:=FREAD(DFILENUM,FILEBUF,REC'LENGTH);              <<03083>>05839000
     IF = THEN                                                 <<03083>>05841000
       BEGIN                                                   <<03083>>05843000
       FWRITE(TAPEF,FILEBUF,REC'LENGTH,0);                     <<03083>>05845000
       IF <> THEN                                              <<03083>>05847000
         TAPE'MODIFY'ERROR(0,TAPEF);                           <<03083>>05849000
       END                                                     <<03083>>05851000
     ELSE                                                      <<03083>>05853000
       BEGIN                                                   <<03083>>05855000
       IF > THEN                                               <<03083>>05857000
         BEGIN                                                 <<03083>>05859000
         FCONTROL(TAPEF,6,FILEOPTIONS);                        <<03083>>05861000
         IF <> THEN                                            <<03083>>05863000
           TAPE'MODIFY'ERROR(3,TAPEF);                         <<03083>>05865000
         EOF:=TRUE;                                            <<03083>>05867000
         END                                                   <<03083>>05869000
       ELSE                                                    <<03083>>05871000
         TAPE'MODIFY'ERROR(2,DFILENUM);                        <<03083>>05873000
       END;                                                    <<03083>>05875000
     END;                                                      <<03083>>05877000
 END;                                                          <<03083>>05879000
                                                               <<03083>>05881000
$PAGE                                                          <<03083>>05883000
 SUBROUTINE FILES'TO'DISC;                                     <<03083>>05885000
 BEGIN                                                         <<03083>>05887000
   EOF:=FALSE;                                                 <<03083>>05889000
   WHILE NOT EOF DO                                            <<03083>>05891000
     BEGIN                                                     <<03083>>05893000
     RLENGTH:=FREAD(TAPEF,FILEBUF,REC'LENGTH);                 <<03083>>05895000
     IF = THEN                                                 <<03083>>05897000
       BEGIN                                                   <<03083>>05899000
       IF BFILEBUF <> "MPECHECK.PUB.SYS NOT PRESENT" THEN      <<03083>>05901000
         BEGIN                                                 <<03083>>05903000
         FWRITE(DFILENUM,FILEBUF,REC'LENGTH,0);                <<03083>>05905000
         IF <> THEN                                            <<03083>>05907000
           TAPE'MODIFY'ERROR(1,TAPEF);                         <<03083>>05909000
         END                                                   <<03083>>05911000
       ELSE                                                    <<03083>>05913000
         BEGIN                                                 <<03083>>05915000
         FCLOSE(DFILENUM,0,0);                                 <<03083>>05917000
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<03083>>05919000
         EOF:=TRUE                                             <<03083>>05921000
         END;                                                  <<03083>>05923000
       END                                                     <<03083>>05925000
     ELSE                                                      <<03083>>05927000
       BEGIN                                                   <<03083>>05929000
       IF > THEN                                               <<03083>>05931000
         BEGIN                                                 <<03083>>05933000
         FCLOSE(DFILENUM,%2,0);                                <<03083>>05935000
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<03083>>05937000
         EOF:=TRUE;                                            <<03083>>05939000
         END                                                   <<03083>>05941000
       ELSE                                                    <<03083>>05943000
         TAPE'MODIFY'ERROR(8,TAPEF);                           <<03083>>05945000
       END;                                                    <<03083>>05947000
   END;                                                        <<03083>>05949000
 END;                                                          <<03083>>05951000
                                                               <<03083>>05953000
                                                               <<03083>>05955000
$PAGE                                                          <<03083>>05957000
 SUBROUTINE CHECK'UNOPENED'FILE;                               <<03083>>05959000
 BEGIN                                                         <<03083>>05961000
   MOVE DBUFFER:="DISCFILE OPEN ERROR";                        <<03083>>05963000
   PRINT(DBUFFER,-19,0);                                       <<03083>>05965000
   IF FILENAME = "MPECHECK" THEN                               <<03083>>05967000
     BEGIN                                                     <<03083>>05969000
     MOVE DBUFFER:="MPECHECK.PUB.SYS NOT PRESENT ON SYSTEM";   <<03083>>05971000
     PRINT(DBUFFER,-38,0);                                     <<03083>>05973000
     FWRITE(TAPEF,DBUFFER,19,0);                               <<03083>>05975000
     IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                    <<03083>>05977000
     FCONTROL(TAPEF,6,FILEOPTIONS);                            <<03083>>05979000
     IF <> THEN TAPE'MODIFY'ERROR(3,TAPEF);                    <<03083>>05981000
     END                                                       <<03083>>05983000
   ELSE                                                        <<03083>>05985000
     BEGIN                                                     <<03083>>05987000
     IF FILENAME = "CONFDATA" THEN                             <<03083>>05989000
       BEGIN                                                   <<03083>>05991000
       MOVE DBUFFER:="CONFDATA.PUB.SYS NOT PRESENT ON SYSTEM"; <<03083>>05993000
       FWRITE(TAPEF,DBUFFER,19,0);                             <<03083>>05995000
       IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                  <<03083>>05997000
       FCONTROL(TAPEF,6,FILEOPTIONS);                          <<03083>>05999000
       IF <> THEN TAPE'MODIFY'ERROR(3,TAPEF);                  <<03083>>06001000
       PRINT(DBUFFER,-39,0);                                   <<03083>>06003000
       END                                                     <<03083>>06005000
     ELSE                                                      <<03083>>06007000
       TAPE'MODIFY'ERROR(5,DFILENUM);                          <<03083>>06009000
     END;                                                      <<03083>>06011000
 END;                                                          <<03083>>06013000
                                                               <<03083>>06015000
                                                               <<03083>>06017000
$PAGE                                                          <<03083>>06019000
   << CHECK IF TAPE WAS DETERMINED TO BE COMPLETE >>           <<03083>>06021000
 IF FILE'REQUIRED THEN                                         <<03083>>06023000
   BEGIN                                                       <<03083>>06025000
   FILECOUNT:=0;                                               <<03083>>06027000
   << LOOP TO PREPARE FOR COPYING OF SYSTEM FILES TO TAPE >>   <<03083>>06029000
   WHILE FILECOUNT < 3 DO                                      <<03083>>06031000
     BEGIN                                                     <<03083>>06033000
     CASE FILECOUNT OF                                         <<03083>>06035000
       BEGIN                                                   <<03083>>06037000
         BEGIN                                                 <<03083>>06039000
         MOVE FILENAME:="LOADMAP.PUB.SYS; ";                   <<03083>>06041000
         REC'LENGTH:=-128;                                     <<03083>>06043000
         FILEOPTIONS:=%5;                                      <<03083>>06045000
         END;                                                  <<03083>>06047000
                                                               <<03083>>06049000
         BEGIN                                                 <<03083>>06051000
         MOVE FILENAME:="MPECHECK.PUB.SYS;";                   <<03083>>06053000
         REC'LENGTH:=128;                                      <<03083>>06055000
         FILEOPTIONS:=%1;                                      <<03083>>06057000
         END;                                                  <<03083>>06059000
                                                               <<03083>>06061000
         BEGIN                                                 <<03083>>06063000
         MOVE FILENAME:="CONFDATA.PUB.SYS;";                   <<03083>>06065000
         REC'LENGTH:=128;                                      <<03083>>06067000
         FILEOPTIONS:=%1;                                      <<03083>>06069000
         END;                                                  <<03083>>06071000
       END;                                                    <<03083>>06073000
     DFILENUM:=FOPEN(FILENAME,FILEOPTIONS,%0,REC'LENGTH);      <<03083>>06075000
     IF <> THEN                                                <<03083>>06077000
       CHECK'UNOPENED'FILE                                     <<03083>>06079000
     ELSE                                                      <<03083>>06081000
       BEGIN                                                   <<03083>>06083000
       DISC'TO'TAPE;                                           <<03083>>06085000
       FCLOSE(DFILENUM,0,0);                                   <<03083>>06087000
       IF <> THEN TAPE'MODIFY'ERROR(7,DFILENUM);               <<03083>>06089000
       END;                                                    <<03083>>06091000
     FILECOUNT:=FILECOUNT + 1;                                 <<03083>>06093000
     END;                                                      <<03083>>06095000
                                                               <<03083>>06097000
     MOVE BCHECKBUF(37):="TAPE COMP.";                         <<03083>>06099000
     FWRITE(TAPEF,CHECKBUF,-46,0);                             <<03083>>06101000
     IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                    <<03083>>06103000
     FCONTROL(TAPEF,6,FILEOPTIONS);                            <<03083>>06105000
     IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                    <<03083>>06107000
     MOVE BBUF:="DUMP FILE DATE:  ";                           <<03083>>06109000
     MOVE BBUF(17):=BCHECKBUF(18),(17);                        <<03083>>06111000
     PRINT(DBUFFER,0,0);                                       <<03083>>06113000
     IF <> THEN ERROR;                                         <<03083>>06115000
    PRINT(DBUFFER,-34,0);                                      <<03752>>06117000
     IF <> THEN ERROR;                                         <<03083>>06119000
   END                                                         <<03083>>06121000
 ELSE                                                          <<03083>>06123000
   BEGIN                                                       <<03083>>06125000
   FILECOUNT:=0;                                               <<03083>>06127000
   << LOOP TO PREPARE FOR COPYING OF TWO TAPE FILES TO DISC >> <<03083>>06129000
   WHILE FILECOUNT < 2 DO                                      <<03083>>06131000
     BEGIN                                                     <<03083>>06133000
     CASE FILECOUNT OF                                         <<03083>>06135000
       BEGIN                                                   <<03083>>06137000
         BEGIN                                                 <<03083>>06139000
         MOVE FILENAME:="DPANLMP.PUB.SYS;";                    <<03083>>06141000
         REC'LENGTH:=-128;                                     <<03083>>06143000
         FILEOPTIONS:=%4;                                      <<03083>>06145000
         FILECODE:=0;                                          <<03083>>06147000
         MOVE LOADMAP:="DPANLMP.PUB.SYS;";                     <<03083>>06149000
         END;                                                  <<03083>>06151000
                                                               <<03083>>06153000
         BEGIN                                                 <<03083>>06155000
         MOVE FILENAME:="DPANPMAP.PUB.SYS;";                   <<03083>>06157000
         REC'LENGTH:=128;                                      <<03083>>06159000
         FILEOPTIONS:=%0;                                      <<03083>>06161000
         FILECODE:=1023;                                       <<03083>>06163000
         MOVE MAPNAME:="DPANPMAP.PUB.SYS;";                    <<03083>>06165000
         END;                                                  <<03083>>06167000
       END;                                                    <<03083>>06169000
     DFILENUM:=FOPEN(FILENAME,FILEOPTIONS,%4,                  <<03083>>06171000
                     REC'LENGTH,,,,,,,,,FILECODE);             <<03083>>06173000
     IF <> THEN                                                <<03083>>06175000
       TAPE'MODIFY'ERROR(5,DFILENUM);                          <<03083>>06177000
     FILES'TO'DISC;                                            <<03083>>06179000
     FILECOUNT:=FILECOUNT+1;                                   <<03083>>06181000
     END;                                                      <<03083>>06183000
     FCONTROL(TAPEF,9,FILEOPTIONS);                            <<03083>>06185000
     IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                    <<03083>>06187000
   END;                                                        <<03083>>06189000
END;                                                           <<03083>>06191000
                                                                        06193000
$PAGE "TAPETODISK: Copy dump to disc file/open files/print regs"        06195000
$CONTROL SEGMENT=INIT                                                   06197000
COMMENT                                                                 06199000
                                                                        06201000
Purpose:                                                                06203000
<<    THIS PROCEDURE WILL READ THE COLD DUMP TAPE AND BUILD A     >>    06205000
<<    CORE IMAGE DISK FILE REPRESENTING MEMORY AS IT WAS AT THE   >>    06207000
<<    TIME THE COLD DUMP TAPE WAS CREATED.                        >>    06209000
Series II/III dumps have two "first record"s.  The first holds the      06211000
firmware area.                                                          06213000
                                                                        06215000
Input parameters:                                                       06217000
                                                                        06219000
Output parameters:                                                      06221000
                                                                        06223000
Globals Referenced:                                                     06225000
                                                                        06227000
Globals Altered:                                                        06229000
                                                                        06231000
Data Structures:                                                        06233000
                                                                        06235000
Algorithm:                                                              06237000
                                                                        06239000
;                                                                       06241000
                                                                        06243000
PROCEDURE TAPETODISK;                                                   06245000
      BEGIN                                                             06247000
         INTEGER PMAPCODE;       <<FOR CHECKING FILETYPE>>     <<00221>>06249000
         DOUBLE SCANP;           <<PMAP SCAN POINTER>>         <<00221>>06251000
         INTEGER SCANL;          <<CST INDEX>>                 <<00221>>06253000
         LOGICAL ARRAY PMAPBUF(0:50);  <<PMAP BUFFER>>         <<MS.00>>06255000
         BYTE ARRAY BPMAPBUF(*)=PMAPBUF;                       <<00221>>06257000
         LOGICAL ARRAY LOADBUF(0:19);  <<LOAD MAP BUFFER>>     <<00221>>06259000
         BYTE ARRAY BLOADBUF(*)=LOADBUF;                       <<00221>>06261000
         LOGICAL MDUMPLDEV;                                    <<00221>>06263000
          INTEGER TAPEF,TLOG,BUFSAV,ADDRD,S;                   <<03083>>06265000
         DOUBLE CURREC;                                        <<03083>>06267000
         LOGICAL SMODE,OPT,PRM,JNK,PROPERVOLUME,CURRENTVOL:=0; <<01114>>06269000
         REAL TIME:=1.0;                                      <<<01.02>>06271000
         LOGICAL RETRYCNT:=0;    <<RETRY COUNT ON TAPE>>       <<00221>>06273000
LOGICAL EOF;                                                   <<03083>>06275000
         LOGICAL INCOMPLETE'TAPE := FALSE;                     <<01377>>06277000
         LOGICAL CHECK'MULTI'VOL;                              <<01377>>06279000
         INTEGER DEVTYPE,CHECKSUM,LDEV,I;                     <<01.LEN>>06281000
         ARRAY TRAILBUF(0:10);                                          06283000
         EQUATE REWINDUNLOAD=9;                                         06285000
         DOUBLE T'CONVERT;                                     <<01543>>06287000
         REAL TICK'TO'MS := 9.14566375E-2;                     <<01543>>06289000
                                                               <<01875>>06291000
LOGICAL SUBROUTINE FIXIT(W);                                   <<01875>>06293000
VALUE W; LOGICAL W;                                            <<01875>>06295000
BEGIN                                                          <<01875>>06297000
   << CHECK EACH BYTE OF W TO SEE THAT IT IS >>                <<01875>>06299000
   << A PRINTABLE ASCII CHARACTER.  IF NOT,  >>                <<01875>>06301000
   << REPLACE WITH BLANK                     >>                <<01875>>06303000
   IF W.(0:8)<%40 OR W.(0:8)>%176 THEN W.(0:8):=%40;           <<01875>>06305000
   IF W.(8:8)<%40 OR W.(8:8)>%176 THEN W.(8:8):=%40;           <<01875>>06307000
   FIXIT:=W;                                                   <<01875>>06309000
END;                                                           <<01875>>06311000
                                                               <<01875>>06313000
                                                               <<00.01>>06315000
      SUBROUTINE GET35CONTEXT;                                 <<00.01>>06317000
         BEGIN                                                 <<00.01>>06319000
         XREG:=M35XREG;                                        <<00.01>>06321000
         DLREG:=M35DLREG;                                      <<00.01>>06323000
         DBBANKREG:=M35DBANKREG;                               <<00.01>>06325000
         DBREG:=M35DBREG;                                      <<00.01>>06327000
         QREG:=M35QREG;                                        <<00.01>>06329000
         SREG:=M35SMREG;                                       <<00.01>>06331000
         ZBANKREG:=M35SBANKREG;                                <<00.01>>06333000
         ZREG:=M35ZREG;                                        <<00.01>>06335000
         STAREG:=M35STATUSREG;                                 <<00.01>>06337000
         PBBANKREG:=M35PBANKREG;                               <<00.01>>06339000
         PBREG:=M35PBREG;                                      <<00.01>>06341000
         PREG:=M35PREG;                                        <<00.01>>06343000
         PLREG:=M35PLREG;                                      <<00.01>>06345000
         CIRREG:=M35CIREG;                                     <<00.01>>06347000
         CPX1:=M35CPX1;                                        <<00.01>>06349000
         CPX2:=M35CPX2;                                        <<00.01>>06351000
         SP1:=M35SP1REG;                                       <<00.01>>06353000
         SP2:=M35SP2REG;                                       <<00.01>>06355000
         IF CNSTARFISH <> 0 THEN                               <<02519>>06357000
            BEGIN                                              <<02519>>06359000
            I := CNSTARFISH*4; << COMPUTE LOCATION OF DRT >>   <<02519>>06361000
            COREBUF(I) := CNDRT0;                              <<02519>>06363000
            COREBUF(I+1) := CNDRT1;                            <<02519>>06365000
            COREBUF(I+2) := CNDRT2;                            <<02519>>06367000
            COREBUF(I+3) := CNDRT3;                            <<02519>>06369000
            END                                                <<02519>>06371000
         ELSE                                                  <<02519>>06373000
            COREBUF(24) := M35CONTENTS24;                      <<02519>>06375000
         TOS:=M35NUMBANKS; TOS:=0;                             <<00.01>>06377000
         MAXMEM:=TOS-1D;                                       <<00.01>>06379000
MEMSIZE:=M35NUMBANKS;                                          <<00221>>06381000
         END  <<GET35CONTEXT>>;                                <<00.01>>06383000
                                                               <<00.01>>06385000
      SUBROUTINE GET25CONTEXT;                                 <<00.01>>06387000
         BEGIN                                                 <<00.01>>06389000
         XREG:=M25XREG;                                        <<00.01>>06391000
         DLREG:=M25DLREG;                                      <<00.01>>06393000
         DBBANKREG:=M25DBANKREG;                               <<00.01>>06395000
         DBREG:=M25DBREG;                                      <<00.01>>06397000
         QREG:=M25QREG;                                        <<00.01>>06399000
         SREG:=M25SREG;                                        <<00.01>>06401000
         ZBANKREG:=M25SBANKREG;                                <<00.01>>06403000
         ZREG:=M25ZREG;                                        <<00.01>>06405000
         STAREG:=M25STATUSREG;                                 <<00.01>>06407000
         PBBANKREG:=M25PBANKREG;                               <<00.01>>06409000
         PBREG:=M25PBREG;                                      <<00.01>>06411000
         PREG:=M25PREG;                                        <<00.01>>06413000
         PLREG:=M25PLREG;                                      <<00.01>>06415000
         CIRREG:=M25CIREG;                                     <<00.01>>06417000
         NIR:=M25NIRREG;                                       <<00.01>>06419000
         ISR:=M25ISR;                                          <<00.01>>06421000
         IF MACHINEID = ICF55                                  <<03013>>06423000
         THEN BEGIN                                            <<03013>>06425000
           NIR := M55NIRREG;                                   <<03013>>06427000
           CPX1 := M55CPX1;                                    <<03013>>06429000
           CPX2 := M55CPX2;                                    <<03013>>06431000
         END;                                                  <<03013>>06433000
         TOS:=M25NUMBANKS; TOS:=0;                             <<00.01>>06435000
         MAXMEM:=TOS-1D;                                       <<00.01>>06437000
MEMSIZE:=M25NUMBANKS;                                          <<00221>>06439000
         END  <<GET25CONTEXT>>;                                <<00.01>>06441000
                                                               <<01377>>06443000
                                                               <<01377>>06445000
SUBROUTINE INVALIDTAPE;                                        <<01377>>06447000
                                                               <<01377>>06449000
<< THE DUMP TAPE HAS BEEN FOUND TO BE INVALID.  PRINT >>       <<01377>>06451000
<< AN ERROR MESSAGE AND TERMINATE.                    >>       <<01377>>06453000
                                                               <<01377>>06455000
BEGIN                                                          <<01377>>06457000
                                                               <<01377>>06459000
   MOVE BBUF :=                                                <<01377>>06461000
      "***INVALID DUMP TAPE.  UNABLE TO PROCESS DUMP.  ";      <<01377>>06463000
   PRINT( DBUFFER, -48, 0 );                                   <<01377>>06465000
   MOVE BBUF :=                                                <<01377>>06467000
      "   SEE THE CONSOLE OPERATOR'S GUIDE FOR FURTHER ";      <<01377>>06469000
   PRINT( DBUFFER, -48, 0 );                                   <<01377>>06471000
   MOVE BBUF := "   INFORMATION.";                             <<01377>>06473000
   PRINT( DBUFFER, -15, 0 );                                   <<01377>>06475000
                                                               <<01377>>06477000
   TERMINATE;                                                  <<01377>>06479000
                                                               <<01377>>06481000
END;  << INVALID TAPE >>                                       <<01377>>06483000
                                                               <<03083>>06485000
                                                               <<03083>>06487000
SUBROUTINE CHECK'TAPE'FILES;                                   <<03083>>06489000
                                                               <<03083>>06491000
    << IN SUBROUTINE CHECK'TAPE'FILES TESTS ARE MADE FOR  >>   <<03083>>06493000
    << DETERMINING THE PRESENT TAPE ORGANIZATION. FIRST,  >>   <<03083>>06495000
    << THE RECORD AFTER THE END OF THE MEMORY DUMP IS READ>>   <<03083>>06497000
    << IF IT IS NOT AN END OF FILE MARK AN EOF IS ADDED,  >>   <<03083>>06499000
    << THE VERIFICATION RECORD IS ADDED AND THE LOGICAL   >>   <<03083>>06501000
    << FILES'REQUIRED IS SET TRUE TO INDICATE THE SYSTEM  >>   <<03083>>06503000
    << FILES ARE TO BE ADDED TO TAPE. OTHERWISE THE NEXT  >>   <<03083>>06505000
    << RECORD IS READ AND COMPARED TO THE VERIFICATION    >>   <<03083>>06507000
    << RECORD CONFIGURED PREVIOUSLY. IF A MATCH IS FOUND  >>   <<03083>>06509000
    << AND THE COMPLETE TAPE INDICATOR IS SET THE LOGICAL >>   <<03083>>06511000
    << FILES REQUIRED IS SET FALSE TO INDICATE FILES ARE  >>   <<03083>>06513000
    << TO BE COPIED FROM TAPE TO DISC.  IF THE VERIFI-    >>   <<03083>>06515000
    << CATION RECORD IS NOT FOUND OR IS INCORRECT THE     >>   <<03083>>06517000
    << VALID VERIFICATION RECORD IS WRITEN AND THE LOGICAL>>   <<03083>>06519000
    << FILES'REQUIRED IS SET TRUE.  IF THE COMPLETE TAPE  >>   <<03083>>06521000
    << INDICATOR IS NOT SET THE TAPE IS PREPARED FOR AN   >>   <<03083>>06523000
    << ATTEMP TO WRITE THE SYSTEM FILES TO TAPE AGAIN     >>   <<03083>>06525000
    << ASSUMING AN ERROR WAS FOUND IN THE LAST ATTEMPT.   >>   <<03083>>06527000
                                                               <<03083>>06529000
BEGIN                                                          <<03083>>06531000
                                                               <<03083>>06533000
    << SET UP VERIFICATION RECORD TO BE ADDED TO TAPE  >>      <<03083>>06535000
                                                               <<03083>>06537000
MOVE CHECKBUF:=24("  ");                                       <<03083>>06539000
MOVE BCHECKBUF:="DPAN HP/3000    ";                            <<03083>>06541000
RECOVER'DATE(TBUF);                                            <<03083>>06543000
MOVE BCHECKBUF(18):=STRING,(17);                               <<03083>>06545000
FILE'REQUIRED:=FALSE;                                          <<03083>>06547000
TLOG:=FREAD(TAPEF,COREBUF,4096);                               <<03083>>06549000
IF <= THEN                                                     <<03083>>06551000
  BEGIN                                                        <<03083>>06553000
  FSPACE(TAPEF,-1);                                            <<03083>>06555000
  FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                           <<03083>>06557000
  IF <> THEN                                                   <<03083>>06559000
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<03083>>06561000
  FWRITE(TAPEF,CHECKBUF,23,0);                                 <<03083>>06563000
  IF <> THEN                                                   <<03083>>06565000
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<03083>>06567000
  FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                           <<03083>>06569000
  IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                       <<03083>>06571000
  FILE'REQUIRED:=TRUE;                                         <<03083>>06573000
  END                                                          <<03083>>06575000
ELSE                                                           <<03083>>06577000
  BEGIN                                                        <<03083>>06579000
  MOVE COREBUF:=4096("  ");                                    <<03083>>06581000
  TLOG:=FREAD(TAPEF,COREBUF,18);                               <<03083>>06583000
  IF <> OR BCOREBUF <> BCHECKBUF,(34) THEN                     <<03083>>06585000
    BEGIN                                                      <<03083>>06587000
    FSPACE(TAPEF,-1);                                          <<03083>>06589000
    IF < THEN                                                  <<03083>>06591000
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<03083>>06593000
    FWRITE(TAPEF,CHECKBUF,23,0);                               <<03083>>06595000
    IF <> THEN                                                 <<03083>>06597000
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<03083>>06599000
    FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                         <<03083>>06601000
    IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                     <<03083>>06603000
    FILE'REQUIRED:=TRUE;                                       <<03083>>06605000
    END                                                        <<03083>>06607000
  ELSE                                                         <<03083>>06609000
    BEGIN                                                      <<03083>>06611000
    FSPACE(TAPEF,1);                                           <<03083>>06613000
    IF <= THEN                                                 <<03083>>06615000
      BEGIN                                                    <<03083>>06617000
      FSPACE(TAPEF,-1);                                        <<03083>>06619000
      IF <> THEN TAPE'MODIFY'ERROR(4,TAPEF);                   <<03083>>06621000
      FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                       <<03083>>06623000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06625000
      FILE'REQUIRED:=TRUE;                                     <<03083>>06627000
      END                                                      <<03083>>06629000
    ELSE                                                       <<03083>>06631000
      BEGIN                                                    <<03083>>06633000
                                                               <<03083>>06635000
     << IN THIS SECTION OF CODE THE ADDITIONAL FILES ARE >>    <<03083>>06637000
     << CHECKED FOR COMPLETENESS.  THE TAPE IS SEARCHED  >>    <<03083>>06639000
     << TO FIND THE COMPLETE TAPE INDICATOR WHICH IS     >>    <<03083>>06641000
     << PLACED AFTER THE THIRD ADDITIONAL FILE.  AFTER   >>    <<03083>>06643000
     << THE COMPLETE TAPE INDICATOR IS FOUND THE TAPE IS >>    <<03083>>06645000
     << REWOUND AND PLACED AT THE BEGINNING OF THE FIRST >>    <<03083>>06647000
     << ADDITIONAL FILE SO THAT THE COPYING PROCEDURE CAN>>    <<03083>>06649000
     << BEGIN.                                           >>    <<03083>>06651000
                                                               <<03083>>06653000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06655000
      IF <> THEN                                               <<03083>>06657000
         BEGIN                                                 <<03083>>06659000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06661000
         GO EXIT;                                              <<03083>>06663000
         END;                                                  <<03083>>06665000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06667000
      IF <> THEN                                               <<03083>>06669000
         BEGIN                                                 <<03083>>06671000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06673000
         GO EXIT;                                              <<03083>>06675000
         END;                                                  <<03083>>06677000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06679000
      IF <> THEN                                               <<03083>>06681000
         BEGIN                                                 <<03083>>06683000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06685000
         GO EXIT;                                              <<03083>>06687000
         END;                                                  <<03083>>06689000
      FREAD(TAPEF,COREBUF,-47);                                <<03083>>06691000
      IF <> THEN                                               <<03083>>06693000
         BEGIN                                                 <<03083>>06695000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06697000
         GO EXIT;                                              <<03083>>06699000
         END;                                                  <<03083>>06701000
      IF BCOREBUF <> BCHECKBUF,(23) THEN                       <<03083>>06703000
        FILE'REQUIRED:=TRUE;                                   <<03083>>06705000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06707000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06709000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06711000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06713000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06715000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06717000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06719000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06721000
      FSPACE(TAPEF,1);                                         <<03083>>06723000
      IF < THEN TAPE'MODIFY'ERROR(4,TAPEF);                    <<03083>>06725000
    EXIT:                                                      <<03083>>06727000
      END;                                                     <<03083>>06729000
    END;                                                       <<03083>>06731000
  END;                                                         <<03083>>06733000
END;                                                           <<03083>>06735000
$PAGE                                                          <<01377>>06737000
SUBROUTINE INCOMPLETE;                                         <<01377>>06739000
                                                               <<01377>>06741000
<< THE INPUT DUMP FILE HAS BEEN FOUND TO BE INCOMPLETE.  >>    <<01377>>06743000
<< PRINT ERROR MESSAGE AND HANDLE CONTINUATION OPTION.   >>    <<01377>>06745000
                                                               <<01377>>06747000
BEGIN                                                          <<01377>>06749000
   MOVE BBUF := "INCOMPLETE DUMP:    K WORDS SHORT";           <<01377>>06751000
   @PBUF := @BBUF + 17;                                        <<01377>>06753000
   ASCII( (NUMREC*4), 10, PBUF );                              <<01377>>06755000
   PRINT( DBUFFER, -33, 0 );                                   <<01377>>06757000
   MOVE BBUF := "  ";                                          <<01377>>06759000
   PRINT( DBUFFER, -2, 0 );                                    <<01377>>06761000
                                                               <<01377>>06763000
<< IF IN A SESSION, THERE IS THE OPTION OF CONTINUING.   >>    <<01377>>06765000
   IF DUPLICATIVE THEN                                         <<01377>>06767000
   BEGIN                                                       <<01377>>06769000
      MOVE BBUF :=                                             <<01377>>06771000
         "THE DUMP TAPE HAS BEEN FOUND TO BE INCOMPLETE.";     <<01377>>06773000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06775000
      MOVE BBUF :=                                             <<01377>>06777000
         "THE RESULTING DUMP LISTING IS OFTEN OF LITTLE ";     <<01377>>06779000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06781000
      MOVE BBUF :=                                             <<01377>>06783000
         "VALUE.  SEE THE CONSOLE OPERATOR'S GUIDE FOR  ";     <<01377>>06785000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06787000
      MOVE BBUF :=                                             <<01377>>06789000
         "FURTHER INFORMATION.                          ";     <<01377>>06791000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06793000
      MOVE BBUF :=                                             <<01377>>06795000
         "    ";                                               <<01377>>06797000
      PRINT( DBUFFER, -4, 0 );                                 <<01377>>06799000
      MOVE BBUF :=                                             <<01377>>06801000
         "DO YOU WISH TO PRINT THIS INCOMPLETE DUMP (Y OR N)?";<<01377>>06803000
      PRINT( DBUFFER, -52, 0 );                                <<01377>>06805000
                                                               <<01377>>06807000
   << READ THE RESPONSE FROM THE USER.                   >>    <<01377>>06809000
      READX (DBUFFER,-1);                                      <<03079>>06811000
      IF BBUF = "Y"                                            <<01377>>06813000
         THEN INCOMPLETE'TAPE := TRUE                          <<01377>>06815000
         ELSE TERMINATE;                                       <<01377>>06817000
                                                               <<01377>>06819000
   END     << USER WAS IN A SESSION. >>                        <<01377>>06821000
   ELSE                                                        <<01377>>06823000
   BEGIN   << USER WAS IN A JOB.     >>                        <<01377>>06825000
                                                               <<01377>>06827000
      MOVE BBUF :=                                             <<01377>>06829000
         "RUN DPAN4 FROM A SESSION TO PRINT INCOMPLETE DUMPS"; << WBT >>06831000
      PRINT( DBUFFER, -50, 0 );                                <<01377>>06833000
      TERMINATE;                                               <<01377>>06835000
                                                               <<01377>>06837000
   END;                                                        <<01377>>06839000
                                                               <<01377>>06841000
END;  << INCOMPLETE. >>                                        <<01377>>06843000
$PAGE                                                          <<01377>>06845000
SUBROUTINE GET'SERIESII'CONTEXT;                               <<01377>>06847000
                                                               <<01377>>06849000
<< THE DEFAULT MACHINE CONTEXT IS THE OLD SERIES II.     >>    <<01377>>06851000
<< OTHER OPTIONS (HANDLED ELSEWHERE) ARE MODELS 25 & 35. >>    <<01377>>06853000
                                                               <<01377>>06855000
BEGIN                                                          <<01377>>06857000
                                                               <<01377>>06859000
   ADDRD := COREBUF( 0 );                                      <<01377>>06861000
   IF LOGICAL( ADDRD ) > %1010 THEN                            <<01377>>06863000
   BEGIN                                                       <<01377>>06865000
      MOVE BBUF := "INVALID DUMP TAPE.";                       <<01377>>06867000
      PRINT( DBUFFER, -19, 0 );                                <<01377>>06869000
      ERROR;                                                   <<01377>>06871000
   END;                                                        <<01377>>06873000
                                                               <<01377>>06875000
<< SAVE PERTENIENT PARTS OF FIRST RECORD.                >>    <<01377>>06877000
   MOVE SCRBUF := COREBUF(1), (26);                            <<01377>>06879000
   BUFSAV := ADDRD + 1;                                        <<01377>>06881000
                                                               <<01377>>06883000
<< READ NEXT RECORD AND RESTORE SAVED INFORMATION.       >>    <<01377>>06885000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>06887000
   IF <> THEN INCOMPLETE;                                      <<01377>>06889000
   MOVE REGSAVE := COREBUF( BUFSAV+1 ), (26);                  <<01377>>06891000
   MOVE COREBUF( BUFSAV ) := SCRBUF, (26);                     <<01377>>06893000
   MOVE COREBUF( BUFSAV-7 ) := REGSAVE, (6);                   <<01377>>06895000
   COREBUF( BUFSAV-1 ) := REG6;                                <<01377>>06897000
   COREBUF( BUFSAV )   := REG7;                                <<01377>>06899000
                                                               <<01377>>06901000
   TOS := MEMSIZE LAND %7770;                                  <<01377>>06903000
   DEL;                                                        <<01377>>06905000
                                                               <<01377>>06907000
   TOS := 0;                                                   <<01377>>06909000
   TOS := MEMSIZE;                                             <<01377>>06911000
   TOS := TOS&DCSR(3)&LSL(3);                                  <<01377>>06913000
   ASB( XCH );                                                 <<01377>>06915000
   TOS := TOS&CSL(3);                                          <<01377>>06917000
   ASB( XCH );                                                 <<01377>>06919000
   TOS := TOS - 1D;                                            <<01377>>06921000
   IF < THEN BEGIN DDEL; TOS := %777777D; END;  << 256 K >>    <<01833>>06923000
   MAXMEM := TOS;                                              <<01377>>06925000
                                                               <<01377>>06927000
END;  << GET'SERIESII'CONTEXT >>                               <<01377>>06929000
$PAGE                                                          <<01377>>06931000
SUBROUTINE MULTIVOL;                                           <<01377>>06933000
                                                               <<01377>>06935000
<< WHILE COPYING THE DUMP FILE TO THE CORE DISK FILE,IT  >>    <<01377>>06937000
<< WAS FOUND THAT THE DUMP FILE WAS SHORT; BUT THERE     >>    <<01377>>06939000
<< EXISTS THE POSSIBILITY THAT THE DUMP FILE OCCUPIES    >>    <<01377>>06941000
<< MULTIPLE VOLUMES.  THIS ROUTINE REQUESTS THAT THE     >>    <<01377>>06943000
<< NEXT VOLUME IS MOUNTED.                               >>    <<01377>>06945000
<<                                                       >>    <<01377>>06947000
<< NOTE:  THIS ROUTINE BECOMES AN INFINITE LOOP IF THE   >>    <<01377>>06949000
<<        PROPER NEXT VOLUME IS NOT FOUND.  SINCE THIS   >>    <<01377>>06951000
<<        ROUTINE REPEATED CALLS THE OPERATOR, HOWEVER,  >>    <<01377>>06953000
<<        IT CAN BE ABORTED WHEN THE OPERATOR CAN'T      >>    <<01377>>06955000
<<        FIND THE RIGHT VOLUME.                         >>    <<01377>>06957000
                                                               <<01377>>06959000
BEGIN                                                          <<01377>>06961000
                                                               <<01377>>06963000
<< CHECK FOR MULTIPLE VOLUME INPUT BY TRYING TO GET THE  >>    <<01377>>06965000
<< TRAILER OF THE CURRENT VOLUME.                        >>    <<01377>>06967000
                                                               <<01377>>06969000
   TLOG := FREAD( TAPEF, TRAILBUF, 10 );                       <<01377>>06971000
   CURRENTVOL := CURRENTVOL + 1;                               <<01377>>06973000
   IF TLOG <> 10  OR  TRAILBUF <> CURRENTVOL  THEN             <<01377>>06975000
   BEGIN                                                       <<01377>>06977000
      INCOMPLETE;                                              <<01377>>06979000
      RETURN;                                                  <<01377>>06981000
   END;                                                        <<01377>>06983000
                                                               <<01377>>06985000
<< SEARCH FOR THE PROPER VOLUME.                         >>    <<01377>>06987000
   DO                                                          <<01377>>06989000
   BEGIN                                                       <<01377>>06991000
                                                               <<01377>>06993000
      FCONTROL( TAPEF, REWINDUNLOAD, PARM );                   <<01377>>06995000
      PRINTOP( MNV, 9, 0 );                                    <<01377>>06997000
      IF DEVTYPE.(8:8) = SERDISC                               <<01377>>06999000
         THEN FCONTROL( TAPEF, 7, JNK );                       <<01377>>07001000
      TLOG := FREAD( TAPEF, TRAILBUF, 10 );                    <<01377>>07003000
      PROPERVOLUME :=                                          <<01377>>07005000
         IF TLOG = 10  AND  TRAILBUF = CURRENTVOL              <<01377>>07007000
            THEN TRUE                                          <<01377>>07009000
            ELSE FALSE;                                        <<01377>>07011000
      IF NOT PROPERVOLUME                                      <<01377>>07013000
         THEN PRINTOP( IMPV, 8, PARM );                        <<01377>>07015000
                                                               <<01377>>07017000
   END  UNTIL PROPERVOLUME;                                    <<01377>>07019000
                                                               <<01377>>07021000
<< READ AND CHECK NEXT RECORD.                           >>    <<01377>>07023000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>07025000
   IF < THEN BEGIN                                             <<01377>>07027000
      INVALIDTAPE;                                             <<01377>>07029000
      RETURN;                                                  <<01377>>07031000
   END                                                         <<01377>>07033000
   ELSE IF >                                                   <<01377>>07035000
      THEN WHILE CHECK'MULTI'VOL DO MULTIVOL                   <<01377>>07037000
   ELSE                                                        <<01377>>07039000
      CHECK'MULTI'VOL := FALSE;                                <<01377>>07041000
                                                               <<01377>>07043000
END;  << MULTIVOL >>                                           <<01377>>07045000
$PAGE                                                          <<01377>>07047000
                                                               <<01377>>07049000
<<  M A I N    B O D Y                                   >>    <<01377>>07051000
                                                               <<01377>>07053000
      WHO( JSM );                                              <<01377>>07055000
      IF JSM.(15:1) = 1 THEN OPT := %400                       <<01377>>07057000
      ELSE OPT:=%410;     <<STDLIST>>                                   07059000
      IF DUPLICATIVE THEN                                      <<01114>>07061000
      BEGIN                                                   <<<01.02>>07063000
         TBUF:="  ";                                          <<<01.02>>07065000
         MOVE TBUF(1):=TBUF,(74);                             <<<01.02>>07067000
         MOVE TBUF:=DPN4,(5);                                  << WBT >>07069000
         MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                   <<04665>>07071000
         MOVE TBUF(5):=LVL,(4);                               <<<01.02>>07073000
         MOVE TBUF(9):=COPYRITE,(14);                         <<<01.02>>07075000
         PRINT(TBUF,24,0);                                    <<<01.02>>07077000
      END; <<PRINT IDENTIFIER ON SESSION DEVICE>>             <<<01.02>>07079000
      IF NOT PRTNPRT THEN BEGIN                                         07081000
      LPF:=FOPEN(LPN,OPT,1,,LPND,,,,16);                      <<<01.02>>07083000
      IF <> THEN                                                        07085000
      BEGIN                                                             07087000
        PRINT'FILE'INFO(LPF);                                           07089000
        ERROR;                                                          07091000
      END;                                                              07093000
      END;                                                              07095000
         DPANSWAP:=FOPEN(MSWLIN,%64,1,-50);                    <<00221>>07097000
          IF = THEN  MOVE MSWLIN:="        ";   <<BLANK NAME>> <<00221>>07099000
COREF:=FOPEN(,0,%504,4096,,,,,,1024D,32,4);                             07101000
         IF <> THEN                                                     07103000
         BEGIN                                                          07105000
           MOVE DBUFFER:="CC <> ON FOPEN TO DISK";                      07107000
           PRINT(DBUFFER,-22,0);                               <<01057>>07109000
           PRINT'FILE'INFO(COREF);                                      07111000
           ERROR;                                                       07113000
         END;                                                           07115000
         COREBUF:=0;                                                    07117000
       FWRITEDIR(COREF,COREBUF,1,255D);<<OPEN LAST EXTENT>>    <<MS.00>>07119000
         IF <> THEN                                                     07121000
         BEGIN                                                          07123000
                                                                        07125000
PDISK:                                                                  07127000
           MOVE DBUFFER:="CC <> ON FWRITE TO DISK";                     07129000
           PRINT(DBUFFER,-23,0);                               <<01057>>07131000
           PRINT'FILE'INFO(COREF);                                      07133000
           ERROR;                                                       07135000
         END;                                                           07137000
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<03083>>07139000
         IF = THEN GO TAPET;                                            07141000
   MOVE COREDUMP(5):=".PUB.SYS";                               <<01833>>07143000
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<03083>>07145000
   IF = THEN GO TAPET;                                         <<01833>>07147000
   TAPEF:=FOPEN(DPANIN,%200,%504,4096,TAPE);                   <<03083>>07149000
         IF <> THEN                                                     07151000
         BEGIN                                                          07153000
            MOVE DBUFFER:="CC <> ON FOPEN TO TAPE";                     07155000
            PRINT(DBUFFER,-22,0);                              <<01057>>07157000
            PRINT'FILE'INFO(TAPEF);                                     07159000
            ERROR;                                                      07161000
         END;                                                           07163000
                                                               <<03659>>07165000
         <<THE FOLLOWING FWRITE OF ZERO LENGTH IS USED TO>>    <<03659>>07167000
         <<FORCE THE FILE SYSTEM TO VERIFY THAT A WRITE  >>    <<03659>>07169000
         <<RING IS PRESENT ON THE TAPE (SINCE WE WILL BE >>    <<03659>>07171000
         <<WRITING ON THE TAPE TO APPEND FILES).  IT     >>    <<03659>>07173000
         <<SHOULD LEAVE THE TAPE AT THE LOAD POINT.  IT  >>    <<03659>>07175000
         <<IS IMPORTANT THAT THE FILE BE OPENED WITH     >>    <<03659>>07177000
         <<UNDEFINED LENGTH RECORDS SPECIFIED, OTHERWISE >>    <<03659>>07179000
         <<THIS FWRITE WILL OVERWRITE PART OF THE TAPE   >>    <<03659>>07181000
         FWRITE(TAPEF,COREBUF,0,0);                            <<03659>>07183000
         IF <> THEN                                            <<03659>>07185000
         BEGIN                                                 <<03659>>07187000
            MOVE DBUFFER:="CC <> ON FWRITE TO TAPE";           <<03659>>07189000
            PRINT(DBUFFER,-23,0);                              <<03659>>07191000
            PRINT'FILE'INFO(TAPEF);                            <<03659>>07193000
            ERROR;                                             <<03659>>07195000
         END;                                                  <<03659>>07197000
TAPET:                                                                  07199000
         FGETINFO(TAPEF,,,,,DEVTYPE,LDEV);                    <<01.LEN>>07201000
         IF DEVTYPE.(8:8)=3 THEN GO BOTFOUND;                  <<04543>>07203000
         IF DEVTYPE.(8:8)=0 THEN                               <<00.01>>07205000
            GOTO BOTFOUND;                                     <<00.01>>07207000
         IF DEVTYPE.(8:8) = SERDISC THEN                       <<00.01>>07209000
            BEGIN                                              <<00.01>>07211000
            FCONTROL(TAPEF,7,JNK);                            <<00.01>> 07213000
            GO BOTFOUND;                                       <<00.01>>07215000
            END;                                               <<00.01>>07217000
         IF DEVTYPE.(8:8) <> MAGTAPE THEN                      <<00.01>>07219000
            BEGIN  <<INVALID DPAN DEVICE>>                     <<00.01>>07221000
            MOVE DBUFFER:="INVALID INPUT DEVICE";              <<00.01>>07223000
            PRINT(DBUFFER,-20,0);                              <<01057>>07225000
            PRINT'FILE'INFO(TAPEF);                            <<00.01>>07227000
            ERROR;                                             <<00.01>>07229000
            END;                                               <<00.01>>07231000
BOTFOUND:                                                     <<<01.02>>07233000
                                                               <<01377>>07235000
<< READ THE FIRST RECORD IN THE DUMP FILE.               >>    <<01377>>07237000
   NUMREC := 256;   << 2 MB WORDS / 4 K WORDS PER REC.   >>    <<01377>>07239000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>07241000
   IF <> THEN       << FREAD ERROR ON FIRST RECORD.      >>    <<01377>>07243000
   BEGIN                                                       <<01377>>07245000
      INVALIDTAPE;                                             <<01377>>07247000
      GO ERRLEAVE;                                             <<01377>>07249000
   END;                                                        <<01377>>07251000
                                                               <<01377>>07253000
<< GET MACHINE ID AND APPROPRIATE MACHINE CONTEXT.       >>    <<01377>>07255000
   MACHINEID := CNMACHINEID;                                   <<01377>>07257000
   IF      MACHINEID = MODEL35                                 <<01377>>07259000
      THEN GET35CONTEXT                                        <<01377>>07261000
   ELSE IF SERIES'33'THRU'55                                   <<01377>>07263000
      THEN GET25CONTEXT                                        <<01377>>07265000
   ELSE    GET'SERIESII'CONTEXT;                               <<01377>>07267000
                                                               <<01377>>07269000
<< COPY THE DUMP FILE TO THE CORE DISK FILE.             >>    <<01377>>07271000
   FWRITEDIR( COREF, COREBUF, 4096, 0D );                      <<01377>>07273000
   IF <> THEN                                                  <<01377>>07275000
   BEGIN                                                       <<01377>>07277000
      MOVE DBUFFER := "* CC <> ON FWRITE TO DISK.";            <<01377>>07279000
      PRINT( DBUFFER, -26, 0 );                                <<01377>>07281000
      PRINT'FILE'INFO( COREF );                                <<01377>>07283000
      ERROR;                                                   <<01377>>07285000
   END;                                                        <<01377>>07287000
                                                               <<01377>>07289000
   NUMREC := INTEGER( MAXMEM&DLSR(12) );                       <<01377>>07291000
   WHILE  NUMREC > 0  AND  NOT INCOMPLETE'TAPE   DO            <<01377>>07293000
   BEGIN                                                       <<01377>>07295000
                                                               <<01377>>07297000
   << READ AND CHECK THE NEXT RECORD.                    >>    <<01377>>07299000
      TLOG := FREAD( TAPEF, COREBUF, 4096 );                   <<01377>>07301000
      IF < THEN INCOMPLETE      << FREAD ERROR.          >>    <<01377>>07303000
      ELSE IF > THEN            << FREAD SHORT.          >>    <<01377>>07305000
      BEGIN                                                    <<01377>>07307000
         CHECK'MULTI'VOL := TRUE;                              <<01377>>07309000
         WHILE CHECK'MULTI'VOL DO                              <<01377>>07311000
         BEGIN                                                 <<01377>>07313000
            MULTIVOL;                                          <<01377>>07315000
            IF INCOMPLETE'TAPE THEN GO ERRLEAVE;               <<01377>>07317000
         END;                                                  <<01377>>07319000
                                                               <<01377>>07321000
                                                               <<00.01>>07323000
                                                               <<01377>>07325000
      << IF THIS IS LAST RECORD, THEN FREAD SHORT OKAY.  >>    <<01377>>07327000
         IF NUMREC > 1 THEN                                    <<01377>>07329000
         BEGIN                                                 <<01377>>07331000
            INCOMPLETE;                                        <<01377>>07333000
            GO ERRLEAVE;                                       <<01377>>07335000
         END;                                                  <<01377>>07337000
                                                               <<01377>>07339000
      END;  << FREAD SHORT. >>                                 <<01377>>07341000
                                                               <<01377>>07343000
   << WRITE THE RECORD TO THE CORE DISK FILE.            >>    <<01377>>07345000
      FWRITE( COREF, COREBUF, 4096, 0 );                       <<01377>>07347000
      IF <> THEN                                               <<01377>>07349000
      BEGIN                                                    <<01377>>07351000
         MOVE DBUFFER := "**CC <> ON FWRITE TO DISK";          <<01377>>07353000
         PRINT( DBUFFER, -25, 0 );                             <<01377>>07355000
         PRINT'FILE'INFO( COREF );                             <<01377>>07357000
         ERROR;                                                <<01377>>07359000
      END;                                                     <<01377>>07361000
                                                               <<01377>>07363000
      NUMREC := NUMREC - 1;                                    <<01377>>07365000
                                                               <<01377>>07367000
   END;  << COPYING LOOP >>                                    <<01377>>07369000
                                                               <<01377>>07371000
CHECK'TAPE'FILES;                                              <<03083>>07373000
                                                               <<03083>>07375000
    << THE FOLLOWING CODE WAS ADDED TO PREVENT DUMPS  >>       <<03083>>07377000
    << FROM ONE SYSTEM LEVEL (I.E. 44'S, 30/33'S)     >>       <<03083>>07379000
    << HAVING THE NECESSARY SYSTEM FILES OF ANOTHER   >>       <<03083>>07381000
    << SYSTEM LEVEL APPENDED TO THE END OF THE MEMORY >>       <<03083>>07383000
    << DUMP TAPE.  THE NECESSARY INFORMATION COULD    >>       <<03083>>07385000
    << NOT BE OBTAINED TO IMPLEMENT THIS TYPE OF CHECK>>       <<03083>>07387000
    << ON SYSTEMS OF THE SAME LEVEL.                  >>       <<03083>>07389000
                                                               <<03083>>07391000
CPUMACHINECODE:=THISCPU;                                       <<03083>>07393000
CASE CPUMACHINECODE OF                                         <<03083>>07395000
  BEGIN                                                        <<03083>>07397000
  ;                                                            <<03083>>07399000
  ;                                                            <<03083>>07401000
  CPUMACHINECODE:=3;                                           <<03083>>07403000
  CPUMACHINECODE:=2;                                           <<03083>>07405000
  ;                                                                     07407000
  END;                                                         <<03083>>07409000
IF FILE'REQUIRED AND CPUMACHINECODE -1 <> MACHINEID            <<03083>>07411000
   THEN GO ERRLEAVE;                                           <<03083>>07413000
MODIFY'TAPE(TAPEF,FILE'REQUIRED);                              <<03083>>07415000
                                                               <<03083>>07417000
ERRLEAVE:                                                               07419000
         FCLOSE(TAPEF,0,0);                                             07421000
         CHKLDMAP;                                             <<01114>>07423000
                                                               <<MS.00>>07425000
            IF SAME'SYSTEM THEN                                <<MS.00>>07427000
            BEGIN                                              <<MS.00>>07429000
PMAPFILE:=FOPEN(MAPNAME,%7,%200);                              <<03083>>07431000
             IF = THEN                                         <<MS.00>>07433000
             BEGIN                                             <<MS.00>>07435000
              FGETINFO(PMAPFILE,,,,,,,,PMAPCODE);              <<MS.00>>07437000
              IF PMAPCODE = 1023 THEN                          <<00740>>07439000
              BEGIN                                            <<MS.00>>07441000
               SCANP:=0D; << START OF RECORD >>                <<MS.00>>07443000
               DBUFFER(72) := FIXIT(CORE(MITVERNO));<<MIT VERSI<<01924>>07445000
               DBUFFER(70) := FIXIT(CORE(MITUPNO)); <<MIT UPDAT<<01924>>07447000
               DBUFFER(71) := FIXIT(CORE(MITFNO));  <<MIT FIX I<<01924>>07449000
             FREADDIR(PMAPFILE,PMAPBUF,-60,SCANP);             <<MS.00>>07451000
               IF <> THEN GO DONEBLD;<< EMPTY >>               <<MS.00>>07453000
               MOVE BLOADBUF    :="%";                         <<MS.00>>07455000
               MOVE BLOADBUF( 1):=BPMAPBUF    ,(6);            <<MS.00>>07457000
               MOVE BLOADBUF( 7):="%";                         <<MS.00>>07459000
               MOVE BLOADBUF( 8):=BPMAPBUF( 7),(6);            <<MS.00>>07461000
               MOVE BLOADBUF(14):="%";                         <<MS.00>>07463000
               MOVE BLOADBUF(15):=BPMAPBUF(14),(6);            <<MS.00>>07465000
               LOADBUF(20):=BINARY(BLOADBUF    ,7);            <<MS.00>>07467000
               LOADBUF(21):=BINARY(BLOADBUF( 7),7);            <<MS.00>>07469000
               LOADBUF(22):=BINARY(BLOADBUF(14),7);            <<MS.00>>07471000
                BEGIN                                          <<MS.00>>07473000
                 SCANL:=0; << INITIALIZE INDEX CNTR >>         <<MS.00>>07475000
                 @MEMBUFP:=@MEMBUF;<<INITIALIZE TBL ADDR>>     <<MS.00>>07477000
                 WHILE (SCANL:=SCANL+1) < 300 DO               <<MS.00>>07479000
                 BEGIN                                         <<MS.00>>07481000
                  SCANP:=SCANP + 1D; << INCR. REC. CNTR >>     <<MS.00>>07483000
                  FREADDIR(PMAPFILE,DBUFFER,25,SCANP);         <<MS.00>>07485000
                  IF <> THEN GO DONEBLD; << FIN >>             <<MS.00>>07487000
                  MOVE MEMBUFP:=DBUFFER,(8); <<SEG.NAME>>      <<MS.00>>07489000
                  MOVE BBUF(24):="%";                          <<MS.00>>07491000
                  MOVE BBUF(34):="%";                          <<MS.00>>07493000
                  MEMBUFP( 8):=BINARY(BBUF(24),7);<<SEG.LEN>>  <<MS.00>>07495000
                  MEMBUFP(10):=BINARY(BBUF(34),7);<<CKSUM>>    <<MS.00>>07497000
                  MEMBUFP(14):=LOGICAL(SCANP);<<SECTOR>>       <<MS.00>>07499000
                  @MEMBUFP:=@MEMBUFP + 15; <<BUMP ADDR.>>      <<MS.00>>07501000
                 END; << END: WHILE STATEMENT >>               <<MS.00>>07503000
                                                               <<MS.00>>07505000
DONEBLD:                                                       <<MS.00>>07507000
                MEMBUFP(14):=0; << TERMINATOR >>               <<MS.00>>07509000
                IF  (SCANP<>0D OR SCANP<>1D) THEN GO HEADER';  <<MS.00>>07511000
               END; << VER./UPD/FIX NEQ >>                     <<MS.00>>07513000
             END; << PMAPCODE <> 1023 >>                       <<00740>>07515000
            END; << CC: NEQ - FOPEN >>                         <<MS.00>>07517000
           FCLOSE(PMAPFILE,0,0); << CLOSE IT >>                <<MS.00>>07519000
           PMAPFILE := 0;  << MAKE IT NON-EXISTENT >>          <<MS.00>>07521000
           END; << SAME'SYSTEM = FALSE >>                      <<MS.00>>07523000
                                                               <<MS.00>>07525000
HEADER':                                                       <<MS.00>>07527000
        TBUF:="  ";     <<ITS A WORD NOT A BYTE>>              <<00221>>07529000
         MOVE TBUF(1):=TBUF,(74);     <<BLANK BUFFER>>                  07531000
         MOVE TBUF:="HP3000     MEMORY DUMP";                  <<04711>>07533000
         MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                   <<04665>>07535000
         MOVE TBUF(11):=LVL, (4);                             <<<01.02>>07537000
         MOVE TBUF(15):="OF SYS VER";                         <<<01.02>>07539000
         MOVE TBUF(22):="UPDATE      FIX     DUMP TIME ";               07541000
   TBUF(20):=FIXIT(CORE(VERNO));                               <<01875>>07543000
   TBUF(26):=FIXIT(CORE(UPNO));                                <<01875>>07545000
   TBUF(30):=FIXIT(CORE(FNO));                                 <<01875>>07547000
RECOVER'DATE(TBUF);                                            <<03083>>07549000
         PAGENO:=0;                                                     07551000
         BANKNO:=0;                                                     07553000
         INDXARAY:=0;                                                   07555000
         MOVE INDXARAY (1) := INDXARAY, ((LSTSYSDST+2) * 2);   <<03556>>07557000
         MPEMIT2:=FOPEN(MPEMIT2N,5,0);     <<OPEN MPEMIT2>>    <<00221>>07559000
          IF = THEN                                            <<00221>>07561000
           BEGIN          <<SEE IF CUSTOM, IF NOT FCLOSE>>     <<00221>>07563000
            FGETINFO(MPEMIT2,,,,,,,,MPEFCODE);                 <<00221>>07565000
            IF MPEFCODE<>1020 THEN                             <<00221>>07567000
             BEGIN        <<NOT TO BE LISTED>>                 <<00221>>07569000
              FCLOSE(MPEMIT2,0,0);   <<CLOSE IT>>              <<00221>>07571000
              MPEMIT2:=0;                                      <<00221>>07573000
             END          <<NOT TO BE LISTED>>                 <<00221>>07575000
            ELSE                                               <<00221>>07577000
             BEGIN        <<READ HEADER LINES>>                <<00221>>07579000
              FREAD(MPEMIT2,COPYRITE(16),-56);                 <<00221>>07581000
              FREAD(MPEMIT2,COPYRITE(45),-40);                 <<00221>>07583000
             END;         <<READ HEADER LINES>>                <<00221>>07585000
           END;           <<SEE IF CUSTOM, IF NOT FCLOSE>>     <<00221>>07587000
      END;                                                              07589000
                                                                        07591000
$PAGE "RECOVER'DATE: Convert calender and clock to date and time"       07593000
$CONTROL SEGMENT=INIT                                                   07595000
COMMENT                                                                 07597000
                                                                        07599000
Purpose:                                                                07601000
     Dig out a date from data in TBUF.  Called by TAPETODISK.           07603000
                                                                        07605000
Input parameters:                                                       07607000
                                                                        07609000
Output parameters:                                                      07611000
                                                                        07613000
Globals Referenced:                                                     07615000
                                                                        07617000
Globals Altered:                                                        07619000
                                                                        07621000
Data Structures:                                                        07623000
                                                                        07625000
Algorithm:                                                              07627000
                                                                        07629000
;                                                                       07631000
PROCEDURE RECOVER'DATE(TBUF);                                  <<03083>>07633000
ARRAY TBUF;                                                    <<03083>>07635000
BEGIN                                                          <<03083>>07637000
   INTEGER D,D',Y,M,H;                                         <<03083>>07639000
   DOUBLE LOCTRL,T'CONVERT;                                    <<03083>>07641000
   DEFINE TIME'MOD'TOS=ASSEMBLE(DDIV;DELB)#,                   <<03083>>07643000
          DUPLICATE=ASSEMBLE(DUP)#;                            <<03083>>07645000
   REAL TICK'TO'MS :=9.14566375E-2;                            <<03083>>07647000
         TOS:=0;                                               <<03083>>07649000
                                                               <<03083>>07651000
         TOS:=CORE(TRLB)+%1000;                                <<03083>>07653000
         LOCTRL:=TOS;                                          <<03083>>07655000
         TOS:=CORE(LOCTRL+7D);  <<YEAR:JULIAN DAY>>            <<03083>>07657000
         DUPLICATE;                                            <<03083>>07659000
         D:=TOS.(7:9);          <<JULIAN DAY>>                 <<03083>>07661000
         Y:=TOS.(0:7);          <<YEAR>>                       <<03083>>07663000
         TOS:=CORE(LOCTRL+5D);                                 <<03083>>07665000
         TOS:=CORE(LOCTRL+6D);                                 <<03083>>07667000
         IF MACHINEID = MODEL25 THEN                           <<03083>>07669000
         BEGIN                                                 <<03083>>07671000
                                                               <<03083>>07673000
         << BACKWARDS COMPATABILITY CHECK:  CHANGE TO 33   >>  <<03083>>07675000
         << INTRODUCED IN B.01.01.  BEFORE THEN, THE THREE >>  <<03083>>07677000
         << CELLS CHECKED HERE WERE NOT USED AND           >>  <<03083>>07679000
         << INITIALLY WERE SET TO ZERO.                    >>  <<03083>>07681000
         << THESE CELLS ARE THE SYSGLOB EXTENSION VERSION, >>  <<03083>>07683000
         << UPDATE, AND FIX LEVELS (MIT NUMBERS, NOT       >>  <<03083>>07685000
         << MODIFYABLE.                                    >>  <<03083>>07687000
         IF  CORE( SYSGLOBX'VER ) = 0  AND                     <<03083>>07689000
             CORE( SYSGLOBX'UPD ) = 0  AND                     <<03083>>07691000
             CORE( SYSGLOBX'FIX ) = 0  THEN                    <<03083>>07693000
         BEGIN                                                 <<03083>>07695000
                                                               <<03083>>07697000
            << SERIES 33'S STORE NUMBER OF TICKS, NOT MS. >>   <<03083>>07699000
               T'CONVERT := TOS;                               <<03083>>07701000
               T'CONVERT:=FIXR( REAL(T'CONVERT)*TICK'TO'MS);   <<03083>>07703000
               TOS := T'CONVERT;                               <<03083>>07705000
                                                               <<03083>>07707000
            END;  << BACKWARDS COMPATABILITY CHECK. >>         <<03083>>07709000
                                                               <<03083>>07711000
         END;                                                  <<03083>>07713000
         TOS:=60000D;                                          <<03083>>07715000
         ASSEMBLE(DDIV; DDEL); <<MINUTES>>                     <<03083>>07717000
         TOS:=60D;                                             <<03083>>07719000
         TIME'MOD'TOS;     <<HOURS>>                           <<03083>>07721000
         M:=TOS;           <<REMAINDER=MINUTES>>               <<03083>>07723000
         TOS:=24D;                                             <<03083>>07725000
         TIME'MOD'TOS;      <<DAYS>>                           <<03083>>07727000
         H:=TOS;     <<REMAINDER= HOURS>>                      <<03083>>07729000
         ASSEMBLE(DELB);                                       <<03083>>07731000
         D:=D+TOS;     <<UPDATE JULIAN DAY>>                   <<03083>>07733000
         TOS:=Y;                                               <<03083>>07735000
         TOS:=4;                                               <<03083>>07737000
         ASSEMBLE(DIV);     <<TEST FOR LEAP YEAR>>             <<03083>>07739000
         IF TOS=0 THEN D':=366                                 <<03083>>07741000
         ELSE D':=365;                                         <<03083>>07743000
         ASSEMBLE(DEL);                                        <<03083>>07745000
         TOS:=D;                                               <<03083>>07747000
         TOS:=D';                                              <<03083>>07749000
         ASSEMBLE(DIV);     <<GET EXTRA YEARS>>                <<03083>>07751000
         D:=TOS;     <<REMAINDER= DAYS>>                       <<03083>>07753000
       IF MACHINEID=MODEL25 THEN D:=D+INTEGER(CORE(LOCTRL+3D));<<04748>>07755000
         Y:=Y+TOS;                                             <<03083>>07757000
         IF Y > 99 THEN Y:=Y-100;                              <<03083>>07759000
         TOS.(0:7):=Y;                                         <<03083>>07761000
         TOS.(7:9):=D;                                         <<03083>>07763000
         CALENDAR:=TOS;                                        <<03083>>07765000
         TOS.(0:8):=H;                                         <<03083>>07767000
         TOS.(8:8):=M;                                         <<03083>>07769000
         CLOCK:=TOS;                                           <<03083>>07771000
         GETDATE;                                              <<03083>>07773000
END;                                                           <<03083>>07775000
                                                                        07777000
$PAGE "GETDATE: Format date"                                            07779000
$CONTROL SEGMENT=INIT                                          <<01.3A>>07781000
COMMENT                                                                 07783000
                                                                        07785000
Purpose:                                                                07787000
    Do some work for RECOVER'DATE, which is the sole caller.            07789000
                                                                        07791000
Input parameters:                                                       07793000
                                                                        07795000
Output parameters:                                                      07797000
                                                                        07799000
Globals Referenced:                                                     07801000
                                                                        07803000
Globals Altered:                                                        07805000
                                                                        07807000
Data Structures:                                                        07809000
                                                                        07811000
Algorithm:                                                              07813000
                                                                        07815000
;                                                                       07817000
PROCEDURE GETDATE;                                                      07819000
      BEGIN                                                             07821000
         INTEGER ARRAY DAYSPERMONTH(0:11)=PB:=                          07823000
         0,31,60,91,121,152,182,213,244,274,305,335;                    07825000
         INTEGER DATE=Q+1,TIME=Q+2,YEAR=Q+3,DAY=Q+4,X=X,HOUR=DAY;       07827000
         EQUATE NOON=12*256;                                            07829000
                                                                        07831000
                                                                        07833000
         SUBROUTINE CONVERT(N,POSITION);                                07835000
         VALUE N,POSITION;                                              07837000
         INTEGER N,POSITION;                                            07839000
         BEGIN                                                          07841000
            X:=POSITION;                                                07843000
            TOS:=N;                                                     07845000
            ASSEMBLE(LDI 10;DIV,XCH);                                   07847000
            STRING(X):=TOS+"0";                                         07849000
            STRING(X:=X+1):=TOS+"0";                                    07851000
         END;    <<CONVERT>>                                            07853000
         TOS:=CALENDAR;                                                 07855000
         TOS:=CLOCK;                                                    07857000
         TOS:=DATE.(0:7);TOS:=DATE.(7:9);                               07859000
         X:=((YEAR-1)&ASR(2)+YEAR+DAY) MOD 7*3;  <<DAY OF WEEK>>        07861000
         MOVE STRING:="  /  /  ,   :  AM";                              07863000
         IF YEAR.(14:2) <> 0 AND DAY >=60 THEN DAY:=DAY+1;              07865000
         IF 1 <= DAY <= 366 THEN ELSE RETURN;                  <<01.KS>>07867000
            << PREVENT OUT OF BOUNDS DAYSPERMONTH INDEX>>      <<08.EB>>07869000
         X:=12;                                                         07871000
         DO X:=X-1 UNTIL DAYSPERMONTH(X)< DAY;                          07873000
         DAY:=DAY-DAYSPERMONTH(X);                                      07875000
         CONVERT(X:=X+1,0);                                             07877000
         IF STRING="0" THEN STRING:=" ";                                07879000
         CONVERT(DAY,3);                                                07881000
         CONVERT(YEAR,6);                                               07883000
         TOS:=(TIME.(0:8)+11) MOD 12+1;                                 07885000
         CONVERT(*,10);                                                 07887000
         IF STRING(10)="0" THEN STRING(10):=" ";                        07889000
         CONVERT(TIME.(8:8),13);                                        07891000
         IF TIME >= NOON THEN STRING(15):="P";                          07893000
         END;                                                           07895000
                                                                        07897000
$PAGE "TAPE'MODIFY'ERROR: Note tape modification errors"                07899000
$CONTROL SEGMENT=INIT                                                   07901000
PROCEDURE TAPE'MODIFY'ERROR(MSGNUM,FILENUM);                   <<03083>>07903000
  VALUE MSGNUM;                                                <<03083>>07905000
  INTEGER MSGNUM,                                              <<03083>>07907000
          FILENUM;                                             <<03083>>07909000
COMMENT                                                                 07911000
                                                                        07913000
Purpose:                                                                07915000
                                                                        07917000
Input parameters:                                                       07919000
                                                                        07921000
Output parameters:                                                      07923000
                                                                        07925000
Globals Referenced:                                                     07927000
                                                                        07929000
Globals Altered:                                                        07931000
                                                                        07933000
Data Structures:                                                        07935000
                                                                        07937000
Algorithm:                                                              07939000
                                                                        07941000
;                                                                       07943000
  BEGIN                                                        <<03083>>07945000
    INTEGER ERRORCODE;                                         <<03083>>07947000
                                                               <<03083>>07949000
    MOVE DBUFFER:="** DPAN ERROR --";                          <<03083>>07951000
    PRINT(DBUFFER,-16,%320);                                   <<03083>>07953000
    CASE MSGNUM OF                                             <<03083>>07955000
      BEGIN                                                    <<03083>>07957000
      MOVE DBUFFER:="FWRITE FAILURE IN WRITE TO TAPE     ";    <<03083>>07959000
      MOVE DBUFFER:="FWRITE ERROR TEMP FILE WRITE FAILURE";    <<03083>>07961000
      MOVE DBUFFER:="FREAD ERROR IN READ FROM DISC FILE  ";    <<03083>>07963000
      MOVE DBUFFER:="FCONTROL ERROR IN EOF WRITE TO TAPE ";    <<03083>>07965000
      MOVE DBUFFER:="FSPACE ERROR IN MOVEMENT OF TAPE    ";    <<03083>>07967000
      MOVE DBUFFER:="FOPEN ERROR -- DISC FILE OPEN FAILED";    <<03083>>07969000
      MOVE DBUFFER:="FCLOSE ERROR -- TEMP FILE NOT CLOSED";    <<03083>>07971000
      MOVE DBUFFER:="FCLOSE ERROR -- DISC FILE NOT CLOSED";    <<03083>>07973000
      BEGIN                                                    <<03083>>07975000
        FCHECK(FILENUM,ERRORCODE);                             <<03083>>07977000
        IF ERRORCODE = 38 THEN                                 <<03083>>07979000
          BEGIN                                                <<03083>>07981000
          MOVE LOADMAP:="LOADMAP.PUB.SYS;";                    <<03083>>07983000
          MOVE MAPNAME:="MPECHECK.PUB.SYS;";                   <<03083>>07985000
          MOVE DBUFFER:="TAPE PARITY ERROR -- FILES INVALID";  <<03083>>07987000
          PRINT(DBUFFER,-34,0);                                <<03083>>07989000
          MOVE DBUFFER:="DUMP MAY INCLUDE SEVERAL INVALID";    <<03083>>07991000
          PRINT(DBUFFER,-32,0);                                <<03083>>07993000
          MOVE DBUFFER:="FILE REFERENCES IN FORMATTED TABLE  ";<<03083>>07995000
          END                                                  <<03083>>07997000
        ELSE                                                   <<03083>>07999000
          BEGIN                                                <<03083>>08001000
          MOVE DBUFFER:="FWRITE FAILURE IN WRITE TO TAPE     ";<<03083>>08003000
          MSGNUM:=0;                                           <<03083>>08005000
          END;                                                 <<03083>>08007000
      END;                                                     <<03083>>08009000
      BEGIN                                                    <<03083>>08011000
        MOVE DBUFFER:="INVALID DUMP TAPE -- CATASTROPHIC TAPE";<<03083>>08013000
        PRINT(DBUFFER,-38,0);                                  <<03083>>08015000
        MOVE DBUFFER:="ERRORS -- UNABLE TO READ DUMP       ";  <<03083>>08017000
        MSGNUM:=0;                                             <<03083>>08019000
      END;                                                     <<03083>>08021000
      BEGIN                                                    <<03083>>08023000
        FILE'REQUIRED:=TRUE;                                   <<03083>>08025000
        MOVE DBUFFER:="TAPE INCORRECTLY PREPARED           ";  <<03083>>08027000
      END;                                                     <<03083>>08029000
      END;                                                     <<03083>>08031000
    PRINT(DBUFFER,-36,0);                                      <<03083>>08033000
    IF MSGNUM <> 10 THEN                                       <<03083>>08035000
      PRINT'FILE'INFO(FILENUM);                                <<03083>>08037000
    IF MSGNUM < 6 THEN                                         <<03083>>08039000
       QUIT(MSGNUM);                                           <<03083>>08041000
  END;                                                         <<03083>>08043000
                                                                        08045000
$PAGE "PRINTING UTILITIES"                                              08047000
$CONTROL SEGMENT=UTIL                                                   08049000
COMMENT                                                                 08051000
                                                                        08053000
Purpose:                                                                08055000
     There are several printing utilities available in DPAN.            08057000
     These not only make output easier, but maintain global             08059000
     variables like PAGENO.                                             08061000
                                                                        08063000
Input parameters:                                                       08065000
                                                                        08067000
Output parameters:                                                      08069000
                                                                        08071000
Globals Referenced:                                                     08073000
     DBUFFER is the print buffer.                                       08075000
     BBUF is the byte equivalent of DBUFFER                             08077000
     @BBUF points to BBUF                                               08079000
     LPF fileno of output file DPANLIST                                 08081000
     PAGENO current page number                                         08083000
     LINECOUNT current line number on page                              08085000
     LNSPERPG maximum lines per page                                    08087000
                                                                        08089000
Globals Altered:                                                        08091000
                                                                        08093000
Data Structures:                                                        08095000
                                                                        08097000
Algorithm:                                                              08099000
                                                                        08101000
;                                                                       08103000
<<             PUT NUMBER                                         >>    08105000
<<    THIS PROCEDURE CONVERTS A NUMBER INTO AN ASCII              >>    08107000
<<    REPRESENTATION OF OCTAL AND STORES IT INTO THE PRINT BUFFER >>    08109000
<<    AT THE CURRENT POINTER AND ADVANCES THE POINTER.            >>    08111000
<<    THE NUMBER ALWAYS OCCUPIES A SEVEN POSITION FIELD WITH A << WBT >>08113000
<<    TRAILING BLANK.  PUTNUM DOES NOT SUPPRESS LEADING ZEROS. << WBT >>08115000
<<    PUTNUMP SUPPRESSES LEADING ZEROS AND DOES NOT ALTER THE  << WBT >>08117000
<<    LOCATIONS WHERE THEY WOULD HAVE BEEN PUT.  THE NUMBERS AR<< WBT >>08119000
<<    RIGHT JUSTIFIED IN THE FIELD (EXCEPT FOR THE TRAILING BLA<< WBT >>08121000
<<                                                             << WBT >>08123000
PROCEDURE PUTNUM(NUM);                                                  08125000
      VALUE NUM;                                                        08127000
      INTEGER NUM;                                                      08129000
      BEGIN                                                             08131000
         INTEGER I:=5;                                                  08133000
         LOGICAL FLAG:=FALSE;                                           08135000
         ENTRY PUTNUMP;                                                 08137000
         FLAG:=TRUE;                                                    08139000
PUTNUMP:                                                                08141000
        BBUF(140):=" ";                                                 08143000
        MOVE BBUF(141):=BBUF(140),(15);                                 08145000
        TOS:=NUM;                                                       08147000
        TOS:=TOS&CSL(1);                                                08149000
        TOS:=S0.(15:1);                                                 08151000
LOOP:                                                                   08153000
        IF <> OR FLAG OR I=0 THEN                                       08155000
        BEGIN                                                           08157000
           PBUF:=TOS+"0";                                               08159000
           FLAG:=TRUE;                                                  08161000
        END ELSE                                                        08163000
        BEGIN                                                           08165000
           DEL;                                                         08167000
        END;                                                            08169000
        @PBUF:=@PBUF+1;                                                 08171000
        I:=I-1;                                                         08173000
        IF < THEN                                                       08175000
        BEGIN                                                           08177000
           PBUF:=" ";                                                   08179000
           @PBUF:=@PBUF+1;                                              08181000
           RETURN;                                                      08183000
        END;                                                            08185000
        TOS:=TOS&CSL(3);                                                08187000
        TOS:=S0.(13:3);                                                 08189000
        GO LOOP;                                                        08191000
     END;                                                               08193000
                                                                        08195000
$PAGE "PUTNZ(NUM,COL): Put non-zero numbers in PBUF"                    08197000
$CONTROL SEGMENT=UTIL                                                   08199000
COMMENT                                                                 08201000
                                                                        08203000
Purpose:                                                                08205000
          PLACE NUM IN PRINT BUFFER WITH RIGHTMOST DIGIT       << WBT >>08207000
          AT COLUMN COL.  IF ZERO, DO NOTHING                  << WBT >>08209000
                                                                        08211000
Input parameters:                                                       08213000
                                                                        08215000
Output parameters:                                                      08217000
                                                                        08219000
Globals Referenced:                                                     08221000
                                                                        08223000
Globals Altered:                                                        08225000
                                                                        08227000
Data Structures:                                                        08229000
                                                                        08231000
Algorithm:                                                              08233000
                                                                        08235000
;                                                                       08237000
   PROCEDURE PUTNZ(NUM, COL);                                  << WBT >>08239000
      VALUE NUM, COL;                                          << WBT >>08241000
      LOGICAL NUM;                                             << WBT >>08243000
      INTEGER COL;                                             << WBT >>08245000
      BEGIN                                                    << WBT >>08247000
      ENTRY PUTOCTALP;                                         << WBT >>08249000
         IF NUM=0 THEN RETURN;                                 << WBT >>08251000
PUTOCTALP:  @PBUF:=@BBUF+COL-6;                                << WBT >>08253000
         PUTNUMP(NUM);                                         << WBT >>08255000
      END;                                                     << WBT >>08257000
                                                                        08259000
$PAGE "PUTOCTAL(NUM,COL): Write octal value to PBUF"                    08261000
$CONTROL SEGMENT=UTIL                                                   08263000
COMMENT                                                                 08265000
                                                                        08267000
Purpose:                                                                08269000
     Simplify writing octal values to PBUF.                             08271000
                                                                        08273000
Input parameters:                                                       08275000
                                                                        08277000
Output parameters:                                                      08279000
                                                                        08281000
Globals Referenced:                                                     08283000
                                                                        08285000
Globals Altered:                                                        08287000
                                                                        08289000
Data Structures:                                                        08291000
                                                                        08293000
Algorithm:                                                              08295000
                                                                        08297000
;                                                                       08299000
   PROCEDURE PUTOCTAL(NUM, COL);                               << WBT >>08301000
   VALUE NUM, COL;                                             << WBT >>08303000
   LOGICAL NUM; INTEGER COL;                                   << WBT >>08305000
   BEGIN                                                       << WBT >>08307000
      @PBUF:=@BBUF+COL-6;                                      << WBT >>08309000
      PUTNUM(NUM);                                             << WBT >>08311000
   END;                                                        << WBT >>08313000
                                                                        08315000
$PAGE "DCONS(HI,LO): Join HI and LO into a doubleword"                  08317000
$CONTROL SEGMENT=UTIL                                                   08319000
COMMENT                                                                 08321000
                                                                        08323000
Purpose:                                                                08325000
                                                                        08327000
Input parameters:                                                       08329000
                                                                        08331000
Output parameters:                                                      08333000
                                                                        08335000
Globals Referenced:                                                     08337000
                                                                        08339000
Globals Altered:                                                        08341000
                                                                        08343000
Data Structures:                                                        08345000
                                                                        08347000
Algorithm:                                                              08349000
                                                                        08351000
;                                                                       08353000
DOUBLE PROCEDURE DCONS(HI,LO);                                 <<01875>>08355000
VALUE HI, LO; LOGICAL HI,LO;                                   <<01875>>08357000
BEGIN                                                          <<01875>>08359000
   TOS:=HI;                                                    <<01875>>08361000
   TOS:=LO;                                                    <<01875>>08363000
   DCONS:=TOS;                                                 <<01875>>08365000
END;                                                           <<01875>>08367000
                                                                        08369000
$PAGE "PUTDNUM: Convert doubleword value to ascii, place in PBUF"       08371000
$CONTROL SEGMENT=UTIL                                                   08373000
COMMENT                                                                 08375000
                                                                        08377000
Purpose:                                                                08379000
<<             PUT DOUBLE NUMBER                                  >>    08381000
<<    THIS PROCEDURE CONVERTS A DOUBLE WORD NUMBER INTO AN ASCII  >>    08383000
<<    REPRESENTATION OF OCTAL AND STORES IT INTO THE PRINT BUFFER >>    08385000
<<    AT THE CURRENT POINTER AND ADVANCES THE POINTER             >>    08387000
<<                                                                >>    08389000
                                                                        08391000
Input parameters:                                                       08393000
                                                                        08395000
Output parameters:                                                      08397000
                                                                        08399000
Globals Referenced:                                                     08401000
                                                                        08403000
Globals Altered:                                                        08405000
                                                                        08407000
Data Structures:                                                        08409000
                                                                        08411000
Algorithm:                                                              08413000
                                                                        08415000
;                                                                       08417000
PROCEDURE PUTDNUM(DNUM);                                                08419000
      VALUE DNUM;                                                       08421000
      DOUBLE DNUM;                                                      08423000
      BEGIN                                                             08425000
         LOGICAL FLAG:=FALSE;                                           08427000
         INTEGER I:=10;                                        <<01.02>>08429000
         ENTRY PUTDNUMP;                                       <<01.02>>08431000
         FLAG:=TRUE;                                           <<01.02>>08433000
PUTDNUMP:                                                      <<01.02>>08435000
           BBUF(140):=" ";                                     <<01.02>>08437000
           MOVE BBUF(141):=BBUF(140),(15);                     <<01.02>>08439000
           TOS:=DNUM;                                          <<01.02>>08441000
           TOS:=TOS&DCSL(1);<<GET LOW ORDER BIT>>              <<01.02>>08443000
           TOS:=S0.(15:1);                                     <<01.02>>08445000
           IF <> THEN                                          <<01.02>>08447000
           BEGIN                                               <<01.02>>08449000
              PBUF:="-"; DEL;                                  <<01.02>>08451000
              @PBUF:=@PBUF+1;                                  <<01.02>>08453000
           END ELSE DEL;                                       <<01.02>>08455000
           TOS:=TOS&DCSL(1);<<GET NEXT LOW ORDER BIT>>         <<01.02>>08457000
           TOS:=S0.(15:1);                                     <<01.02>>08459000
LOOP:                                                          <<01.02>>08461000
           IF <> OR FLAG OR I=0 THEN                           <<01.02>>08463000
           BEGIN                                               <<01.02>>08465000
              PBUF:=TOS+"0";                                   <<01.02>>08467000
              FLAG:=TRUE;                                      <<01.02>>08469000
              @PBUF:=@PBUF+1;                                  <<01.02>>08471000
           END ELSE DEL;                                       <<01.02>>08473000
           I:=I-1;                                             <<01.02>>08475000
           IF < THEN                                           <<01.02>>08477000
           BEGIN                                               <<01.02>>08479000
              PBUF:=" ";                                       <<01.02>>08481000
              @PBUF:=@PBUF+1;                                  <<01.02>>08483000
              RETURN;                                          <<01.02>>08485000
           END;                                                <<01.02>>08487000
           TOS:=TOS&DCSL(3);                                   <<01.02>>08489000
           TOS:=S0.(13:3);                                     <<01.02>>08491000
           GO LOOP;                                            <<01.02>>08493000
        END;<<PUTDNUM/PUTDNUMP>>                               <<01.02>>08495000
                                                                        08497000
$PAGE "PRINTLINE: Print line and maintain LINECOUNT and newpage"        08499000
$CONTROL SEGMENT=UTIL                                                   08501000
PROCEDURE PRINTLINE;                                                    08503000
COMMENT                                                                 08505000
                                                                        08507000
Purpose:                                                                08509000
<<             PRINTLINE                                          >>    08511000
<<    THIS PROCEDURE WILL OUTPUT A LINE TO THE LINE PRINTER FROM  >>    08513000
<<    DBUFFER. AFTER PRINTING LINECOUNT IS INCREMENTED BY 1 AND   >>    08515000
<<    CHECKED FOR =60. IF SO NEWPAGE IS CALLED TO PRINT HEADER .  >>    08517000
<<    NEWPAGE WILL RESET LINECOUNT TO 0 PRIOR TO PRINTING         >>    08519000
<<    HEADER. AFTER PRINTING THE PRINT BUFFER IS FILLED WITH      >>    08521000
<<    BLANKS.                                                     >>    08523000
<<                                                                >>    08525000
                                                                        08527000
Input parameters:                                                       08529000
                                                                        08531000
Output parameters:                                                      08533000
                                                                        08535000
Globals Referenced:                                                     08537000
                                                                        08539000
Globals Altered:                                                        08541000
                                                                        08543000
Data Structures:                                                        08545000
                                                                        08547000
Algorithm:                                                              08549000
                                                                        08551000
;                                                                       08553000
      BEGIN                                                             08555000
         ENTRY BLANKBUF;                                                08557000
         IF NOPRFLAG THEN GO NOPRJMP;                          <<00221>>08559000
         FWRITE(LPF,DBUFFER,66,0);                                      08561000
         IF <> THEN                                                     08563000
         BEGIN                                                          08565000
           PRINT'FILE'INFO(LPF);                                        08567000
           ERROR;                                                       08569000
         END;                                                           08571000
NOPRJMP:   <<NO PRINT JUMP POINT>>                             <<00221>>08573000
         @PBUF:=@BBUF;                                                  08575000
         LINECOUNT:=LINECOUNT+1;                                        08577000
BLANKBUF:                                                               08579000
         DBUFFER:="  ";                                                 08581000
         MOVE DBUFFER(1):=DBUFFER,(65);                                 08583000
         IF LINECOUNT > LNSPERPG THEN NEWPAGE;                 <<00221>>08585000
      END;                                                              08587000
                                                                        08589000
$PAGE "SKIPLINES: Skip N lines, maintain linecount and newpage"         08591000
$CONTROL SEGMENT=UTIL                                                   08593000
COMMENT                                                                 08595000
                                                                        08597000
Purpose:                                                                08599000
<<             SKIP LINES                                         >>    08601000
<<    THIS PROCEDURE SKIPS THE SPECIFIED NUMBER OF LINES.         >>    08603000
<<    FIRST A CHECK IS MADE FOR LINECOUNT+ NUMBER OF LINES TO     >>    08605000
<<    BE SKIPPED =>60.  IF SO NO LINES ARE SKIPPED AND NEWPAGE    >>    08607000
<<    IS CALLED.ELSE LINES ARE SKIPPED AND LINECOUNT IS           >>    08609000
<<    INCREMENTED BY THE NUMBER OF LINES SKIPPED.                 >>    08611000
<<                                                                >>    08613000
                                                                        08615000
Input parameters:                                                       08617000
                                                                        08619000
Output parameters:                                                      08621000
                                                                        08623000
Globals Referenced:                                                     08625000
                                                                        08627000
Globals Altered:                                                        08629000
                                                                        08631000
Data Structures:                                                        08633000
                                                                        08635000
Algorithm:                                                              08637000
                                                                        08639000
;                                                                       08641000
PROCEDURE SKIPLINES(NLINES);                                            08643000
      VALUE NLINES;                                                     08645000
      INTEGER NLINES;                                                   08647000
      BEGIN                                                             08649000
         LINECOUNT:=LINECOUNT+NLINES;                                   08651000
         IF LINECOUNT > LNSPERPG THEN                          <<00221>>08653000
         BEGIN                                                          08655000
            NEWPAGE;                                                    08657000
            GO TO ENDSKIP;                                              08659000
         END;                                                           08661000
         IF NOPRFLAG THEN RETURN;       <<SUPPRESS FLAG>>      <<00221>>08663000
         FWRITE(LPF,DBUFFER,0,(NLINES+%200));                           08665000
         IF <> THEN                                                     08667000
         BEGIN                                                          08669000
           PRINT'FILE'INFO(LPF);                                        08671000
           ERROR;                                                       08673000
         END;                                                           08675000
ENDSKIP:                                                                08677000
         END;                                                           08679000
                                                                        08681000
$PAGE "NEWPAGE: Skip page, update pagecount, linecount"                 08683000
$CONTROL SEGMENT=UTIL                                                   08685000
COMMENT                                                                 08687000
                                                                        08689000
Purpose:                                                                08691000
<<             NEW PAGE                                           >>    08693000
<<    THIS PROCEDURE CHECKS FOR LINECOUNT<60 AND PAGE EJECTS      >>    08695000
<<    IF SO.  LINECOUNT IS RESET TO 0 AND A HEADER LINE IS        >>    08697000
<<    PRINTED.                                                    >>    08699000
<<                                                                >>    08701000
                                                                        08703000
Input parameters:                                                       08705000
                                                                        08707000
Output parameters:                                                      08709000
                                                                        08711000
Globals Referenced:                                                     08713000
                                                                        08715000
Globals Altered:                                                        08717000
                                                                        08719000
Data Structures:                                                        08721000
                                                                        08723000
Algorithm:                                                              08725000
                                                                        08727000
;                                                                       08729000
PROCEDURE NEWPAGE;                                                      08731000
      BEGIN                                                             08733000
         IF LINECOUNT = 3 THEN RETURN;  <<ALREADY AT TOF>>     <<00221>>08735000
         PAGENO:=PAGENO+1;                                              08737000
         LINECOUNT:=0;                                                  08739000
         BLANKBUF;                                                      08741000
         IF NOPRFLAG THEN                                      <<00221>>08743000
          BEGIN                                                <<00221>>08745000
           LINECOUNT:=3;              <<CORRECT LINE COUNT>>   <<00221>>08747000
           RETURN;                                             <<00221>>08749000
          END;                                                 <<00221>>08751000
         FWRITE(LPF,DBUFFER,0,%61);                                     08753000
         MOVE DBUFFER:=TBUF,(50);                                       08755000
         MOVE DBUFFER(61):="PAGE";                                      08757000
         IF BNKFLG THEN                                        <<00221>>08759000
         IF ASCII(BANKNO,8,BBUF(108)) = 1 THEN               <<00.01>>  08761000
MOVE BBUF(104):="  BANK   "                                    <<00221>>08763000
         ELSE                                                  <<00.01>>08765000
            MOVE BBUF(104):="  BANK %";                        <<00.01>>08767000
         ASCII(PAGENO,10,PSTRING);                                      08769000
         PRINTLINE;                                                     08771000
          BLANKBUF;                                           <<<01.02>>08773000
          MOVE DBUFFER:=COPYRITE,(66);                         <<00221>>08775000
          PRINTLINE;                                          <<<01.02>>08777000
          SKIPLINES(1);                                       <<<01.02>>08779000
      END;                                                              08781000
                                                                        08783000
$PAGE "ERROR: Call intrinsic terminate"                                 08785000
$CONTROL SEGMENT=UTIL                                                   08787000
COMMENT                                                                 08789000
                                                                        08791000
Purpose:                                                                08793000
<<             ERROR                                              >>    08795000
<<    THIS PROCEDURE PRINTS OPERATIONAL ERRORS ENCOUNTERED WITH   >>    08797000
<<    THE FILE SYSTEM.                                            >>    08799000
<<                                                                >>    08801000
                                                                        08803000
Input parameters:                                                       08805000
                                                                        08807000
Output parameters:                                                      08809000
                                                                        08811000
Globals Referenced:                                                     08813000
                                                                        08815000
Globals Altered:                                                        08817000
                                                                        08819000
Data Structures:                                                        08821000
                                                                        08823000
Algorithm:                                                              08825000
                                                                        08827000
;                                                                       08829000
PROCEDURE ERROR;                                                        08831000
      BEGIN                                                             08833000
         INTRINSIC TERMINATE;                                           08835000
         TERMINATE;                                                     08837000
         END;                                                           08839000
                                                                        08841000
$PAGE "FILCSTBLK: Copy CST block table into array of pointers"          08843000
$CONTROL SEGMENT=UTIL                                                   08845000
COMMENT                                                                 08847000
                                                                        08849000
Purpose:                                                                08851000
           THIS PROCEDURE COPIES THE CST BLOCK TABLE INTO      << WBT >>08853000
           THE ARRAY LCSTBLK=ICSTBLK.  A MAXIMUM OF 100        << WBT >>08855000
           ENTRIES ARE COPIED.  CSTBLK(0) IS THE NUMBER        << WBT >>08857000
           OF ENTRIES.  EACH ENTRY IS A DST RELATIVE INDEX     << WBT >>08859000
           TO A CSTX BLOCK.  %177777 INDICATES AN UNUSED       << WBT >>08861000
           ENTRY                                               << WBT >>08863000
Theoretically, the maximum should be 128, and 512 in MPE V.             08865000
Called by FILLMEMBUF and PRINTXCST. Redundant?                          08867000
                                                                        08869000
Input parameters:                                                       08871000
                                                                        08873000
Output parameters:                                                      08875000
                                                                        08877000
Globals Referenced:                                                     08879000
                                                                        08881000
Globals Altered:                                                        08883000
                                                                        08885000
Data Structures:                                                        08887000
                                                                        08889000
Algorithm:                                                              08891000
                                                                        08893000
;                                                                       08895000
PROCEDURE FILCSTBLK;                                           <<01.02>>08897000
BEGIN                                                          <<01.02>>08899000
                                                               <<01.02>>08901000
DOUBLE SCRATCH;                                                <<01.02>>08903000
LOGICAL ARRAY SCR0(*)=SCRATCH;                                 <<01.02>>08905000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<01.02>>08907000
LOGICAL WORK1,WORK2;                                           <<01.02>>08909000
INTEGER INDX;                                                  <<01.02>>08911000
LOGICAL ARRAY DSTA(0:3);                                       <<01.02>>08913000
                                                               << WBT >>08915000
                                                               <<01.02>>08917000
<<BEGIN BODY OF PROCEDURE>>                                    <<01.02>>08919000
                                                               <<01.02>>08921000
SCRATCH:=0D;                                                   <<01.02>>08923000
SCR1:=DSTFLG;                                                  <<01.02>>08925000
IF INTEGER(SCR1)=0 THEN RETURN;<<DST ADR NO GOOD..CANT GO ON>> <<01.02>>08927000
SCR1:=SCR1+(4*%43);<<OFFSET TO CSTBLK DST IN TABLE>>           <<01.02>>08929000
WORK2:=0;                                                      <<01.02>>08931000
WHILE INTEGER(WORK2) < 4 DO                                    <<01.02>>08933000
BEGIN<<MOVE DST ENTRY TO LOCAL ARRAY>>                         <<01.02>>08935000
   DSTA(WORK2):=CORE(SCRATCH+DOUBLE(WORK2));                   <<01.02>>08937000
   WORK2:=WORK2+1;                                             <<01.02>>08939000
END;                                                           <<01.02>>08941000
IF DSTA.(0:1) =0 THEN GO GETBLK;<<DST IN MAIN MEM.>>           <<01.02>>08943000
IF DSTA(1).(1:15) = 0 THEN RETURN;<<REALLY ABSENT>>            <<01.02>>08945000
IF DSTA(3) <> 0 THEN <<PRESENT& ON OLSQ/LOKQ>>                 <<01.02>>08947000
GETBLK:                                                        <<01.02>>08949000
BEGIN                                                          <<01.02>>08951000
   SCR1:=DSTA(3);<<MEM ADR. OF CSTBLK DST#%43>>                <<01.02>>08953000
   WORK1:=CORE(SCRATCH);<<FIRST LOC. OF DST>>                  <<01.02>>08955000
   IF INTEGER(WORK1) <=0 THEN RETURN;<<#ENTRYS INVALID>>       <<01.02>>08957000
   IF INTEGER(WORK1) > 100 THEN WORK1:=100;<<SET ARBITRARY LIMI<<01.02>>08959000
   LCSTBLK:=WORK1;<<SET ARRAY LIMIT>>                          <<01.02>>08961000
   INDX:=1;                                                    <<01.02>>08963000
   WHILE INDX < INTEGER(WORK1) DO                              <<01.02>>08965000
   BEGIN                                                       <<01.02>>08967000
      LCSTBLK(INDX):=CORE(SCRATCH+DOUBLE(INDX));               <<01.02>>08969000
      INDX:=INDX+1;                                            <<01.02>>08971000
   END;                                                        <<01.02>>08973000
END;                                                           <<01.02>>08975000
END<<FILCSTBLK>>;                                              <<01.02>>08977000
                                                                        08979000
$PAGE "FIXPCBSTACK: initialize PCBSTACK array"                          08981000
$CONTROL SEGMENT=INIT                                                   08983000
COMMENT                                                                 08985000
                                                                        08987000
Purpose:                                                                08989000
     Called once by PROCESS'DUMP to initialize PCBSTACK array           08991000
                                                                        08993000
Input parameters:                                                       08995000
                                                                        08997000
Output parameters:                                                      08999000
                                                                        09001000
Globals Referenced:                                                     09003000
                                                                        09005000
Globals Altered:                                                        09007000
                                                                        09009000
Data Structures:                                                        09011000
                                                                        09013000
Algorithm:                                                              09015000
                                                                        09017000
;                                                                       09019000
PROCEDURE FIXPCBSTACK;                                         << WBT >>09021000
BEGIN                                                          << WBT >>09023000
   INTEGER INDX;                                               << WBT >>09025000
   LOGICAL STKDST;                                             << WBT >>09027000
   DOUBLE LOCPCB;                                              <<01791>>09029000
   EQUATE PCBSIZE=%20;                                         <<01791>>09031000
   OWN BYTE ARRAY PCBNAME(0:9):=9,"PCB TABLE";                 <<01875>>09033000
   PCBSTACK:=0;                                                << WBT >>09035000
   MOVE PCBSTACK(1):=PCBSTACK,(255);                           << WBT >>09037000
   IF PCBDEFIN=0D OR DSTDEFIN=0D THEN RETURN;                  << WBT >>09039000
   PCB'ADDR:=LOCPCB:=VERIFYP(%3, %1003D);                      <<01791>>09041000
   MAKEFREEMAP(PCB'ADDR, ISFREEPCB, 16, 255, PCBNAME);         <<01875>>09043000
   INDX:=1;                                                    << WBT >>09045000
   DO                                                          << WBT >>09047000
   BEGIN                                                       << WBT >>09049000
      IF NOT ISFREEPCB(INDX) THEN                              << WBT >>09051000
      BEGIN                                                    << WBT >>09053000
         STKDST:=PCB03.(1:10);                                 << WBT >>09055000
         IF CORE(DSTDEFIN+DOUBLE(4*STKDST)).(0:1)=0 OR         << WBT >>09057000
            CORE(DSTDEFIN+DOUBLE(4*STKDST+1)).(1:1)=1          << WBT >>09059000
         THEN PCBSTACK(INDX):=STKDST;                          << WBT >>09061000
      END;                                                     << WBT >>09063000
      INDX:=INDX+1;                                            << WBT >>09065000
   END                                                         << WBT >>09067000
   UNTIL INDX>=INTEGER(CORE(LOCPCB))+1;                        << WBT >>09069000
END; <<FIXPCBSTACK>>                                           << WBT >>09071000
                                                                        09073000
$PAGE "PUTSEGID : Classify a segment "                                  09075000
$CONTROL SEGMENT=UTIl                                                   09077000
                                                               <<01791>>09079000
PROCEDURE PUTSEGID(SEGID, COL);                                <<01791>>09081000
                                                               <<01791>>09083000
VALUE SEGID, COL;                                              <<01791>>09085000
LOGICAL SEGID, COL;                                            <<01791>>09087000
                                                               <<01791>>09089000
BEGIN                                                          <<01791>>09091000
COMMENT                                                                 09093000
                                                                        09095000
Purpose:                                                                09097000
   This utility routine simply classifies a segment as to its           09099000
   type ( DST, CST, CSTX ).                                             09101000
                                                                        09103000
Input parameters:                                                       09105000
   SEGID - the segment identifier                                       09107000
                                                                        09109000
Output parameters:                                                      09111000
   COL - the column in the output buffer where the classification       09113000
         string belongs.                                                09115000
                                                                        09117000
Globals Referenced:                                                     09119000
                                                                        09121000
Globals Altered:                                                        09123000
                                                                        09125000
Data Structures:                                                        09127000
                                                                        09129000
Algorithm:                                                              09131000
                                                                        09133000
;                                                                       09135000
                                                               <<01791>>09137000
   IF SEGID=0 THEN RETURN;                                     <<01875>>09139000
   IF SEGID.SEGIDTYPEFIELD=SEGIDDATATYPE THEN                  <<01791>>09141000
   BEGIN                                                       <<01791>>09143000
      MOVE BBUF(COL-1):="DST       0";                         <<01791>>09145000
      IF SEGID.(2:1) = 1 THEN                                  <<CACHE>>09147000
         MOVE BBUF(COL-1):="CDT";                              <<CACHE>>09149000
      PUTOCTALP(SEGID.(3:13),COL+10);                          <<CACHE>>09151000
   END                                                         <<01791>>09153000
   ELSE IF SEGID.SEGIDTYPEFIELD=SEGIDSLTYPE THEN               <<01791>>09155000
   BEGIN                                                       <<01791>>09157000
      MOVE BBUF(COL-1):="CST       0";                         <<01791>>09159000
      PUTOCTALP(SEGID.(2:14), COL+10);                         <<01791>>09161000
   END                                                         <<01791>>09163000
   ELSE                                                        <<01791>>09165000
   BEGIN                                                       <<01791>>09167000
      MOVE BBUF(COL-1):="CTX   0.000";                         <<01791>>09169000
      PUTOCTALP(SEGID.SEGIDPBXFIELD, COL+6);                   <<01791>>09171000
      PUTOCTALP(SEGID.SEGIDLOGSEGFIELD, COL+10);               <<01791>>09173000
      BBUF(COL+6):=".";                                        <<01791>>09175000
   END;                                                        <<01791>>09177000
                                                               <<01791>>09179000
END; << PUTSEGID >>                                            <<01791>>09181000
                                                                        09183000
$PAGE "YESANSWER : Process a user reply"                                09185000
$CONTROL SEGMENT=INIT                                          <<01114>>09187000
 LOGICAL PROCEDURE YESANSWER(LENGTH);                          <<01114>>09189000
 VALUE LENGTH;                                                 <<01114>>09191000
 INTEGER LENGTH;                                               <<01114>>09193000
COMMENT                                                                 09195000
                                                                        09197000
Purpose:                                                                09199000
          This  procedure prints the message supplied in the            09201000
          buffer DBUFFER, and processes the yes/ no reply.              09203000
          The possible replys follow:                                   09205000
                                                                        09207000
               True(-1)   - Reply from user was YES or Y.               09209000
               False(0)   - User replyed with carriage return.          09211000
               False(2)   - User explicitly stated NO or N.             09213000
                            This return is used when                    09215000
                            determining whether to print a              09217000
                            code segment                                09219000
                                                                        09221000
Input parameters:                                                       09223000
                                                                        09225000
Output parameters:                                                      09227000
                                                                        09229000
Globals Referenced:                                                     09231000
                                                                        09233000
Globals Altered:                                                        09235000
                                                                        09237000
Data Structures:                                                        09239000
                                                                        09241000
Algorithm:                                                              09243000
                                                                        09245000
;                                                                       09247000
 BEGIN                                                         <<01114>>09249000
 INTEGER INDX, INX, LNGTH;                                     <<01114>>09251000
  BYTE POINTER BPS0=S-0;                                       <<01114>>09253000
  INDX := (LENGTH + 1) / 2;                                    <<01114>>09255000
  YESANSWER := 0;                                              <<01114>>09257000
  WHILE TRUE DO                                                <<01114>>09259000
   BEGIN                                                       <<01114>>09261000
    IF DUPLICATIVE THEN                                        <<01114>>09263000
     PRINT(DBUFFER,-LENGTH,%320);                              <<01114>>09265000
    LNGTH := READX(DBUFFER(INDX),-72);                         <<03079>>09267000
    INX := INDX&LSL(1);                                        <<01114>>09269000
    FWRITE(LPF,DBUFFER,-(INX+LNGTH),0);                        <<01114>>09271000
    IF <> THEN                                                 <<01114>>09273000
     BEGIN                                                     <<01114>>09275000
      PRINT'FILE'INFO(LPF);                                    <<01114>>09277000
      ERROR;                                                   <<01114>>09279000
     END;                                                      <<01114>>09281000
    BBUF(INX+LNGTH) := %15;                                    <<01114>>09283000
    SCAN BBUF(INX) WHILE " ",1;                                <<01114>>09285000
    ASSEMBLE(DUP,DDUP);                                        <<01114>>09287000
    MOVE * := * WHILE AS,1;                                    <<01114>>09289000
    LNGTH := -(TOS - TOS);                                     <<01114>>09291000
    CASE LNGTH OF                                              <<01114>>09293000
     BEGIN                                                     <<01114>>09295000
      RETURN;                     << REPLY WAS cr >>           <<01114>>09297000
      IF BPS0 = "Y" THEN                                       <<01114>>09299000
       BEGIN                                                   <<01114>>09301000
        YESANSWER := TRUE;                                     <<01114>>09303000
        RETURN;                                                <<01114>>09305000
       END                                                     <<01114>>09307000
       ELSE                                                    <<01114>>09309000
        IF BPS0 = "N" THEN                                     <<01114>>09311000
         BEGIN                                                 <<01114>>09313000
          YESANSWER := 2;                                      <<01114>>09315000
          RETURN;                                              <<01114>>09317000
         END;                                                  <<01114>>09319000
      IF BPS0 = "NO" THEN                                      <<01114>>09321000
       BEGIN                                                   <<01114>>09323000
        YESANSWER := 2;                                        <<01114>>09325000
        RETURN;                                                <<01114>>09327000
       END;                                                    <<01114>>09329000
      IF BPS0 = "YES" THEN                                     <<01114>>09331000
       BEGIN                                                   <<01114>>09333000
        YESANSWER := TRUE;                                     <<01114>>09335000
        RETURN;                                                <<01114>>09337000
       END;                                                    <<01114>>09339000
     END;                                                      <<01114>>09341000
     MOVE DBUFFER(INDX) :=                                     <<01114>>09343000
          " EXPECTED YES, NO, Y, N.  ";                        <<01114>>09345000
     FWRITE(LPF,DBUFFER(INDX),12,0);                           <<01114>>09347000
     IF <> THEN                                                <<01114>>09349000
      BEGIN                                                    <<01114>>09351000
       PRINT'FILE'INFO(LPF);                                   <<01114>>09353000
       ERROR;                                                  <<01114>>09355000
      END;                                                     <<01114>>09357000
     IF DUPLICATIVE THEN                                       <<01114>>09359000
      BEGIN                                                    <<01114>>09361000
       MOVE DBUFFER(INDX+13) := "TRY AGAIN.";                  <<01114>>09363000
       PRINT(DBUFFER(INDX),-36,0);                             <<01114>>09365000
      END                                                      <<01114>>09367000
      ELSE                                                     <<01114>>09369000
       ERROR;                                                  <<01114>>09371000
     DEL;                                                      <<01114>>09373000
    END;                                                       <<01114>>09375000
  END;                                                         <<01114>>09377000
                                                                        09379000
$PAGE "ANSWER : Log a user transaction to the spool file"               09381000
$CONTROL SEGMENT=INIT                                          <<01114>>09383000
 INTEGER PROCEDURE ANSWER(LENGTH);                             <<01114>>09385000
 VALUE LENGTH;                                                 <<01114>>09387000
 INTEGER LENGTH;                                               <<01114>>09389000
 BEGIN                                                         <<01114>>09391000
COMMENT                                                                 09393000
                                                                        09395000
Purpose:                                                                09397000
          This procedure prints the message supplied in the             09399000
          buffer DBUFFER, and processes the user supplied               09401000
          reply.  The allowable replys follow:                          09403000
                                                                        09405000
               Reply       Return value                                 09407000
                                                                        09409000
                YES              1                                      09411000
                ALL              2                                      09413000
                NO               0                                      09415000
                cr               0                                      09417000
                                                                        09419000
Input parameters:                                                       09421000
                                                                        09423000
Output parameters:                                                      09425000
                                                                        09427000
Globals Referenced:                                                     09429000
                                                                        09431000
Globals Altered:                                                        09433000
                                                                        09435000
Data Structures:                                                        09437000
                                                                        09439000
Algorithm:                                                              09441000
                                                                        09443000
;                                                                       09445000
 INTEGER INDX, INX, LNGTH;                                     <<01114>>09447000
  BYTE POINTER BPS0=S-0;                                       <<01114>>09449000
  INDX := (LENGTH + 1) / 2;                                    <<01114>>09451000
  ANSWER := 0;                                                 <<01114>>09453000
  WHILE TRUE DO                                                <<01114>>09455000
   BEGIN                                                       <<01114>>09457000
    IF DUPLICATIVE THEN                                        <<01114>>09459000
     PRINT(DBUFFER,-LENGTH,%320);                              <<01114>>09461000
    LNGTH := READX(DBUFFER(INDX),-72);                         <<03079>>09463000
    INX := INDX&LSL(1);                                        <<01114>>09465000
    FWRITE(LPF,DBUFFER,-(INX+LNGTH),0);                        <<01114>>09467000
    IF <> THEN                                                 <<01114>>09469000
     BEGIN                                                     <<01114>>09471000
      PRINT'FILE'INFO(LPF);                                    <<01114>>09473000
      ERROR;                                                   <<01114>>09475000
     END;                                                      <<01114>>09477000
    BBUF(INX+LNGTH) := %15;                                    <<01114>>09479000
    SCAN BBUF(INX) WHILE " ",1;                                <<01114>>09481000
    ASSEMBLE(DUP,DDUP);                                        <<01114>>09483000
    MOVE * := * WHILE AS,1;                                    <<01114>>09485000
    LNGTH := -(TOS - TOS);                                     <<01114>>09487000
    CASE LNGTH OF                                              <<01114>>09489000
     BEGIN                                                     <<01114>>09491000
      RETURN;                     << REPLY WAS cr >>           <<01114>>09493000
      IF BPS0 = "Y" THEN                                       <<01114>>09495000
       BEGIN                                                   <<01114>>09497000
        ANSWER := 1;                                           <<01114>>09499000
        RETURN;                                                <<01114>>09501000
       END                                                     <<01114>>09503000
       ELSE                                                    <<01114>>09505000
        IF BPS0 = "N" THEN RETURN;                             <<01114>>09507000
      IF BPS0 = "NO" THEN RETURN;                              <<01114>>09509000
      IF BPS0 = "YES" THEN                                     <<01114>>09511000
       BEGIN                                                   <<01114>>09513000
        ANSWER := 1;                                           <<01114>>09515000
        RETURN;                                                <<01114>>09517000
       END                                                     <<01114>>09519000
       ELSE                                                    <<01114>>09521000
        IF BPS0 = "ALL" THEN                                   <<01114>>09523000
         BEGIN                                                 <<01114>>09525000
          ANSWER := 2;                                         <<01114>>09527000
          RETURN;                                              <<01114>>09529000
         END;                                                  <<01114>>09531000
     END;                                                      <<01114>>09533000
     MOVE DBUFFER(INDX) :=                                     <<01114>>09535000
          " EXPECTED YES, ALL, NO, Y, N.  ";                   <<01114>>09537000
     FWRITE(LPF,DBUFFER(INDX),15,0);                           <<01114>>09539000
     IF <> THEN                                                <<01114>>09541000
      BEGIN                                                    <<01114>>09543000
       PRINT'FILE'INFO(LPF);                                   <<01114>>09545000
       ERROR;                                                  <<01114>>09547000
      END;                                                     <<01114>>09549000
     IF DUPLICATIVE THEN                                       <<01114>>09551000
      BEGIN                                                    <<01114>>09553000
       MOVE DBUFFER(INDX+15) := " TRY AGAIN. ";                <<01114>>09555000
       PRINT(DBUFFER(INDX),-41,0);                             <<01114>>09557000
      END                                                      <<01114>>09559000
      ELSE                                                     <<01114>>09561000
       ERROR;                                                  <<01114>>09563000
     DEL;                                                      <<01114>>09565000
    END;                                                       <<01114>>09567000
  END;                                                         <<01114>>09569000
                                                                        09571000
$PAGE "INTERACTIVE'DIALOG : Query the user "                            09573000
$CONTROL SEGMENT=INIT                                          <<01114>>09575000
 PROCEDURE INTERACTIVE'DIALOG;                                 <<01114>>09577000
 BEGIN                                                         <<01114>>09579000
COMMENT                                                                 09581000
                                                                        09583000
Purpose:                                                                09585000
          This procedure processes the interactive dialog               09587000
          if the program is run with PARM=10.  It sets                  09589000
          all flags necessary to produce the available                  09591000
          reports                                                       09593000
                                                                        09595000
Input parameters:                                                       09597000
                                                                        09599000
Output parameters:                                                      09601000
                                                                        09603000
Globals Referenced:                                                     09605000
                                                                        09607000
Globals Altered:                                                        09609000
                                                                        09611000
Data Structures:                                                        09613000
                                                                        09615000
Algorithm:                                                              09617000
                                                                        09619000
;                                                                       09621000
  INTEGER INDX := -1;                                          <<01114>>09623000
  INTEGER NUMPARMS,LENGTH,WORK1,WORK2;                         <<01114>>09625000
  LOGICAL GOOD;                                                <<01114>>09627000
  INTEGER POINTER PARM;                                        <<01114>>09629000
  BYTE ARRAY DELIMITER(0:2);                                   <<01114>>09631000
  INTEGER ARRAY PARM'INFO(0:71);                               <<01114>>09633000
LOGICAL SUBROUTINE VALID(DSTNO);                               <<03079>>09635000
  VALUE DSTNO;                                                 <<03079>>09637000
  INTEGER DSTNO;                                               <<03079>>09639000
  BEGIN                                                        <<03079>>09641000
  IF DSTNO < INTEGER (CORE (DOUBLE (CORE(DOUBLE(DSTB)))) ) AND <<03079>>09643000
                    DSTNO > 0          <<TRUE IF IN DST RANGE>><<03079>>09645000
     THEN  VALID := TRUE                                       <<03079>>09647000
     ELSE  VALID := FALSE;                                     <<03079>>09649000
  END;                                            <<END VALID>><<03079>>09651000
SUBROUTINE PICKDSTS;                                           <<03079>>09653000
  BEGIN                                                        <<03079>>09655000
  DO BEGIN                                                     <<03079>>09657000
     BLANKBUF;                                                 <<03079>>09659000
     MOVE DBUFFER := "WHICH DST (DECIMAL)?";                   <<03079>>09661000
     PRINT(DBUFFER,-20,%320);                                  <<03079>>09663000
     LENGTH := READX(DBUFFER(10),-5);         <<READ RESPONSE>><<03079>>09665000
     IF = AND LENGTH <> 0 THEN           <<IF READ SUCCESSFUL>><<03079>>09667000
        BEGIN                                                  <<03079>>09669000
        FWRITE(LPF,DBUFFER,-(LENGTH+20),%40);                  <<03079>>09671000
        IF <> THEN BEGIN                                       <<03079>>09673000
           PRINT'FILE'INFO(LPF);                               <<03079>>09675000
           ERROR;                                              <<03079>>09677000
           END;                                                <<03079>>09679000
        WORK1 := BINARY(DBUFFER(10),LENGTH); <<CONVERT NUMBER>><<03079>>09681000
        IF = AND VALID(WORK1) AND            <<IF VALID DST #>><<03079>>09683000
           NOT ONFREELIST(DOUBLE(CORE(CSTABP)),(WORK1*4)) THEN <<03079>>09685000
           BEGIN                                               <<03079>>09687000
           IF DST'TYPE(WORK1) = 0 THEN        <<IF UNASSIGNED>><<03079>>09689000
              DST'TYPE(WORK1):=14;    <<SET CODE TO PRINT DST>><<03079>>09691000
           END                                                 <<03079>>09693000
        ELSE BEGIN                                             <<03079>>09695000
             MOVE DBUFFER := "INVALID DST #";                  <<03079>>09697000
             PRINT(DBUFFER,-13,%40);                           <<03079>>09699000
             FWRITE(LPF,DBUFFER,-13,%40);                      <<03079>>09701000
             IF <> THEN BEGIN                                  <<03079>>09703000
                PRINT'FILE'INFO(LPF);                          <<03079>>09705000
                ERROR;                                         <<03079>>09707000
                END;                                           <<03079>>09709000
             END;                                              <<03079>>09711000
        END;                                                   <<03079>>09713000
     END                                                       <<03079>>09715000
  UNTIL LENGTH = 0;                         <<CARRIAGE RETURN>><<03079>>09717000
  END;                                        <<END PICKDSTS>> <<03079>>09719000
                                                               <<03079>>09721000
  SUBROUTINE PRNT'PROCESS;<< Set process control print flags>> <<01114>>09723000
  BEGIN                                                        <<01114>>09725000
   PRINT'CST := TRUE;                                          <<01114>>09727000
   PRINT'DST := TRUE;                                          <<01114>>09729000
   PRINT'PCB := TRUE;                                          <<01114>>09731000
   PRINT'STACKS := TRUE;                                       <<01114>>09733000
   PRINT'ICS := TRUE;                                          <<03080>>09735000
  END;                                                         <<01114>>09737000
  SUBROUTINE PRNT'MEMORY'MGT; <<Set all memory mgt rept flags>><<01114>>09739000
  BEGIN                                                        <<01114>>09741000
   PRINT'AVAIL := TRUE;                                        << WBT >>09743000
      PRINT'SLL:=TRUE;                                         << WBT >>09745000
   PRINT'VDSL := TRUE;                                         <<01114>>09747000
   PRINT'VDSM := TRUE;                                         <<01114>>09749000
   PRINT'CACHE := TRUE;                                                 09751000
  END;                                                         <<01114>>09753000
  SUBROUTINE PRNT'IO'MGT;     << Set all I/O report flags >>   <<01114>>09755000
  BEGIN                                                        <<01114>>09757000
   PRINT'DRT := TRUE;                                          <<01114>>09759000
   PRINT'ILT := TRUE;                                          <<01114>>09761000
   PRINT'LPDT := TRUE;                                         <<01114>>09763000
   PRINT'DIT := TRUE;                                          <<01114>>09765000
   PRINT'IOQ := TRUE;                                          <<01114>>09767000
   PRINT'SBUF := TRUE;                                         <<01114>>09769000
   PRINT'TBUF := TRUE;                                         <<01114>>09771000
   PRINT'DRQT := TRUE;                                         << WBT >>09773000
  END;                                                         <<01114>>09775000
  SUBROUTINE PRIMARY'MEMORY;<< Process memory bank questions >><<01114>>09777000
  BEGIN                                                        <<01114>>09779000
  MOVE DBUFFER := " PRINT PRIMARY MEMORY?";                    <<01114>>09781000
  IF YESANSWER(22) THEN                                        <<01114>>09783000
   BEGIN                                                       <<01114>>09785000
    PRINT'MEMORY := TRUE;                                      <<01114>>09787000
    MOVE DBUFFER := "  FORMATTED?";                            <<01114>>09789000
    IF YESANSWER(12) THEN                                      <<01114>>09791000
     BEGIN                   << Format memory >>               <<01114>>09793000
      PRINT'INDEX := TRUE;                                     <<01114>>09795000
      FORMAT'MEMORY := TRUE;                                   <<01114>>09797000
      MOVE DBUFFER := "   CODE SEGMENTS? ";                    <<01114>>09799000
      CODE'SEGMENTS := YESANSWER(17);                          <<01114>>09801000
      MOVE DBUFFER := "   CACHED REGIONS?";                             09803000
      CACHED'REGIONS := YESANSWER(18);                                  09805000
      MOVE DBUFFER := "   FREE AREAS?";                        <<01114>>09807000
      FREE'AREAS := YESANSWER(14);                             <<01114>>09809000
     END;                                                      <<01114>>09811000
     MOVE DELIMITER := ",-";                                   <<01114>>09813000
     DELIMITER(2) := %15;                                      <<01114>>09815000
     WHILE TRUE DO                                             <<01114>>09817000
      BEGIN                  << process bank selection >>      <<01114>>09819000
       GOOD := TRUE;                                           <<01114>>09821000
       MOVE DBUFFER := "  WHICH BANKS?";                       <<01114>>09823000
       IF DUPLICATIVE THEN                                     <<01114>>09825000
        PRINT(DBUFFER,-14,%320);                               <<01114>>09827000
       LENGTH := READX(DBUFFER(7),-72) + 14;                   <<03079>>09829000
       FWRITE(LPF,DBUFFER,-LENGTH,0);                          <<01114>>09831000
       IF <> THEN                                              <<01114>>09833000
        BEGIN                                                  <<01114>>09835000
         PRINT'FILE'INFO(LPF);                                 <<01114>>09837000
         ERROR;                                                <<01114>>09839000
        END;                                                   <<01114>>09841000
       BBUF(LENGTH) := %15;                                    <<01114>>09843000
       @PARM := @PARM'INFO - 2;                                <<01114>>09845000
       MYCOMMAND(BBUF(14),DELIMITER,36,NUMPARMS,PARM'INFO);    <<01114>>09847000
       INDX := -1;                                             <<01114>>09849000
       WHILE (INDX:=INDX+1) < NUMPARMS DO                      <<01114>>09851000
        BEGIN                                                  <<01114>>09853000
         @PARM := @PARM + 2;                                   <<01114>>09855000
         TOS := 0;                                             <<01114>>09857000
         TOS := PARM;                                          <<01114>>09859000
         TOS := PARM(1).(0:8);                                 <<01114>>09861000
         WORK1 := BINARY(*,*);                                 <<01114>>09863000
         IF <> OR LOGICAL(WORK1) > LOGICAL(MAXBANK) THEN       <<01114>>09865000
          BEGIN                                                <<01114>>09867000
           GOOD := FALSE;                                      <<01114>>09869000
           INDX := NUMPARMS;                                   <<01114>>09871000
          END                                                  <<01114>>09873000
          ELSE                                                 <<01114>>09875000
           BEGIN                                               <<01114>>09877000
            IF PARM(1).(11:5) = 1 THEN                         <<01114>>09879000
             BEGIN                                             <<01114>>09881000
              @PARM := @PARM + 2;                              <<01114>>09883000
              INDX := INDX + 1;                                <<01114>>09885000
              TOS := 0;                                        <<01114>>09887000
              TOS := PARM;                                     <<01114>>09889000
              TOS := PARM(1).(0:8);                            <<01114>>09891000
              WORK2 := BINARY(*,*);                            <<01114>>09893000
              IF <> OR NOT(WORK1<=WORK2<=MAXBANK) THEN         <<01114>>09895000
               BEGIN                                           <<01114>>09897000
                GOOD := FALSE;                                 <<01114>>09899000
                INDX := NUMPARMS;                              <<01114>>09901000
               END                                             <<01114>>09903000
               ELSE                                            <<01114>>09905000
                IF PARM(1).(11:5) = 1 THEN                     <<01114>>09907000
                 BEGIN                                         <<01114>>09909000
                  GOOD := FALSE;                               <<01114>>09911000
                  INDX := NUMPARMS;                            <<01114>>09913000
                  PARM := PARM + LENGTH;                       <<01114>>09915000
                 END;                                          <<01114>>09917000
             END                                               <<01114>>09919000
             ELSE                                              <<01114>>09921000
              WORK2 := WORK1;                                  <<01114>>09923000
           END;                                                <<01114>>09925000
         IF GOOD THEN                                          <<01114>>09927000
          DO PRINT'BANK(WORK1) := TRUE                         <<01114>>09929000
             UNTIL (WORK1:= WORK1+1) > WORK2;                  <<01114>>09931000
        END;                                                   <<01114>>09933000
       IF GOOD THEN RETURN;                                    <<01114>>09935000
       BBUF := " ";          << bank selection was invalid >>  <<01114>>09937000
       MOVE BBUF(1) := BBUF,(LENGTH);                          <<01114>>09939000
       BBUF(PARM-@BBUF) := "^";                                <<01114>>09941000
       PRINT(DBUFFER,-LENGTH,0);                               <<01114>>09943000
       FWRITE(LPF,DBUFFER,-LENGTH,0);                          <<01114>>09945000
       IF <> THEN                                              <<01114>>09947000
        BEGIN                                                  <<01114>>09949000
         PRINT'FILE'INFO(LPF);                                 <<01114>>09951000
         ERROR;                                                <<01114>>09953000
        END;                                                   <<01114>>09955000
       MOVE BBUF := " INVALID PARAMETER. ";                    <<01114>>09957000
       FWRITE(LPF,DBUFFER,-19,0);                              <<01114>>09959000
       IF <> THEN                                              <<01114>>09961000
        BEGIN                                                  <<01114>>09963000
         PRINT'FILE'INFO(LPF);                                 <<01114>>09965000
         ERROR;                                                <<01114>>09967000
        END;                                                   <<01114>>09969000
       IF DUPLICATIVE THEN                                     <<01114>>09971000
        BEGIN                                                  <<01114>>09973000
         MOVE BBUF(20) := " TRY AGAIN.";                       <<01114>>09975000
         PRINT(DBUFFER,-31,0);                                 <<01114>>09977000
        END                                                    <<01114>>09979000
        ELSE                                                   <<01114>>09981000
         ERROR;                                                <<01114>>09983000
       INDX:=-1;                                               <<01114>>09985000
       WHILE (INDX:=INDX+1) <= MAXBANK DO                      <<01114>>09987000
        PRINT'BANK(INDX) := FALSE;                             <<01114>>09989000
      END;                                                     <<01114>>09991000
   END;                                                        <<01114>>09993000
  END;                                                         <<01114>>09995000
  SUBROUTINE PROCESS'CONTROL; << Process control questions >>  <<01114>>09997000
  BEGIN                                                        <<01114>>09999000
   MOVE DBUFFER := "  PROCESS CONTROL?";                       <<01114>>10001000
   CASE *ANSWER(18) OF                                         <<01114>>10003000
    BEGIN                                                      <<01114>>10005000
     ;                            << REPLY WAS NO  >>          <<01114>>10007000
     BEGIN                                                     <<01114>>10009000
      MOVE DBUFFER := "   CST? ";                              <<01114>>10011000
      PRINT'CST := YESANSWER(7);                               <<01114>>10013000
      MOVE DBUFFER := "   DST? ";                              <<01114>>10015000
      PRINT'DST := YESANSWER(7);                               <<01114>>10017000
      MOVE DBUFFER := "   PCB? ";                              <<01114>>10019000
      PRINT'PCB := YESANSWER(7);                               <<01114>>10021000
      MOVE DBUFFER := "   STACK MARKERS? ";                    <<01114>>10023000
      PRINT'STACKS := YESANSWER(17);                           <<01114>>10025000
         MOVE DBUFFER:="   INTERRUPT CONTROL STACK? ";         <<03080>>10027000
         PRINT'ICS := YESANSWER(27);                           <<03080>>10029000
     END;                                                      <<01114>>10031000
     PRNT'PROCESS;                << REPLY WAS ALL >>          <<01114>>10033000
    END;                                                       <<01114>>10035000
  END;                                                         <<01114>>10037000
  SUBROUTINE MEMORY'MGT;    << Process memory mgr questions >> <<01114>>10039000
  BEGIN                                                        <<01114>>10041000
   MOVE DBUFFER := "  MEMORY MANAGEMENT?";                     <<01114>>10043000
   CASE *ANSWER(20) OF                                         <<01114>>10045000
    BEGIN                                                      <<01114>>10047000
     ;                            << REPLY WAS NO  >>          <<01114>>10049000
     BEGIN                        << REPLY WAS YES >>          <<01114>>10051000
      MOVE DBUFFER := "   CACHE DESCRIPTOR TABLE?";                     10053000
      PRINT'CACHE:=YESANSWER(27);                                       10055000
            MOVE DBUFFER := "   SEGMENT LOCALITY LISTS?";      << WBT >>10057000
            PRINT'SLL := YESANSWER(26);                        << WBT >>10059000
      MOVE DBUFFER := "   VDS PAGE ALLOCATION? ";              <<01114>>10061000
      PRINT'VDSL := YESANSWER(23);                             <<01114>>10063000
      MOVE DBUFFER := "   VIRTUAL DISK SPACE BIT MAP?";        <<01114>>10065000
      PRINT'VDSM := YESANSWER(30);                             <<01114>>10067000
     END;                                                      <<01114>>10069000
     PRNT'MEMORY'MGT;             << REPLY WAS ALL >>          <<01114>>10071000
    END;                                                       <<01114>>10073000
  END;                                                         <<01114>>10075000
  SUBROUTINE IO'MGT;          << Process I/O questions >>      <<01114>>10077000
  BEGIN                                                        <<01114>>10079000
   MOVE DBUFFER := "  I/O MANAGEMENT? ";                       <<01114>>10081000
   CASE *ANSWER(17) OF                                         <<01114>>10083000
    BEGIN                                                      <<01114>>10085000
     ;                            << REPLY WAS NO  >>          <<01114>>10087000
     BEGIN                        << REPLY WAS YES >>          <<01114>>10089000
      MOVE DBUFFER := "   DRT? ";                              <<01114>>10091000
      PRINT'DRT := YESANSWER(7);                               <<01114>>10093000
      MOVE DBUFFER := "   INTERRUPT LINKAGE? ";                <<01114>>10095000
      PRINT'ILT := YESANSWER(21);                              <<01114>>10097000
      MOVE DBUFFER := "   LOGICAL PHYSICAL DEVICE? ";          <<01114>>10099000
      PRINT'LPDT := YESANSWER(27);                             <<01114>>10101000
      MOVE DBUFFER := "   DIT? ";                              <<01114>>10103000
      PRINT'DIT := YESANSWER(7);                               <<01114>>10105000
      MOVE DBUFFER := "   DISC REQUEST TABLE ?";               << WBT >>10107000
      PRINT'DRQT := YESANSWER(23);                             << WBT >>10109000
      MOVE DBUFFER := "   IOQ? ";                              <<01114>>10111000
      PRINT'IOQ := YESANSWER(7);                               <<01114>>10113000
      MOVE DBUFFER := "   SYSTEM BUFFERS?";                    <<01114>>10115000
      PRINT'SBUF := YESANSWER(18);                             <<01114>>10117000
      MOVE DBUFFER := "   TERMINAL BUFFERS?";                  <<01114>>10119000
      PRINT'TBUF := YESANSWER(20);                             <<01114>>10121000
     END;                                                      <<01114>>10123000
     PRNT'IO'MGT;                 << REPLY WAS ALL >>          <<01114>>10125000
    END;                                                       <<01114>>10127000
  END;                                                         <<01114>>10129000
                                                               <<01114>>10131000
                                                               <<01114>>10133000
  NEWPAGE;                                                     <<01114>>10135000
  LINECOUNT := 0;                                              <<01114>>10137000
  WHILE (INDX:=INDX+1) < NUM'RESPONSES DO                      <<01114>>10139000
   RESPONSES(INDX) := FALSE;                                   <<01114>>10141000
  INDX := -1;                                                  <<01114>>10143000
  WHILE (INDX:=INDX+1) <= MAXBANK DO                           <<01114>>10145000
   PRINT'BANK(INDX) := FALSE;                                  <<01114>>10147000
                                                               <<01114>>10149000
MOVE DBUFFER:="MINIDUMP? ";                                    <<03076>>10151000
MINI'DUMP:=YESANSWER(9);                                       <<03076>>10153000
IF MINI'DUMP THEN PICKDSTS;                                    <<03079>>10155000
  MOVE DBUFFER := " FORMAT TABLES? ";                          <<01114>>10157000
  CASE *ANSWER(15) OF                                          <<01114>>10159000
   BEGIN                                                       <<01114>>10161000
    ;                              << DO NOT FORMAT TABLES >>  <<01114>>10163000
    BEGIN                      << CONTINUE INTERACTIVE DIALOG>><<01114>>10165000
     PRINT'INDEX := TRUE;                                      <<01114>>10167000
     MOVE DBUFFER := "  REGISTERS?";                           <<01114>>10169000
     PRINT'REGISTERS := YESANSWER(12);                         <<01114>>10171000
     PROCESS'CONTROL;                                          <<01114>>10173000
     MEMORY'MGT;                                               <<01114>>10175000
     IO'MGT;                                                   <<01114>>10177000
     MOVE DBUFFER := "  TIMER REQUEST LIST? ";                 <<01114>>10179000
     PRINT'TRL := YESANSWER(21);                               <<01114>>10181000
     MOVE DBUFFER := "  SIR?";                                 <<01114>>10183000
     PRINT'SIR := YESANSWER(6);                                <<01114>>10185000
     MOVE DBUFFER := "  MONITOR?";                             <<01114>>10187000
     PRINT'MON := YESANSWER(10);                               <<01114>>10189000
    END;                                                       <<01114>>10191000
    BEGIN                           << FORMAT ALL TABLES >>    <<01114>>10193000
     PRINT'REGISTERS := TRUE;                                  <<01114>>10195000
     PRINT'INDEX := TRUE;                                      <<01114>>10197000
     PRNT'PROCESS;                                             <<01114>>10199000
     PRNT'MEMORY'MGT;                                          <<01114>>10201000
     PRNT'IO'MGT;                                              <<01114>>10203000
     PRINT'TRL := TRUE;                                        <<01114>>10205000
     PRINT'SIR := TRUE;                                        <<01114>>10207000
     PRINT'MON := TRUE;                                        <<01114>>10209000
    END;                                                       <<01114>>10211000
   END;      << END OF TABLE DIALOG >>                         <<01114>>10213000
  PRIMARY'MEMORY;                                              <<01114>>10215000
 END;                                                          <<01114>>10217000
PROCEDURE SETUP'REGION'DEF;                                    <<CACHE>>10219000
                                                               <<CACHE>>10221000
BEGIN                                                          <<CACHE>>10223000
   LOGICAL FOUND'DST;                                          <<CACHE>>10225000
   INTEGER DST'INDEX;                                          <<CACHE>>10227000
                                                               <<CACHE>>10229000
   DST'INDEX:=CORE(2D);                                        <<CACHE>>10231000
   DST'INDEX:=DST'INDEX+4;                                     <<CACHE>>10233000
   FOUND'DST:=FALSE;                                           <<CACHE>>10235000
                                                               <<CACHE>>10237000
   WHILE NOT FOUND'DST DO                                      <<CACHE>>10239000
      BEGIN                                                    <<CACHE>>10241000
         IF CORE(DOUBLE(DST'INDEX)).(0:1) = 0 << PRESENT>>     <<CACHE>>10243000
            AND CORE(DOUBLE(DST'INDEX+1)).(7:1) = 0            <<CACHE>>10245000
            THEN BEGIN                                         <<CACHE>>10247000
                    FOUND'DST:=TRUE;                           <<CACHE>>10249000
                    IF CORE(DOUBLE(DST'INDEX+3)).(11:5)=24 THEN<<CACHE>>10251000
                       BEGIN << MPE IV + CACHE >>              <<CACHE>>10253000
                          RBTORSDISP := 23;                    <<CACHE>>10255000
                          RBTOSRSDISP := 14;                   <<CACHE>>10257000
                          RBTONLDISP := 18;                    <<CACHE>>10259000
                          REGIONHSIZE := %30;                  <<CACHE>>10261000
                          REGIONOHSIZE := %34;                 <<CACHE>>10263000
                          REG'DIFF:=0;                         <<CACHE>>10265000
                          CACHE'SYSTEM:=TRUE;                  <<CACHE>>10267000
                       END                                     <<CACHE>>10269000
                    ELSE                                       <<CACHE>>10271000
                       BEGIN                                   <<CACHE>>10273000
                         IF CORE(DOUBLE(DST'INDEX+3)).(11:5)=19<<CACHE>>10275000
                          THEN                                 <<CACHE>>10277000
                             BEGIN << MPE IV, NON CACHING >>   <<CACHE>>10279000
                                RBTORSDISP:=18;                <<CACHE>>10281000
                                RBTOSRSDISP:=10;               <<CACHE>>10283000
                                RBTONLDISP:=13;                <<CACHE>>10285000
                                REGIONHSIZE:=%23;              <<CACHE>>10287000
                                REGIONOHSIZE:=%27;             <<CACHE>>10289000
                                REG'DIFF:=5;                   <<CACHE>>10291000
                                CACHE'SYSTEM:=FALSE;           <<CACHE>>10293000
                             END                               <<CACHE>>10295000
                          ELSE                                 <<CACHE>>10297000
                             FOUND'DST := FALSE;               <<CACHE>>10299000
                       END;                                    <<CACHE>>10301000
                 END;                                          <<CACHE>>10303000
         DST'INDEX:=DST'INDEX+4;                               <<CACHE>>10305000
      END; << WHILE >>                                         <<CACHE>>10307000
END; << SETUP'REGION'DEF >>                                    <<CACHE>>10309000
                                                                        10311000
$include INCLDNKN                                                       10313000
$include INCLDNIO                                                       10315000
$include INCLDNDA                                                       10317000
$include INCLDNDS                                                       10319000
$include INCLDNMR                                                       10321000
$include INCLDNTG                                                       10323000
$include INCLDNOB                                                       10325000
