$CONTROL CODE,MAP,NOWARN,LIST,USLINIT                          <<02012>>00004000
<< HP3000 SERIES II/III DUMP ANALYZER >>                                00006000
<< HP32002C MPE SOURCE C.00.00 >>                              << WBT >>00008000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00010000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00012000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00014000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00016000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00018000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00020000
$CONTROL MAIN=DPAN5                                            <<sknew>>00022000
$CONTROL SEGMENT=INIT                                                   00024000
<< HP32002C MPE SOURCE C.00.00 >>                              << WBT >>00026000
COMMENT                                                                 00028000
MODULE DPAN                                                             00030000
                                                                        00032000
Product Information                                                     00034000
   Product name, mnemonic, project number                               00036000
      DPAN, DN,                                                         00038000
   Project abstract                                                     00040000
      Format raw memory dumps to facilitate analysis of 3000 problems   00042000
   Project personnel                                                    00044000
      MPE kernel/startup                                                00046000
                                                                        00048000
General Design Overview                                                 00050000
   Design approach and Major modules                                    00052000
                                                                        00054000
                              DPAN4                                     00056000
                                |                                       00058000
                           PROCESSDUMP                                  00060000
                                |                                       00062000
       +------------------------+---------------------------+           00064000
   initialize           formatted tables            formatted memory    00066000
   TAPETODISK               PRINTAVAIL                PRINTMEMORY       00068000
   VERIFYTBL                    .                       FILLMEMBUF      00070000
   FIXPCBSTACK                  .                       SORTMEMBUF      00072000
   CATEGORIZE'DST               .                       PRINTMEMLOCS    00074000
                            PRINTXCST                   DUMPMEM         00076000
                                                                        00078000
   There are 3 main parts to DPAN: initializing, table formatting,      00080000
   and memory formatting.  The main routine, DPAN4, calls               00082000
   PROCESS'DUMP, which in turn calls routines for these 3 parts.        00084000
   PROCESS'DUMP also handles the PARM values which may be passed in,    00086000
   and selectively calls the routines in the latter two parts.          00088000
                                                                        00090000
   Initialization                                                       00092000
      Initialization is done with 4 routines. TAPE'TO'DISK copies the   00094000
      files from the dump tape into temporary files, for later use.     00096000
      VERIFYTBL computes and verifies the base addresses for several    00098000
      system tables and initializes some global variables accordingly.  00100000
      FIXPCBSTACK also initializes some variables.  CATEGORIZEDST fills 00102000
      up the global array DST'TYPE, which describes each data segment.  00104000
                                                                        00106000
   Table Formatting                                                     00108000
      Table formatting means the detailed formatting of specific system 00110000
      tables.  In general, each routine handles a specific, resident    00112000
      system table.  As yet, all the system tables are not formatted so 00114000
      elaborately.  There are 19 of these routines, ranging from        00116000
      PRINTAVAIL to PRINTXCST.                                          00118000
                                                                        00120000
   Memory Formatting                                                    00122000
      Memory formatting is driven by the PRINTMEMORY routine.  This     00124000
      routine loops over the desired banks, and sequentially dumps a    00126000
      half-formatted octal dump of each segment.  Four principal rou-   00128000
      tines are used to do so.  FILLMEMBUF creates 4 word records which 00130000
      describe the entries in the bank, putting them in the array       00132000
      MEMBUF.  It does this by checking through the CST, DST, and       00134000
      available area tables for segments in the current bank.  SORT-    00136000
      MEMBUF sorts these entries into ascending memory order.  PRINT-   00138000
      MEMLOCS uses MEMBUF to print the preview page which comes before  00140000
      each bank and summarizes what is in the next bank to be printed.  00142000
      Lastly, DUMPMEM calls routines (OCTALDUMP, CSTENTRY, DSTENTRY) to 00144000
      produce the actual dump of each segment described by MEMBUF.      00146000
                                                                        00148000
   Major data structures                                                00150000
      The principal structures are MEMBUF and DST'TYPE                  00152000
                                                                        00154000
   Overall flow of data and control                                     00156000
      Described above                                                   00158000
                                                                        00160000
   Performance considerations                                           00162000
      The basic approach to performance, with the recent resegmentation,00164000
      was to locate the 101 procedures in as few large code segments as 00166000
      possible.  The main segments, INIT, TABLES, MEMORY, and UTIL      00168000
      correspond with the design overview above.  This should minimize  00170000
      segment faults.                                                   00172000
      As for use of DPAN, it is often helpful to use the minidump option00174000
      or the interactive dialogue to list only the needed dump parts,   00176000
      in light of the cost of (EPOC) paper and machine loads.           00178000
                                                                        00180000
Module Implementation                                                   00182000
                                                                        00184000
   Here are descriptions of the utility routines available in DPAN:     00186000
                                                                        00188000
   CHECKSTACK(DSTNO)                                                    00190000
      Verify that the given DST is a stack and print its markers (if ok)00192000
      and its PCBX.  Can be followed by a call to FORMATSTACK.          00194000
                                                                        00196000
   CORE(ADR)                                                            00198000
      Input is doubleword ADR value.  Finds and returns as a logical    00200000
      value the contents of this location in the core image of the dump 00202000
      being analyzed.  Prints error message if invalid address.         00204000
   DCORE(ADR)                                                           00206000
      Like core, but returns a doubleword.                              00208000
   SYSGLOB(ADR)                                                         00210000
      Like core, but adds %1000 to ADR.                                 00212000
                                                                        00214000
   DCONS(HI,LO)                                                         00216000
      Glues HI and LO together and returns them as a doubleword         00218000
                                                                        00220000
   DSTTOADDR(DSTNO)                                                     00222000
      Input is logical DST number.  Looks up starting address of this   00224000
      data segment, and returns it as a doubleword bank+address.        00226000
                                                                        00228000
   ERROR                                                                00230000
      Calls intrinsic TERMINATE.                                        00232000
                                                                        00234000
   NAMECST(CSTENTRY)                                                    00236000
      Looks up the name of CSTENTRY in LOADMAP.PUB.SYS                  00238000
      and returns 17 bytes worth of it to where @PBUF points.           00240000
      @PBUF is advanced.  Nothing done if LOADMAP not accessable.       00242000
   NAMEDST                                                              00244000
      Uses global variable MBENTNO to return the names of system        00246000
      data segments into PBUF at @PBUF.                                 00248000
   NAMEPROC(SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL)                           00250000
      Uses MPEPMAP to look up the segment name and offset of a proc.    00252000
      However, maintaining this MPEPMAP is rare and this DPAN           00254000
      feature has fallen into disuse.  It might be easier to use        00256000
      the system SL, since this is always there.                        00258000
                                                                        00260000
   OCTALDUMP(STADR,ENADR,TABLEBASE)                                     00262000
      All input parameters are doubleword, passed by value.  The last   00264000
      parameter is optional.  Prints a nice, two column formatted octal 00266000
      dump of the core between STADR and ENADR.  Checks for duplicate   00268000
      memory locations and prints a message whenever one is found.      00270000
      If global flag CHARFLAG is true, also prints the ASCII            00272000
      translation of the line of core.                                  00274000
   SKIPOCTALDUMP                                                        00276000
      Parallels OCTALDUMP, but prints a message stating that the range  00278000
      of addresses has been skipped.                                    00280000
                                                                        00282000
   ONFREELIST(TABLEBASE,INDEX)                                          00284000
      Given standard table base, scan through free list to see if       00286000
      index is present on free list.                                    00288000
                                                                        00290000
                                                                        00292000
   Printing utilities                                                   00294000
      There are several printing utilities available in DPAN.  Since    00296000
      DPAN uses these to keep track of the page numbers for the headers 00298000
      and the index, it is important for any new code to follow these   00300000
      conventions.  Global variables PAGENO, LINECOUNT, and LNSPERPG    00302000
      are all maintainted. @PBUF points to output buffer PBUF.          00304000
                                                                        00306000
   NEWPAGE skips to a new page, increments the page number, etc.        00308000
   PRINTLINE writes DBUFFER to (printer file) LPF.                      00310000
      Entry point BLANKBUF fills PBUF with blanks.                      00312000
   PUTCHAR(WORD) puts a pair of characters (1 word) into PBUF           00314000
      and advances @PBUF.                                               00316000
   PUTDNUM(P)(DNUM) is like PUTNUM, but for double variables.           00318000
   PUTNUM(P)(NUM) converts an integer number to ASCII, and writes it    00320000
      to @PBUF.  The number occupies a field of 7.  PUTNUM does         00322000
      not suppress leading zeroes, PUTNUMP does.                        00324000
   PUTNZ(NUM,COL) Puts NUM at COL in PBUF if NUM<>0.                    00326000
   SKIPLINES(NLINES) will skip lines.                                   00328000
                                                                        00330000
Global Data Structure Implementation                                    00332000
   Overall data structure relations                                     00334000
      Narrative                                                         00336000
      Maps of linkages                                                  00338000
                                                                        00340000
   DPAN Global variables                                                00342000
   (for each data structure)                                            00344000
   Data structure name                                                  00346000
      Purpose                                                           00348000
      Creation and dispostion                                           00350000
      Access methods                                                    00352000
      Users                                                             00354000
      Data layout and description                                       00356000
      Storage management                                                00358000
      Subordinate data structures                                       00360000
                                                                        00362000
   CHARFLAG used by OCTALDUMP for optional translation to ASCII.        00364000
   DBUFFER(0:100) is the printed output buffer                          00366000
   DSTADDR bases of DST, CST, and PCB tables.                           00368000
   DST'TYPE is used by CATEGORIZE'DST to classify all data segments.    00370000
   MBTYPE, MBENTNO, MBBANK, MBADDR are used by FILLMEMBUF and           00372000
      DUMPMEM to work with the MEMBUF array.                            00374000
   NUM'RESPONSES number of flags set in INTERACTIVE'DIALOG.             00376000
   PBUF is a byte array equivalenced to DBUFFER                         00378000
   PRINT'BANK(0:MAXIMUM'BANKS) do we want to print this bank?           00380000
   RESPONSES (see INTERACTIVE'DIALOG) flags whether certain parts       00382000
      of the dump are wanted.                                           00384000
                                                                        00386000
                                                                        00388000
Fix History                                                             00390000
   12/17/82                                                             00392000
      Installation of comment templates, split of source modules to     00394000
      share responsibility with other groups, resegmentation.           00396000
                                                                        00398000
Quality                                                                 00400000
      DPAN needs much more in-code documentation, particularly with     00402000
   global variables.                                                    00404000
      Implicit passing of global variables should be eliminated as      00406000
   much as possible.                                                    00408000
      As Stan Sieler's new variable XREF indicates, there are           00410000
   numerous variables in DPAN which are declared, but never             00412000
   used.  These should not simply be removed, but examined,             00414000
   since each may point to a nearby flaw in the code.                   00416000
      TOS is used too much.                                             00418000
      FILLMEMBUF should be completely revamped -- this could lead to    00420000
   a significant simplification of DUMPMEM.                             00422000
                                                                        00424000
;                                                                       00426000
      BEGIN                                                             00428000
                                                               <<03013>>00430000
DOUBLE DRT'TABLE'ADDRESS;   <<USUALLY A COPY OF DRTBANK/ADDR>> <<03013>>00432000
       <<TAKEN FROM FIXED CELLS %10, %11.  IF THESE VALUES>>   <<03013>>00434000
       <<ARE INVALID, THEN WE USE DEFAULT VALUES OF 0-0 >>     <<03013>>00436000
                                                               <<03013>>00438000
 INTRINSIC MYCOMMAND, ASCII;                                   <<04701>>00440000
 DEFINE DUPLICATIVE = (JSM.(14:1))#;                           <<01114>>00442000
 DEFINE SYSGLOB'EXT = CORE(DOUBLE(SYSBASE+%377)) + SYSBASE#,   << WBT >>00444000
        MITVERNO    = DOUBLE(SYSGLOB'EXT + %76)#,              <<01114>>00446000
        MITUPNO     = DOUBLE(SYSGLOB'EXT + %74)#,              <<01114>>00448000
        MITFNO      = DOUBLE(SYSGLOB'EXT + %75)#;              <<01114>>00450000
         LOGICAL NOPRFLAG:=FALSE;  <<SUPPRESS PRINT OFF>>      <<00221>>00452000
         DEFINE CSTBLK=CORE(DOUBLE(SYSBASE+%51))+SYSBASE#;     << WBT >>00454000
         EQUATE CSTB=0,CSTB'=1,DSTB=2,CPCB=4,PCBB=3;                    00456000
         EQUATE CSTMAXENT=%4000,CSTMAXENT'=255,CSTSIZE=4;      <<b8222>>00458000
         EQUATE DSTMAXENT=4095,DSTSIZE=4,SYSBASE=%1000;        << MCW >>00460000
         EQUATE CCG=0,CCL=1,CCE=2;                             <<01.02>>00462000
         EQUATE LSTSYSDST = %73;  << LAST SYS DST # >>         <<03556>>00464000
         EQUATE SERIES2=0,SERIES3=1;                           <<2M.HM>>00466000
         LOGICAL CSTBAD:=FALSE,CSTBAD':=TRUE,DSTBAD:=FALSE;             00468000
      LOGICAL ARRAY BAD'DST(0:2) := FALSE,FALSE,FALSE;         <<01080>>00470000
         INTEGER PARM=Q-4;                                     <<01.02>>00472000
         INTEGER STATUS=Q-1;                                   <<01.02>>00474000
         LOGICAL CSTFLG:=0;                                    <<01.02>>00476000
DOUBLE CST'ADDRESS, DST'ADDRESS, PCB'ADDR;                     << WBT >>00478000
         LOGICAL DSTFLG:=0;                                    <<01.02>>00480000
         LOGICAL SERIES:=0;                                    <<01.3A>>00482000
         LOGICAL PCBFLG:=0;                                    <<01.02>>00484000
         LOGICAL GLOBPARM:=0;                                  <<01.02>>00486000
         LOGICAL DSTLENGTH:=%077777;     <<LENGTH OF DST>>     <<00221>>00488000
         LOGICAL CHARFLAG,BNKFLG:=FALSE;                       <<01114>>00490000
         LOGICAL STACKFLAG,MARKERS'OK;                         <<00221>>00492000
         LOGICAL PRTNPRT:=FALSE;     <<FLAG FOR NOPRINT ENTRY>><<03084>>00494000
         DOUBLE STACKMARKER;    <<POINTER TO TOP MARKER>>      <<00221>>00496000
         DOUBLE STACKSREG;      <<S REGISTER FOR STACK>>       <<00221>>00498000
         DOUBLE STARTADR;       <<SAVED TOP OF STACK>>         <<00221>>00500000
         ENTRY EIGHTLPI;     <<8 LINES PER INCH FORMATTED>>    <<00221>>00502000
         ENTRY NOPRINT;      <<TO APPEND LOADMAP AND MPECHECK>><<03084>>00504000
         LOGICAL SVPAPER:=TRUE;                                <<00.01>>00506000
         LOGICAL GLOBTEMP:=TRUE;                               << WBT >>00508000
  INTEGER MAXDUMPBANK;                                         <<00221>>00510000
         ARRAY REGSAVE(0:30)=DB;  <<REGISTERS>>                         00512000
         LOGICAL REG0=REGSAVE+0,                                        00514000
                 REG1=REGSAVE+1,                                        00516000
                 REG2=REGSAVE+2,                                        00518000
                 REG3=REGSAVE+3,                                        00520000
                 REG4=REGSAVE+4,                                        00522000
                 REG5=REGSAVE+5,                                        00524000
                 REG7=REGSAVE+6,                                        00526000
                 XREG=REGSAVE+7,                                        00528000
                 DLREG=REGSAVE+8,                                       00530000
                 DBBANKREG=REGSAVE+9,                                   00532000
                 DBREG=REGSAVE+10,                                      00534000
                 QREG=REGSAVE+11,                                       00536000
                 SREG=REGSAVE+12,                                       00538000
                 ZBANKREG=REGSAVE+13,                                   00540000
                 ZREG=REGSAVE+14,                                       00542000
                 STAREG=REGSAVE+15,                                     00544000
                 PBBANKREG=REGSAVE+16,                                  00546000
                 PBREG=REGSAVE+17,                                      00548000
                 PREG=REGSAVE+18,                                       00550000
                 PLREG=REGSAVE+19,                                      00552000
                 CIRREG=REGSAVE+20,                                     00554000
                 CPX1=REGSAVE+21,                                       00556000
                 CPX2=REGSAVE+22,                                       00558000
                 REG6=REGSAVE+23,                                       00560000
                 MEMSIZE=REGSAVE+24,                                    00562000
                 NIR=REGSAVE+25,                               <<00.01>>00564000
                 SP1=REGSAVE+26,                               <<00.01>>00566000
                 SP2=REGSAVE+27,                               <<00.01>>00568000
                 ISR=REGSAVE+28,                               <<00.01>>00570000
                 BANKNO,SVBANK,                                         00572000
                 PAGENO;     <<PAGE NUMBER>>                            00574000
         ARRAY VCST(0:11):=                                    <<01.3A>>00576000
            0,   <<PROGEN>>                                    <<01.3A>>00578000
            0,   <<UCOP>>                                      <<01.3A>>00580000
            0,   <<DEVREC>>                                    <<01.3A>>00582000
            0,   <<MESSAGE>>                                   <<01.3A>>00584000
            0,   <<LOG>>                                       <<01.3A>>00586000
            0,   <<LOAD>>                                      <<01.3A>>00588000
            0,   <<MEMLOGP>>                                   <<01.3A>>00590000
            0,   <<PCREATE>>                                   <<01.3A>>00592000
            0,   <<MORGUE>>                                    <<01.3A>>00594000
            0,   <<CIINIT>>                                    <<01.3A>>00596000
            0,   <<TRACE1'>>                                   <<01.3A>>00598000
            0;   <<SPOOLING>>                                  <<01.3A>>00600000
                 ARRAY DBUFFER(0:100);   <<PRINT BUFFER>>               00602000
                 ARRAY TBUF(0:75);                                      00604000
                 BYTE ARRAY STRING(*)=TBUF(37);                         00606000
                 BYTE ARRAY BBUF(*)=DBUFFER;                            00608000
                 BYTE ARRAY PSTRING(*)=DBUFFER(64);                     00610000
                 BYTE ARRAY BSTRING(*)=DBUFFER(58);                     00612000
BYTE ARRAY MOUNTNEXTVOLUME(0:17):="MOUNT NEXT VOLUME ";        <<00221>>00614000
BYTE ARRAY IMPROPERVOLUME (0:15):="IMPROPER VOLUME ";          <<00221>>00616000
LOGICAL ARRAY MNV(*) = MOUNTNEXTVOLUME;                        <<00221>>00618000
LOGICAL ARRAY IMPV(*) = IMPROPERVOLUME;                        <<00221>>00620000
         ARRAY indxaray (0:2*(lstsysdst+4));                   <<03556>>00622000
LOGICAL DITFPG, DITNFPG;                                       <<02012>>00624000
                 ARRAY IOQIX(0:2048);                          << MCW >>00626000
                 ARRAY SIRPIN(*)=IOQIX;                        <<00221>>00628000
ARRAY PCBSTACK(0:1023);                                        << MCW >>00630000
ARRAY ISFREEPCB(0:1023):=1024(FALSE);                          << MCW >>00632000
                 INTEGER X=X,S0=S-0,S1=S-1,S2=S-2,S3=S-3;               00634000
                 INTEGER S4=S-4,S5=S-5,S6=S-6,S7=S-7;                   00636000
                 BYTE POINTER PBUF:=@BBUF;                              00638000
                 ARRAY SCRBUF(0:100);                                   00640000
                 ARRAY MEMBUF(0:4800);                                  00642000
                 POINTER MEMBUFP:=@MEMBUF;                              00644000
DEFINE                                                         << WBT >>00646000
       CHECKMEMBUF=IF @MEMBUFP>(@MEMBUF+4780) THEN             << WBT >>00648000
                      MEMBUFOFL#,                              << WBT >>00650000
       MBTYPE     =MEMBUFP.(0:4)#,                             << WBT >>00652000
       MBENTNO    =MEMBUFP.(4:12)#,                            << WBT >>00654000
       MBBANK     =MEMBUFP(1)#,                                << WBT >>00656000
       MBADDR     =MEMBUFP(2)#,                                << WBT >>00658000
       MBCSTXNDX  =MEMBUFP(3)#;                                << WBT >>00660000
                 ARRAY COREBUF(0:4095);                                 00662000
BYTE ARRAY BCOREBUF(*)=COREBUF;                                <<03083>>00664000
LOGICAL FILE'REQUIRED;                                         <<03083>>00666000
ARRAY CHECKBUF(0:23);                                          <<03083>>00668000
BYTE ARRAY BCHECKBUF(*)=CHECKBUF;                              <<03083>>00670000
INTEGER CPUMACHINECODE;                                        <<03083>>00672000
EQUATE  MAX'DSTNUM = 4095;                                     << MCW >>00674000
BYTE ARRAY DST'TYPE(0:MAX'DSTNUM);                             <<04284>>00676000
DEFINE AFT05=CORE(AFTBASE-DOUBLE(INDX))#,                      << MCW >>00678000
       AFT04=CORE(AFTBASE-DOUBLE(INDX+1))#,                    << MCW >>00680000
       AFT03=CORE(AFTBASE-DOUBLE(INDX+2))#,                    << MCW >>00682000
       AFT02=CORE(AFTBASE-DOUBLE(INDX+3))#,                    << MCW >>00684000
       AFT01=CORE(AFTBASE-DOUBLE(INDX+4))#,                    << MCW >>00686000
       AFT00=CORE(AFTBASE-DOUBLE(INDX+5))#;                    << MCW >>00688000
                    LOGICAL ARRAY LCSTBLK(0:101):=101(%177777);<<01.02>>00690000
                    INTEGER ARRAY ICSTBLK(*)=LCSTBLK;          <<01.02>>00692000
                 DOUBLE LINKEDMEM; <<START OF LINKED MEM>>     <<WH.01>>00694000
DOUBLE MMPAGESIZE;     <<MEMORY MANAGER PAGE SIZE IN WORDS>>   << WBT >>00696000
DOUBLE SYSGLOBX;       <<START OF SYSGLOB EXTENSION>>          << WBT >>00698000
EQUATE RBTORSDISP   =   23,                                    << MCW >>00700000
       RBTONLDISP   =   18;                                    << MCW >>00702000
                 DOUBLE MAXMEM;                                         00704000
                 INTEGER MAXBANK=MAXMEM,BANKNUM;               <<00.01>>00706000
                 DOUBLE DBADR; <<DB ADDR FOR DSTS>>            <<01.3A>>00708000
                 DOUBLE VERNO:=%1116D;                                  00710000
                 DOUBLE UPNO:=%1114D;                                   00712000
                 DOUBLE FNO:=%1115D;                                    00714000
                                                               <<01543>>00716000
              DEFINE                                           <<01543>>00718000
                 SYSGLOBX'VER                                  <<01543>>00720000
                    = DOUBLE( CORE(%377D) + %76 ) #,           <<01543>>00722000
                 SYSGLOBX'UPD                                  <<01543>>00724000
                    = DOUBLE( CORE(%377D) + %74 ) #,           <<01543>>00726000
                 SYSGLOBX'FIX                                  <<01543>>00728000
                    = DOUBLE( CORE(%377D) + %75 ) #;           <<01543>>00730000
              DEFINE                                           <<s7922>>00732000
                 CSTEXPANSION = LOGICAL(CORE(%1220D))#;        <<s7922>>00734000
                                                               <<01543>>00736000
                 DOUBLE CSTABP:=0D;                                     00738000
                 DOUBLE CSTXTABP:=1D;                                   00740000
                 DOUBLE CHRONOS;                                        00742000
                 DOUBLE TRLB:=%1012D;                                   00744000
                 INTEGER COREF,LPF,NUMREC;                              00746000
                 BYTE ARRAY LEVEL(0:7):="        ";  <<*****>> <<04665>>00748000
                 BYTE ARRAY BCOPYRIT(0:131):=                  <<00221>>00750000
                 "(C) HEWLETT-PACKARD CO. 1980",104(" ");      <<01833>>00752000
                 ARRAY COPYRITE(*)=BCOPYRIT;                  <<<01.02>>00754000
                 ARRAY LVL(*)=LEVEL;                          <<<01.02>>00756000
                 BYTE ARRAY NAM(0:9):=                        <<<01.02>>00758000
                 "DPAN5 VER.";                                 << MCW >>00760000
                 ARRAY DPN4(*)=NAM;                            << WBT >>00762000
                 BYTE ARRAY DPANIN(0:6):="MDUMP  ";            <<00.01>>00764000
                 BYTE ARRAY TAPE(0:4):="TAPE ";                <<00.01>>00766000
                 EQUATE MAGTAPE=24,SERDISC=%37;                <<00.01>>00768000
         BYTE ARRAY COREDUMP(0:20):="MDUMP          TAPE ";    <<00221>>00770000
                 BYTE ARRAY DISC(0:1):="1.";                            00772000
                 DEFINE ASB=ASSEMBLE#;                                  00774000
                 BYTE ARRAY LPN(0:9):="DPANLIST  ";                     00776000
                 BYTE ARRAY LPND(0:3):="LP  ";                          00778000
         BYTE ARRAY LOADMAP(0:15):="LOADMAP.PUB.SYS ";         <<01.3A>>00780000
                 LOGICAL LMAPFNUM:=0; <<LOAD MAP FILE NUMBER>> <<00221>>00782000
         BYTE ARRAY MAPNAME(0:16):="MPECHECK.PUB.SYS ";        <<MS.00>>00784000
                 LOGICAL PMAPFILE:=0; <<PMAP FILE NUMBER>>     <<00221>>00786000
                 LOGICAL ARRAY MPEMIT2N(0:17):=                <<00221>>00788000
                    "MPEMIT2.PUB.SYS ";                        <<00221>>00790000
                 LOGICAL MPEMIT2:=0;   <<MPEMIT2 FNUM>>        <<00221>>00792000
                 LOGICAL MPEFCODE;                             <<00221>>00794000
                 LOGICAL ARRAY PROCINDEX(0:195):=196(%177777); <<00221>>00796000
                    <<INDEXED BY CST, POINTER INTO PMAP FILE>> <<00221>>00798000
                 LOGICAL SAME'SYSTEM:=TRUE;   <<TILL SITE ID>> <<00221>>00800000
                 INTEGER LNSPERPG:=58;  <<LINES PER PAGE>>     <<00221>>00802000
DEFINE LDFNUM=LMAPFNUM#;  << FOR GSD RECODE >>                 <<00221>>00804000
DEFINE SAME'SYS=SAME'SYSTEM#; << FOR GSD RECODE >>             <<00221>>00806000
                 INTRINSIC FOPEN,FCLOSE,FREAD,FWRITE,FREADDIR,          00808000
                 WHO,PAUSE,READX,TERMINATE,ARITRAP;            <<03079>>00810000
                 INTRINSIC FWRITEDIR,FCONTROL,PRINT,ASCII,DASCII;       00812000
                 INTRINSIC FGETINFO,GETPRIVMODE,GETUSERMODE;   <<00.01>>00814000
INTRINSIC FSPACE,FCHECK,QUIT;                                  <<03083>>00816000
INTRINSIC FPOINT,BINARY;                                       <<MS.00>>00818000
                 INTEGER PAGE:=1;                                       00820000
                 INTEGER LINECOUNT:=0;                                  00822000
                 INTEGER CLOCK,CALENDAR,CDSTN,DSTNB,MACHINEID; <<00.01>>00824000
                 ARRAY COMPBUFF(0:15);                                  00826000
                 BYTE ARRAY CB(*)=COMPBUFF;                             00828000
                 ARRAY COMPBUFF2(0:15);                                 00830000
                 BYTE ARRAY CB2(*)=COMPBUFF2;                           00832000
    LOGICAL MSWAPS:=0;          <<NUMBER OF SWAPS COUNTER>>    <<00221>>00834000
    DOUBLE MFETCH:=0D;          <<NUMBER OF FETCHES>>          <<00221>>00836000
    LOGICAL MACTAG:=0;          <<ACTIVITY TAG>>               <<00221>>00838000
    BYTE ARRAY MSWLIN(0:49):="DPANSWAP",42(" ");               <<00221>>00840000
    LOGICAL ARRAY LMSWLIN(*)=MSWLIN;                           <<00221>>00842000
    LOGICAL DPANSWAP:=0;        <<DPAN SWAP FILE>>             <<00221>>00844000
    DOUBLE ARRAY DSTADDR(1:LSTSYSDST):=LSTSYSDST(0D);          <<00221>>00846000
    DOUBLE ARRAY DSTDEFIN(*)=DSTADDR(2);  <<DEFINE DST BASE>>  <<00221>>00848000
    DOUBLE ARRAY CSTDEFIN(*)=DSTADDR(1);  <<DEFINE CST BASE>>  <<00221>>00850000
    DOUBLE ARRAY PCBDEFIN(*)=DSTADDR(3);  <<DEFINE PCB BASE>>  <<00221>>00852000
    LOGICAL ARRAY DSTDEF(1:LSTSYSDST):=LSTSYSDST(0);           <<00221>>00854000
                 DEFINE SEGK=STAREG.(8:8)#;                             00856000
                DEFINE CC=STATUS.(6:2)#;                       <<01.02>>00858000
          EQUATE OLDSERIESII  = 0,                             <<00.01>>00860000
                 MODEL35      = 1,     << SERIES 3  >>         <<01377>>00862000
                 MODEL25      = 2,     << SERIES 33 >>         <<01377>>00864000
                 MODEL44      = 3,     << SERIES 44 >>         <<01296>>00866000
                 ICF55        = 4,     << SERIES 55 >>         <<04665>>00868000
                 MM           = 5,     << MIGHTY MOUSE >>      <<s7922>>00870000
                 VUFF'COL     = 0;     << OFFSET FOR VUF>>     <<04665>>00872000
                                                               <<01377>>00874000
          DEFINE SERIES'33'THRU'MM                             <<s7922>>00876000
             = ( MACHINEID=MODEL25 LOR MACHINEID=MODEL44       <<01296>>00878000
                 LOR MACHINEID=ICF55 LOR MACHINEID=MM )#;      <<s7922>>00880000
                                                               <<01377>>00882000
         DEFINE ICF55'OR'MM                                    <<s7922>>00884000
            = ( MACHINEID=ICF55 LOR MACHINEID=MM )#;           <<s7922>>00886000
                                                               <<01377>>00888000
<< Since the ILT format changed some time ago, we need to>>    <<03752>>00890000
<< check for this, even though it is unlikely old formats>>    <<03752>>00892000
<< will ever be processed. Thus we check word 0 of the   >>    <<03752>>00894000
<< ILT. In the old format, bits (8:8) held the DRT number>>    <<03752>>00896000
<< while in the new format word 0 is a CPVA word which   >>    <<03752>>00898000
<< would not usually contain a value exactly equal to the>>    <<03752>>00900000
<< DRT number of the host ILT. If this again becomes a   >>    <<03752>>00902000
<< problem, this define could  be changed to '( TRUE )', >>    <<03752>>00904000
<< after which only new ILT's will be processed.         >>    <<03752>>00906000
                                                               <<03752>>00908000
       DEFINE NEW'ILT'FORMAT =                                 <<03752>>00910000
        (INTEGER(CORE(LOCILT).(8:8)) <> DRTNO)#;               <<03752>>00912000
                                                               <<03752>>00914000
<<* * * MACHINE CONTEXT * * *>>                                <<00.01>>00916000
                                                               <<00.01>>00918000
DEFINE                                                         <<00.01>>00920000
   CNMACHINEID        = COREBUF(%1400).(8:8) #,                <<01172>>00922000
                                                               <<00.01>>00924000
<<MODEL 35>>                                                   <<00.01>>00926000
   CNSTARFISH         = COREBUF(%1400).(0:8) #,                <<02519>>00928000
   M35CONTENTS24      = COREBUF(%1401)       #,                <<00.01>>00930000
   M35SMREG           = COREBUF(%1402)       #,                <<00.01>>00932000
   M35SP1REG          = COREBUF(%1403)       #,                <<00.01>>00934000
   M35SP2REG          = COREBUF(%1404)       #,                <<00.01>>00936000
   M35DBREG           = COREBUF(%1405)       #,                <<00.01>>00938000
   M35DBANKREG        = COREBUF(%1406).(0:4) #,                <<00.01>>00940000
   M35PBANKREG        = COREBUF(%1406).(4:4) #,                <<00.01>>00942000
   M35SBANKREG        = COREBUF(%1406).(12:4)#,                <<00.01>>00944000
   M35ZREG            = COREBUF(%1407)       #,                <<00.01>>00946000
   M35DLREG           = COREBUF(%1410)       #,                <<00.01>>00948000
   M35XREG            = COREBUF(%1411)       #,                <<00.01>>00950000
   M35QREG            = COREBUF(%1412)       #,                <<00.01>>00952000
   M35CIREG           = COREBUF(%1413)       #,                <<00.01>>00954000
   M35PBREG           = COREBUF(%1414)       #,                <<00.01>>00956000
   M35PLREG           = COREBUF(%1415)       #,                <<00.01>>00958000
   M35PREG            = COREBUF(%1416)       #,                <<00.01>>00960000
   M35CPX1            = COREBUF(%1417)       #,                <<00.01>>00962000
   M35STATUSREG       = COREBUF(%1420)       #,                <<00.01>>00964000
   M35CPX2            = COREBUF(%1421).(0:8) #,                <<00.01>>00966000
   M35NUMBANKS        = COREBUF(%1421).(8:8) #,                <<00.01>>00968000
   CNDRT0             = COREBUF(%1422)       #,                <<02519>>00970000
   CNDRT1             = COREBUF(%1423)       #,                <<02519>>00972000
   CNDRT2             = COREBUF(%1424)       #,                <<02519>>00974000
   CNDRT3             = COREBUF(%1425)       #,                <<02519>>00976000
                                                               <<00.01>>00978000
                                                               <<00.01>>00980000
<<MODEL 25  AND  MODEL ICF/55>>                                <<03013>>00982000
   M25DUMPDEVICEDRT   = COREBUF(%1401)       #,                <<00.01>>00984000
   M25XREG            = COREBUF(%1402)       #,                <<00.01>>00986000
   M25DLREG           = COREBUF(%1403)       #,                <<00.01>>00988000
   M25DBANKREG        = COREBUF(%1404)       #,                <<00.01>>00990000
   M25DBREG           = COREBUF(%1405)       #,                <<00.01>>00992000
   M25QREG            = COREBUF(%1406)       #,                <<00.01>>00994000
   M25SREG            = COREBUF(%1407)       #,                <<00.01>>00996000
   M25SBANKREG        = COREBUF(%1410)       #,                <<00.01>>00998000
   M25ZREG            = COREBUF(%1411)       #,                <<00.01>>01000000
   M25STATUSREG       = COREBUF(%1412)       #,                <<00.01>>01002000
   M25PBANKREG        = COREBUF(%1413)       #,                <<00.01>>01004000
   M25PBREG           = COREBUF(%1414)       #,                <<00.01>>01006000
   M25PREG            = COREBUF(%1415)       #,                <<00.01>>01008000
   M25PLREG           = COREBUF(%1416)       #,                <<00.01>>01010000
   M25CIREG           = COREBUF(%1417)       #,                <<00.01>>01012000
   M25NUMPHYSICALBANKS= COREBUF(%1420)       #,                <<00.01>>01014000
   M25NIRREG          = COREBUF(%1421)       #,                <<00.01>>01016000
   M55NIRREG          = COREBUF(%1515)       #,                <<03013>>01018000
   M25ISR             = COREBUF(%1422)       #,                <<00.01>>01020000
   M25NUMBANKS        = COREBUF(%1423)       #,                <<03013>>01022000
   M55CPX1            = COREBUF(%1421)       #,                <<03013>>01024000
   M55CPX2            = COREBUF(%1422)       #;                <<03013>>01026000
 EQUATE NUM'RESPONSES = 28;                                    <<sknew>>01028000
 LOGICAL ARRAY RESPONSES(0:NUM'RESPONSES-1):=                  <<01114>>01030000
          NUM'RESPONSES(TRUE);                                 <<01114>>01032000
 DEFINE PRINT'REGISTERS    = RESPONSES    #,                   <<01114>>01034000
        PRINT'CST          = RESPONSES(1) #,                   <<01114>>01036000
        PRINT'DST          = RESPONSES(2) #,                   <<01114>>01038000
        PRINT'PCB          = RESPONSES(3) #,                   <<01114>>01040000
        PRINT'STACKS       = RESPONSES(4) #,                   <<01114>>01042000
        PRINT'CACHE        = RESPONSES(5) #,                   << WBT >>01044000
        PRINT'DRQT         = RESPONSES(6) #,                   << WBT >>01046000
        PRINT'VDSL         = RESPONSES(7) #,                   <<01114>>01048000
        PRINT'VDSM         = RESPONSES(8) #,                   <<01114>>01050000
        PRINT'DRT          = RESPONSES(9) #,                   <<01114>>01052000
        PRINT'ILT          = RESPONSES(10)#,                   <<01114>>01054000
        PRINT'LPDT         = RESPONSES(11)#,                   <<01114>>01056000
        PRINT'DIT          = RESPONSES(12)#,                   <<01114>>01058000
        PRINT'IOQ          = RESPONSES(13)#,                   <<01114>>01060000
        PRINT'SBUF         = RESPONSES(14)#,                   <<01114>>01062000
        PRINT'TBUF         = RESPONSES(15)#,                   <<01114>>01064000
        PRINT'TRL          = RESPONSES(16)#,                   <<01114>>01066000
        PRINT'SIR          = RESPONSES(17)#,                   <<01114>>01068000
        PRINT'MON          = RESPONSES(18)#,                   <<01114>>01070000
        PRINT'MEMORY       = RESPONSES(19)#,                   <<01114>>01072000
        FORMAT'MEMORY      = RESPONSES(20)#,                   <<01114>>01074000
        CODE'SEGMENTS      = RESPONSES(21)#,                   <<01114>>01076000
        FREE'AREAS         = RESPONSES(22)#,                   <<01114>>01078000
        PRINT'INDEX        = RESPONSES(23)#,                   << WBT >>01080000
        PRINT'SLL          = RESPONSES(24)#,                   <<03076>>01082000
        PRINT'ICS          = RESPONSES(25)#,                   <<03076>>01084000
        MINI'DUMP          = RESPONSES(26)#,                   <<sknew>>01086000
        CACHED'REGIONS     = RESPONSES(27)#;                   <<sknew>>01088000
 EQUATE MAXIMUM'BANKS = 64;                                    <<01114>>01090000
 LOGICAL ARRAY PRINT'BANK(0:MAXIMUM'BANKS-1):=                 <<01114>>01092000
          MAXIMUM'BANKS(FALSE);                                <<01114>>01094000
 LOGICAL JSM;                                                  <<01114>>01096000
                                                                        01098000
DEFINE                                                         << WBT >>01100000
PCB00=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+00))#,                   << WBT >>01102000
PCB01=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+01))#,                   << WBT >>01104000
PCB02=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+02))#,                   << WBT >>01106000
PCB03=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+03))#,                   << WBT >>01108000
PCB04=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+04))#,                   << WBT >>01110000
PCB05=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+05))#,                   << WBT >>01112000
PCB06=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+06))#,                   << WBT >>01114000
PCB07=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+07))#,                   << WBT >>01116000
PCB08=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+08))#,                   << WBT >>01118000
PCB09=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+09))#,                   << WBT >>01120000
PCB10=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+10))#,                   << WBT >>01122000
PCB11=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+11))#,                   << WBT >>01124000
PCB12=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+12))#,                   << WBT >>01126000
PCB13=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+13))#,                   << WBT >>01128000
PCB14=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+14))#,                   << WBT >>01130000
PCB15=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+15))#,                   << MCW >>01132000
PCB16=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+16))#,                   << MCW >>01134000
PCB17=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+17))#,                   << MCW >>01136000
PCB18=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+18))#,                   << MCW >>01138000
PCB19=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+19))#,                   << MCW >>01140000
PCB20=CORE(LOCPCB+DOUBLE(INDX*PCBSIZE+20))#;                   << MCW >>01142000
                                                               << WBT >>01144000
EQUATE                                                         << WBT >>01146000
SEGIDDATATYPE = 0,                                             << WBT >>01148000
SEGIDSLTYPE   = 1;  << PROGRAM TYPE = 2 OR 3 >>                << WBT >>01150000
DEFINE                                                         << WBT >>01152000
SEGIDTYPEFIELD    = (0:2)#,                                    << WBT >>01154000
SEGIDPBXFLAG      = (0:1)#,                                    << WBT >>01156000
SEGIDPBXFIELD     = (1:7)#,                                    << WBT >>01158000
SEGIDLOGSEGFIELD  = (8:8)#;                                    << WBT >>01160000
                                                               << WBT >>01162000
DEFINE                                                         <<01791>>01164000
                                                               <<01791>>01166000
NUMCONFIG   = CORE(TABLEBASE)#,                                <<01791>>01168000
NUMFREE     = CORE(TABLEBASE+2D)#,                             <<01791>>01170000
FIRSTFREEX  = CORE(TABLEBASE+3D)#,                             <<01791>>01172000
NEXTFREEX   = CORE(TABLEBASE+DOUBLE(FREEX+1))#;                <<01791>>01174000
                                                               <<01791>>01176000
                                                               <<01791>>01178000
INTRINSIC PRINTOP;                                                      01180000
                                                               <<04665>>01182000
$INCLUDE INCLVUF                                               <<04665>>01184000
                                                               <<04665>>01186000
$INCLUDE INCLDNFW                                              <<fwd01>>01188000
                                                                        01190000
$PAGE "OCTALDUMP: Print formatted core dump data"                       01192000
$CONTROL SEGMENT=UTIL                                          <<01.3A>>01194000
PROCEDURE OCTALDUMP(STADR,ENADR,TABLEBASE);                    << WBT >>01196000
      VALUE STADR,ENADR,TABLEBASE;                             << WBT >>01198000
      DOUBLE STADR,ENADR,TABLEBASE;                            << WBT >>01200000
      OPTION VARIABLE;                                         << WBT >>01202000
                                                                        01204000
COMMENT                                                                 01206000
                                                                        01208000
Purpose:                                                                01210000
     this procedure will format and print octal data from "start"       01212000
     to "stop"  8x8 2 columns across.if 16 even contigious              01214000
     locations are duplicated more than once a duplication              01216000
     message is printed.                                                01218000
                                                                        01220000
Input parameters:                                                       01222000
                                                                        01224000
Output parameters:                                                      01226000
                                                                        01228000
Globals Referenced:                                                     01230000
                                                                        01232000
Globals Altered:                                                        01234000
                                                                        01236000
Data Structures:                                                        01238000
                                                                        01240000
Algorithm:                                                              01242000
                                                                        01244000
;                                                                       01246000
       BEGIN                                                            01248000
   ENTRY DUMPTABLE;                                            << WBT >>01250000
          DOUBLE LINESTART1,LINESTART2,LINEDUP;                         01252000
            INTEGER IX2,CWORD;                                <<<01.02>>01254000
            LOGICAL IX1,IX3;                                  <<<01.02>>01256000
          LOGICAL DUPLICATION;                                          01258000
         DOUBLE LINEBUMP,LINECT;                               <<01.3A>>01260000
         LOGICAL IX1S,IX1T;                                    <<01.3A>>01262000
   TABLEBASE:=0D;                                              << WBT >>01264000
DUMPTABLE:                                                     << WBT >>01266000
          IF ENADR > MAXMEM THEN ENADR:=MAXMEM;                         01268000
      IF ENADR < STADR THEN GO ENDUMP;     <<ALLOW ONE WORD>>  <<00221>>01270000
         IF CHARFLAG THEN <<CHECK FOR DUMP LIMITS>>            <<01.3A>>01272000
         BEGIN                                                 <<01.3A>>01274000
            LINEBUMP:=0D;<<PRINT ADDR FOR CHARS>>              <<01.3A>>01276000
            IX1S:=12;                                          <<01.3A>>01278000
            IX1T:=12;                                          <<01.3A>>01280000
            LINECT:=12D;                                       <<01.3A>>01282000
         END ELSE                                              <<01.3A>>01284000
         BEGIN                                                 <<01.3A>>01286000
            LINEBUMP:=8D;<<SET LIMITS FOR OCTAL>>              <<01.3A>>01288000
            IX1S:=8;                                           <<01.3A>>01290000
            IX1T:=16;                                          <<01.3A>>01292000
            LINECT:=16D;                                       <<01.3A>>01294000
         END;                                                  <<01.3A>>01296000
          LINESTART1:=STADR;                                            01298000
          IX2 := 0;                                                     01300000
TEST2:    IX1:=0;  @PBUF:=@BBUF;  DUPLICATION:=FALSE;                   01302000
                                                                        01304000
         LINESTART2:=LINESTART1+LINEBUMP;                      <<01.3A>>01306000
          TOS:=LINESTART1-TABLEBASE;                           << WBT >>01308000
          CWORD:=TOS;                                                   01310000
          DEL;                                                          01312000
          PUTNUM(CWORD);                                                01314000
          @PBUF:=@PBUF-1;                                               01316000
         IF CHARFLAG THEN  <<INCLUDE DB REL ADDRESS>>          <<01.3A>>01318000
         BEGIN                                                 <<01.3A>>01320000
              TOS:=(LINESTART1-STARTADR-DBADR);                <<00221>>01322000
            CWORD:=TOS; <<LOW ORDER 16 BITS>>                  <<01.3A>>01324000
            DEL;        <<HI ORDER 16 BITS>>                   <<01.3A>>01326000
            PBUF:="(";                                         <<01.3A>>01328000
            @PBUF:=@PBUF+1;                                    <<01.3A>>01330000
            PUTNUM(CWORD);<<DB REL ADDRESS>>                   <<01.3A>>01332000
            @PBUF:=@PBUF-1;                                    <<01.3A>>01334000
            MOVE PBUF:=")";                                    <<01.3A>>01336000
            @PBUF:=@PBUF+1;                                    <<01.3A>>01338000
         END;                                                  <<01.3A>>01340000
          PBUF:=":";                                                    01342000
          @PBUF:=@PBUF+2;                                               01344000
          DO                                                            01346000
             BEGIN                                                      01348000
                COMPBUFF(IX1):=CORE(LINESTART1+DOUBLE(IX1));            01350000
                PUTNUM(COMPBUFF(IX1));                                  01352000
                IX1:=IX1+1;                                             01354000
             IF (LINESTART1+DOUBLE(IX1))>ENADR THEN            <<01.3A>>01356000
             IF CHARFLAG THEN                                  <<01.3A>>01358000
                IX1:=IX1S <<ASCII CHARACTERS>>                 <<01.3A>>01360000
                ELSE GO PLINE;                                 <<01.3A>>01362000
             END                                                        01364000
       UNTIL IX1=IX1S;                                         <<01.3A>>01366000
       @PBUF:=@BBUF+9+INTEGER(IX1S)*7;                         <<01.3A>>01368000
       IF CHARFLAG THEN <<DOING CHARACTERS>>                   <<01.3A>>01370000
       BEGIN                                                   <<01.3A>>01372000
          @PBUF:=@PBUF+8;                                      <<01.3A>>01374000
          IX1:=0;<<START OVER FOR CHARS>>                      <<01.3A>>01376000
       END;                                                    <<01.3A>>01378000
          TOS:=LINESTART2-TABLEBASE;                           << WBT >>01380000
          CWORD:=TOS;                                                   01382000
          DEL;                                                          01384000
          PUTNUM(CWORD);                                                01386000
          @PBUF:=@PBUF-1;                                               01388000
          PBUF:=":";                                                    01390000
     IF CHARFLAG THEN                                          <<01.3A>>01392000
      @PBUF:=@PBUF+1 <<CHARS NEXT TO ":">>                     <<01.3A>>01394000
      ELSE                                                     <<01.3A>>01396000
          @PBUF:=@PBUF+2;                                               01398000
          DO                                                            01400000
             BEGIN                                                      01402000
                COMPBUFF(IX1):=CORE(LINESTART1+DOUBLE(IX1));            01404000
            IF CHARFLAG THEN                                   <<01.3A>>01406000
             PUTCHAR(LOGICAL(COMPBUFF(IX1)))                   <<01.3A>>01408000
            ELSE                                               <<01.3A>>01410000
                PUTNUM(COMPBUFF(IX1));                                  01412000
                IX1:=IX1+1;                                             01414000
                IF (LINESTART1+DOUBLE(IX1)) >ENADR THEN GO PLINE;       01416000
             END                                                        01418000
     UNTIL IX1=IX1T;                                           <<01.3A>>01420000
PLINE:    PRINTLINE;  <<GO PRINT LINE>>                                 01422000
          IF (LINESTART1+DOUBLE(IX1)) >ENADR THEN GO ENDUMP;            01424000
     LINEDUP:=LINESTART1+LINECT;<<TEST FOR DUP>>               <<01.3A>>01426000
COMPARE:  IX3:=0;                                                       01428000
          DO                                                            01430000
             BEGIN                                                      01432000
                IF (LINEDUP+DOUBLE(IX3)) > MAXMEM THEN GO TEST1;        01434000
                COMPBUFF2(IX3):=CORE(LINEDUP+DOUBLE(IX3));              01436000
                IX3:=IX3+1;                                             01438000
        END UNTIL IX3=IX1T;                                    <<01.3A>>01440000
     IF CB <> CB2,(2*INTEGER(IX1T)) THEN GO TEST1;             <<01.3A>>01442000
          DUPLICATION:=TRUE;                                            01444000
     LINEDUP:=LINEDUP+LINECT;<<BUMP TO COMP NXT LINE>>         <<01.3A>>01446000
          IF LINEDUP > ENADR THEN GO PRINTDUP;                          01448000
          GO TO COMPARE;                                                01450000
TEST1:    IF DUPLICATION=TRUE THEN GO PRINTDUP;                         01452000
CONT1:    IX2:=IX2+1;                                                   01454000
          LINESTART1:=LINEDUP;                                          01456000
          IF LINESTART1 > ENADR THEN GO ENDUMP;                         01458000
          IF IX2=8 THEN                                                 01460000
             BEGIN                                                      01462000
               IF NOT CHARFLAG THEN     <<NO SKIP IF CHAR>>    <<00221>>01464000
                SKIPLINES(1); <<SKIP LINE AFTER PRINT 8>>               01466000
                IX2:=0;                                                 01468000
             END;                                                       01470000
          GO TO TEST2;                                                  01472000
PRINTDUP:  <<PRINT LINES XXXXXX-XXXXXX SAME AS ABOVE>>                  01474000
         BLANKBUF;                                                      01476000
     IF LINEDUP > ENADR THEN LINEDUP:=(LINEDUP-LINECT);        <<01.3A>>01478000
     IF LINEDUP = (LINESTART1+LINECT) THEN GO CONT1;           <<01.3A>>01480000
          MOVE BBUF                                                     01482000
          :="LINES XXXXXX - XXXXXX SAME AS ABOVE ";                     01484000
          @PBUF:=@PBUF+6;                                               01486000
     TOS:=LINESTART1+LINECT-TABLEBASE;                         << WBT >>01488000
          CWORD:=TOS;                                                   01490000
          DEL;                                                          01492000
          PUTNUM(CWORD);                                                01494000
          @PBUF:=@PBUF+2;                                               01496000
          TOS:=LINEDUP-1D-TABLEBASE;                           << WBT >>01498000
          CWORD:=TOS;                                                   01500000
          DEL;                                                          01502000
          PUTNUM(CWORD);                                                01504000
          PRINTLINE;                                                    01506000
          IX2:=7;                                                       01508000
          GO TO CONT1 <<CONTINUE>>;                                     01510000
ENDUMP:                                                                 01512000
       END;                                                             01514000
                                                                        01516000
$PAGE "SKIPOCTALDUMP: Note range of addresses not printed"              01518000
$CONTROL SEGMENT=UTIL                                                   01520000
PROCEDURE SKIPOCTALDUMP(CURAD,NEXTADR);                        <<01.3A>>01522000
VALUE CURAD,NEXTADR; DOUBLE CURAD,NEXTADR;                     <<01.3A>>01524000
COMMENT                                                                 01526000
                                                                        01528000
Purpose:                                                                01530000
     Print message noting that a range of addresses has been            01532000
     skipped.  Provides parallelism with OCTALDUMP.                     01534000
                                                                        01536000
Input parameters:                                                       01538000
     CURAD: Sktarting address                                           01540000
     NEXTADR: Ending address                                            01542000
                                                                        01544000
Output parameters:                                                      01546000
                                                                        01548000
Globals Referenced:                                                     01550000
                                                                        01552000
Globals Altered:                                                        01554000
                                                                        01556000
Data Structures:                                                        01558000
                                                                        01560000
Algorithm:                                                              01562000
                                                                        01564000
;  <<end procedure header comment>>                                     01566000
BEGIN                                                          <<01.3A>>01568000
                                                               <<01.3A>>01570000
LOGICAL SCR1=Q-6;                                              <<01.3A>>01572000
LOGICAL SCR3=Q-4;                                              <<01.3A>>01574000
                                                               <<01.3A>>01576000
   IF CURAD>NEXTADR THEN RETURN;                               <<01924>>01578000
MOVE BBUF:=                                                    <<01.3A>>01580000
"**** (       TO        NOT PRINTED) ****";                    <<01.3A>>01582000
@PBUF:=@BBUF+6;                                                <<01.3A>>01584000
PUTNUMP(SCR1);                                                 <<01.3A>>01586000
@PBUF:=@BBUF+16;                                               <<01.3A>>01588000
PUTNUMP(SCR3);                                                 <<01.3A>>01590000
PRINTLINE;                                                     <<01.3A>>01592000
END<<SKIPOCTALDUMP>>;                                          <<01.3A>>01594000
                                                                        01596000
$PAGE "PUTCHAR: Write 2 characters to PBUF"                             01598000
$CONTROL SEGMENT=UTIL                                                   01600000
PROCEDURE PUTCHAR(WORD);                                       <<01.3A>>01602000
COMMENT                                                                 01604000
                                                                        01606000
Purpose:                                                                01608000
     Screen out strange characters and replace them with a '.'          01610000
     This procedure puts a pair of characters into                      01612000
     the output line and advances @pbuf.  Any invalid                   01614000
     characters are replaced by a ".".                                  01616000
                                                                        01618000
Input parameters:                                                       01620000
     WORD: Contains 2 byte size characters                              01622000
                                                                        01624000
Output parameters: none                                                 01626000
                                                                        01628000
Globals Referenced:                                                     01630000
     @PBUF: pointer to PBUF output buffer.                              01632000
                                                                        01634000
Globals Altered:                                                        01636000
     @PBUF is incremented by 2.                                         01638000
     2 characters are written to PBUF                                   01640000
                                                                        01642000
Data Structures:                                                        01644000
                                                                        01646000
Algorithm:                                                              01648000
     Check each byte separately, if its < %40 or > %176                 01650000
     its probably strange, so write a '.'.                              01652000
     Otherwise, write the character as is                               01654000
                                                                        01656000
;                                                                       01658000
                                                               <<01.3A>>01660000
   VALUE WORD;                                                 <<01.3A>>01662000
   LOGICAL WORD;                                               <<01.3A>>01664000
   BEGIN                                                       <<01.3A>>01666000
     IF ((WORD.(0:8) < %40) OR (WORD.(0:8) > %176))            <<01.3A>>01668000
     THEN PBUF:="." ELSE PBUF:=BYTE(WORD.(0:8));               <<01.3A>>01670000
     @PBUF:=@PBUF+1;                                           <<01.3A>>01672000
     IF ((WORD.(8:8)<%40) OR (WORD.(8:8) > %176))              <<01.3A>>01674000
     THEN PBUF:="." ELSE PBUF:=BYTE(WORD.(8:8));               <<01.3A>>01676000
     @PBUF:=@PBUF+1;                                           <<01.3A>>01678000
   END;                                                        <<01.3A>>01680000
                                                                        01682000
$PAGE "NAMEDST: Describe DST given DST number"                          01684000
$CONTROL SEGMENT=UTIL                                                   01686000
PROCEDURE NAMEDST;                                                      01688000
COMMENT                                                                 01690000
                                                                        01692000
Purpose:                                                                01694000
     This procedure will name the dst entrys by their function          01696000
                                                                        01698000
Input parameters:                                                       01700000
                                                                        01702000
Output parameters:                                                      01704000
                                                                        01706000
Globals Referenced:                                                     01708000
     MBENTNO is used to pass in the number of the DST to be             01710000
             described                                                  01712000
                                                                        01714000
Globals Altered:                                                        01716000
     PBUF output buffer gets description of DST                         01718000
     @PBUF is incremented according to length of description            01720000
                                                                        01722000
Data Structures:                                                        01724000
                                                                        01726000
Algorithm:                                                              01728000
     Blank out PBUF(1:32), then use a big case statement to             01730000
     give the DST the appropriate name.                                 01732000
                                                                        01734000
;                                                                       01736000
   BEGIN                                                                01738000
     MOVE PBUF   := " ";  << BLANK OUT >>                      <<MS.00>>01740000
     MOVE PBUF(1):= PBUF,(32); << OUTPUT BUFFER >>             <<MS.00>>01742000
   CASE MBENTNO OF                                             <<01833>>01744000
      BEGIN                                                             01746000
         BEGIN     <<0>>                                                01748000
         END;                                                           01750000
         BEGIN     <<1>>                                                01752000
            MOVE PBUF:="(CODE SEGMENT TABLE)";                          01754000
            @PBUF:=@PBUF+20;                                            01756000
         END;                                                           01758000
         BEGIN     <<2>>                                                01760000
            MOVE PBUF:="(DATA SEGMENT TABLE)";                          01762000
            @PBUF:=@PBUF+20;                                            01764000
         END;                                                           01766000
         BEGIN     <<3>>                                                01768000
            MOVE PBUF:="(PROCESS CONTROL BLOCK)";                       01770000
            @PBUF:=@PBUF+23;                                            01772000
         END;                                                           01774000
         BEGIN     <<4>>                                                01776000
            MOVE PBUF:="(CST EXTENSION)";                               01778000
            @PBUF:=@PBUF+16;                                            01780000
         END;                                                           01782000
         BEGIN     <<5>>                                                01784000
            MOVE PBUF:="(SYSTEM GLOBAL AREA)";                          01786000
            @PBUF:=@PBUF+21;                                            01788000
         END;                                                           01790000
         BEGIN     <<6>>                                                01792000
            MOVE PBUF:="(FIXED LOW CORE)";                              01794000
            @PBUF:=@PBUF+18;                                            01796000
         END;                                                           01798000
         BEGIN     <<7>>                                                01800000
            MOVE PBUF:="(INTERRUPT CONTROL STACK)";                     01802000
            @PBUF:=@PBUF+26;                                            01804000
         END;                                                           01806000
         BEGIN     <<10>>                                               01808000
            MOVE PBUF:="(SYSTEM BUFFERS)";                              01810000
            @PBUF:=@PBUF+17;                                            01812000
           CHARFLAG:=TRUE;                                     <<01.3A>>01814000
         END;                                                           01816000
         BEGIN     <<11>>                                               01818000
            MOVE PBUF:="(UCOP REQUEST QUEUE)";                          01820000
            @PBUF:=@PBUF+21;                                            01822000
         END;                                                           01824000
         BEGIN     <<12>>                                               01826000
            MOVE PBUF:="(PROCESS-PROCESS COMMUNICATION TABLE)";         01828000
            @PBUF:=@PBUF+38;                                            01830000
         END;                                                           01832000
         BEGIN     <<13>>                                               01834000
            MOVE PBUF:="(I/O QUEUE)";                                   01836000
            @PBUF:=@PBUF+12;                                            01838000
         END;                                                           01840000
         BEGIN     <<14>>                                               01842000
            MOVE PBUF:="(TERMINAL BUFFERS)";                            01844000
            @PBUF:=@PBUF+19;                                            01846000
           CHARFLAG:=TRUE;                                     <<01.3A>>01848000
         END;                                                           01850000
         BEGIN     <<15>>                                               01852000
            MOVE PBUF:="(LOGICAL-PHYSICAL DEVICE TABLE)";               01854000
            @PBUF:=@PBUF+32;                                            01856000
         END;                                                           01858000
         BEGIN     <<16>>                                               01860000
            MOVE PBUF:="(LOGICAL DEVICE TABLE)";               << MCW >>01862000
            @PBUF:=@PBUF+23;                                   << MCW >>01864000
           CHARFLAG:=TRUE;                                     <<01.3A>>01866000
         END;                                                           01868000
         BEGIN     <<17>>                                               01870000
            MOVE PBUF:="(DRIVER LINKAGE TABLE)";                        01872000
            @PBUF:=@PBUF+23;                                            01874000
         END;                                                           01876000
         BEGIN     <<20>>                                               01878000
            MOVE PBUF:="(I/O RESOURCE TABLES)";                <<01.02>>01880000
            @PBUF:=@PBUF+23;                                            01882000
         END;                                                           01884000
         BEGIN     <<21>>                                               01886000
           MOVE PBUF := "(PORT DICTIONARY TABLE)";             <<03556>>01888000
           @PBUF := @PBUF + 24;                                <<03556>>01890000
         END;                                                           01892000
         BEGIN     <<22>>                                               01894000
            MOVE PBUF:="(LOADER SEGMENT TABLE)";                        01896000
            @PBUF:=@PBUF+23;                                            01898000
           CHARFLAG:=TRUE;                                     <<01.3A>>01900000
         END;                                                           01902000
         BEGIN     <<23>>                                               01904000
            MOVE PBUF:="(TIMER REQUEST LIST)";                          01906000
            @PBUF:=@PBUF+21;                                            01908000
         END;                                                           01910000
         BEGIN     <<24>>                                               01912000
            MOVE PBUF:="(DIRECTORY)";                                   01914000
            @PBUF:=@PBUF+12;                                            01916000
           CHARFLAG:=TRUE;                                     <<01.3A>>01918000
         END;                                                           01920000
         BEGIN     <<25>>                                               01922000
            MOVE PBUF:="(DIRECTORY SPACE)";                             01924000
            @PBUF:=@PBUF+18;                                            01926000
         END;                                                           01928000
         BEGIN     <<26>>                                               01930000
            MOVE PBUF:="(RIN TABLE)";                                   01932000
            @PBUF:=@PBUF+12;                                            01934000
         END;                                                           01936000
         BEGIN     <<27>>                                               01938000
            MOVE PBUF:="(SWAPTABLE)";                          << WBT >>01940000
            @PBUF:=@PBUF+12;                                   << WBT >>01942000
         END;                                                           01944000
         BEGIN     <<30>>                                               01946000
            MOVE PBUF:="(JOB PROCESS COUNT)";                           01948000
            @PBUF:=@PBUF+20;                                            01950000
         END;                                                           01952000
         BEGIN     <<31>>                                               01954000
            MOVE PBUF:="(JOB MASTER TABLE)";                            01956000
            @PBUF:=@PBUF+19;                                            01958000
           CHARFLAG:=TRUE;                                     <<01.3A>>01960000
         END;                                                           01962000
         BEGIN     <<32>>                                               01964000
            MOVE PBUF:="(TAPE LABEL TABLE)";                   <<01.3A>>01966000
            @PBUF:=@PBUF+19;                                   <<01.3A>>01968000
            CHARFLAG:=TRUE;                                    <<01.3A>>01970000
         END;                                                           01972000
         BEGIN     <<33>>                                               01974000
            MOVE PBUF:="(LOG TABLE)";                          << WBT >>01976000
            @PBUF:=@PBUF+12;                                   << WBT >>01978000
           CHARFLAG:=TRUE;                                     <<01.3A>>01980000
         END;                                                           01982000
         BEGIN     <<34>>                                               01984000
            MOVE PBUF:="(REPLY INFORMATION TABLE)";                     01986000
            @PBUF:=@PBUF+26;                                            01988000
           CHARFLAG:=TRUE;                                     <<01.3A>>01990000
         END;                                                           01992000
         BEGIN     <<35>>                                               01994000
            MOVE PBUF:="(VOLUME TABLE)";                                01996000
            @PBUF:=@PBUF+15;                                            01998000
           CHARFLAG:=TRUE;                                     <<01.3A>>02000000
         END;                                                           02002000
         BEGIN     <<36>>                                               02004000
            MOVE PBUF:="(BREAKPOINT TABLE)";                            02006000
            @PBUF:=@PBUF+19;                                            02008000
         END;                                                           02010000
         BEGIN     <<37>>                                               02012000
            MOVE PBUF:="(LOG BUFFER 1)";                                02014000
            @PBUF:=@PBUF+15;                                            02016000
           CHARFLAG:=TRUE;                                     <<01.3A>>02018000
         END;                                                           02020000
         BEGIN     <<40>>                                               02022000
            MOVE PBUF:="(LOG BUFFER 2)";                                02024000
            @PBUF:=@PBUF+15;                                            02026000
           CHARFLAG:=TRUE;                                     <<01.3A>>02028000
         END;                                                           02030000
         BEGIN     <<41>>                                               02032000
            MOVE PBUF:="(LOG ID TABLE)";                       << WBT >>02034000
            @PBUF:=@PBUF+15;                                   << WBT >>02036000
           CHARFLAG:=TRUE;                                     <<01.3A>>02038000
         END;                                                           02040000
         BEGIN     <<42>>                                               02042000
            MOVE PBUF := "(ASSOCIATION TABLE)";                <<01664>>02044000
            @PBUF := @PBUF + 19;                               <<01664>>02046000
            CHARFLAG := TRUE;                                  <<01664>>02048000
         END;                                                           02050000
         BEGIN     <<43>>                                               02052000
            MOVE PBUF:="(CST BLOCK)";                                   02054000
            @PBUF:=@PBUF+12;                                            02056000
         END;                                                           02058000
         BEGIN     <<44>>                                               02060000
            MOVE PBUF:="(JOB CUTOFF TABLE)";                            02062000
            @PBUF:=@PBUF+19;                                            02064000
         END;                                                           02066000
         BEGIN     <<45>>                                               02068000
            MOVE PBUF:="(SYSTEM JIT)";                                  02070000
            @PBUF:=@PBUF+13;                                            02072000
           CHARFLAG:=TRUE;                                     <<01.3A>>02074000
         END;                                                           02076000
         BEGIN     <<46>>                                               02078000
            MOVE PBUF:="(SPECIAL REQUEST TABLE)";              << WBT >>02080000
            @PBUF:=@PBUF+24;                                   << WBT >>02082000
         END;                                                           02084000
         BEGIN     <<47>>                                               02086000
            MOVE PBUF:="(VIRTUAL DISK SPACE TABLE)";           << WBT >>02088000
            @PBUF:=@PBUF+27;                                   << WBT >>02090000
         END;                                                           02092000
         BEGIN     <<50>>                                               02094000
            MOVE PBUF:="(DEVICE CLASS TABLE)";                 << MCW >>02096000
            @PBUF:=@PBUF+21;                                   << MCW >>02098000
         END;                                                           02100000
         BEGIN     <<51>>                                               02102000
         MOVE PBUF:="(ARSBM TABLE)";                           << WBT >>02104000
         @PBUF:=@PBUF+14;                                      << WBT >>02106000
         END;                                                           02108000
         BEGIN     <<52>>                                               02110000
            MOVE PBUF:="(ILT)";                                <<02012>>02112000
            @PBUF:=@PBUF+6;                                    <<02012>>02114000
         END;                                                           02116000
         BEGIN     <<53>>                                               02118000
            MOVE PBUF:="(SIR TABLE)";                                   02120000
            @PBUF:=@PBUF+12;                                            02122000
         END;                                                           02124000
         BEGIN <<54>>                                          <<01.02>>02126000
         MOVE PBUF:="(FILE MULTI-ACCESS VECTOR)";              <<00221>>02128000
         @PBUF:=@PBUF+27;                                      <<00221>>02130000
           CHARFLAG:=TRUE;                                     <<01.3A>>02132000
         END;                                                  <<01.02>>02134000
         BEGIN <<55>>                                          <<01.02>>02136000
         MOVE PBUF:="(INPUT DEVICE DIRECTORY)";                <<00221>>02138000
         @PBUF:=@PBUF+25;                                      <<00221>>02140000
           CHARFLAG:=TRUE;                                     <<SP.SZ>>02142000
         END;                                                  <<01.02>>02144000
         BEGIN <<56>>                                          <<01.02>>02146000
         MOVE PBUF:="(OUTPUT DEVICE DIRECTORY)";               <<00221>>02148000
         @PBUF:=@PBUF+26;                                      <<00221>>02150000
           CHARFLAG:=TRUE;                                     <<SP.SZ>>02152000
         END;                                                  <<01.02>>02154000
         BEGIN <<57>>                                          <<01.02>>02156000
         MOVE PBUF:="(WELCOME MESSAGE #1)";                    <<00221>>02158000
         @PBUF:=@PBUF+22;                                      <<00221>>02160000
           CHARFLAG:=TRUE;                                     <<01.3A>>02162000
         END;                                                  <<01.02>>02164000
         BEGIN <<60>>                                          <<01.02>>02166000
         MOVE PBUF:="(WELCOME MESSAGE #2)";                    <<00221>>02168000
         @PBUF:=@PBUF+22;                                      <<00221>>02170000
           CHARFLAG:=TRUE;                                     <<01.3A>>02172000
         END;                                                  <<01.02>>02174000
         BEGIN <<61>>                                          <<01.02>>02176000
         MOVE PBUF:="(CS SYSTEM SEGMENT)";                     <<00221>>02178000
         @PBUF:=@PBUF+21;                                      <<00221>>02180000
         END;                                                  <<01.02>>02182000
         BEGIN <<62>>                                          <<01.02>>02184000
         MOVE PBUF:="(JOB-PROCESS CROSS REFERENCE)";           <<00221>>02186000
         @PBUF:=@PBUF+29;                                      <<00221>>02188000
         END;                                                  <<01.02>>02190000
         BEGIN <<63>>                                          <<01.02>>02192000
            MOVE PBUF:="(SYSTEM JDT)";                         <<01.02>>02194000
            @PBUF:=@PBUF+13;                                   <<01.02>>02196000
         END;                                                  <<01.02>>02198000
         BEGIN <<64>>                                          <<01.02>>02200000
         MOVE PBUF:="(COMMAND INTERPRETER LOG-ON DST)";        <<00221>>02202000
         @PBUF:=@PBUF+32;                                      <<00221>>02204000
           CHARFLAG:=TRUE;                                     <<01.3A>>02206000
         END;                                                  <<01.02>>02208000
         BEGIN <<65>>                                          <<01.02>>02210000
            MOVE PBUF:="(MOUNTED VOLUME TAB.)";                <<01.02>>02212000
            @PBUF:=@PBUF+22;                                   <<01.02>>02214000
           CHARFLAG:=TRUE;                                     <<01.3A>>02216000
         END;                                                  <<01.02>>02218000
         BEGIN <<66>>                                          <<01.02>>02220000
            MOVE PBUF:="(PRI. VOL. USER TABLE)";               << WBT >>02222000
            @PBUF:=@PBUF+23;                                   << WBT >>02224000
           CHARFLAG:=TRUE;                                     <<01.3A>>02226000
         END;                                                  <<01.02>>02228000
         BEGIN            <<67>>                               << WBT >>02230000
            MOVE PBUF:="(AVAILABLE REGION LIST)";              << WBT >>02232000
            @PBUF:=@PBUF+24;                                   << WBT >>02234000
         END;                                                  << WBT >>02236000
         BEGIN            <<70>>                               << WBT >>02238000
            MOVE PBUF:="(DISC REQUEST TABLE)";                 << WBT >>02240000
            @PBUF:=@PBUF+21;                                   << WBT >>02242000
         END;                                                  << WBT >>02244000
         BEGIN            <<71>>                               << WBT >>02246000
            MOVE PBUF:="(MSG HBR TABLE)";                      << WBT >>02248000
            @PBUF:=@PBUF+16;                                   << WBT >>02250000
         END;                                                  << WBT >>02252000
         BEGIN            <<72>>                               << WBT >>02254000
            MOVE PBUF:="(IOWAITPORT MAP TABLE)";               << WBT >>02256000
            @PBUF:=@PBUF+23;                                   << WBT >>02258000
         END;                                                  << WBT >>02260000
         BEGIN            <<73>>                               << WBT >>02262000
            MOVE PBUF:="(MEASUREMENT INFO TABLE)";             << WBT >>02264000
            @PBUF:=@PBUF+25;                                   << WBT >>02266000
         END;                                                  << WBT >>02268000
         BEGIN            <<74>>                               << WBT >>02270000
            MOVE PBUF:="(SECONDARY MSG TABLE)";                << WBT >>02272000
            @PBUF:=@PBUF+22;                                   << WBT >>02274000
         END;                                                  << WBT >>02276000
         BEGIN            <<75>>                               << WBT >>02278000
         END;                                                  << WBT >>02280000
         BEGIN            <<76>>                               << WBT >>02282000
         END;                                                  << WBT >>02284000
         BEGIN            <<77>>                               << WBT >>02286000
         END;                                                  << WBT >>02288000
      END;                                                     <<01.02>>02290000
   END<<NAMEDST>>;                                             <<01.02>>02292000
                                                                        02294000
$PAGE "GTCSTIDX: Prepare CST labels for CHKLDMAP"                       02296000
$CONTROL SEGMENT=INIT                                                   02298000
LOGICAL PROCEDURE GTCSTIDX;                                             02300000
COMMENT                                                                 02302000
                                                                        02304000
Purpose:                                                                02306000
     Load global array VCST for use by CHKLDMAP                         02308000
                                                                        02310000
Input parameters: none                                                  02312000
                                                                        02314000
Output parameters: returns true upon successful completion              02316000
                                                                        02318000
Globals Referenced:                                                     02320000
                                                                        02322000
Globals Altered: VCST(1:11)                                             02324000
                                                                        02326000
Data Structures:                                                        02328000
                                                                        02330000
Algorithm:                                                              02332000
     It's really unclear why this isn't just a subroutine of            02334000
     CHKLDMAP, since thats the only thing that calls it.                02336000
     It looks at some low core which somehow characterizes              02338000
     the loadmap of the dump system for comparison with that of         02340000
     the machine DPAN is running on.  This low core info is             02342000
     placed in global array VCST.  It seems to always return            02344000
     a value of TRUE.                                                   02346000
                                                                        02348000
;                                                                       02350000
BEGIN                                                          <<01.3A>>02352000
<<THIS PROCEDURE OBTAINS THE EXTERNAL CST LABEL OF CERTAIN>>   <<01.3A>>02354000
<<SYSTEM PROCESSES AND PLACES THEM IN AN ARRAY FOR LATER USE>> <<01.3A>>02356000
                                                               <<01.3A>>02358000
DOUBLE SCRATCH, PCBFLG;                                       <<< MCW >>02360000
LOGICAL ARRAY SCR0(*)=SCRATCH;                                 <<01.3A>>02362000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<01.3A>>02364000
LOGICAL ARRAY PCBANK(*)=PCBFLG;                                << MCW >>02366000
LOGICAL ARRAY PCBDSP(*)=PCBANK(1);                             << MCW >>02368000
                                                               <<01.3A>>02370000
PCBFLG:=DSTTOADDR(3);                                          << MCW >>02372000
GTCSTIDX:=FALSE;                                               <<01.3A>>02374000
SCRATCH:=PCBFLG;                                               << MCW >>02376000
SCR1:=CORE(%1141D);<<PROGEN LOGICAL PROCESS>>                  <<01.3A>>02378000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02380000
VCST:=(CORE(SCRATCH)&LSR(8));                                  <<01.3A>>02382000
SCR1:=CORE(%1143D);<<UCOP LOGICAL PROCESS>>                    <<01.3A>>02384000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02386000
VCST(1):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02388000
SCR1:=CORE(%1145D);<<DEVREC>>                                  <<01.3A>>02390000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02392000
VCST(2):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02394000
SCR1:=CORE(%1146D);<<MESSAGE LOGICAL PROCESS>>                 <<01.3A>>02396000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02398000
VCST(3):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02400000
SCR1:=CORE(%1150D);<<LOG LOGICAL PROCESS>>                     <<01.3A>>02402000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02404000
VCST(4):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02406000
SCR1:=CORE(%1151D);<<LOAD LOGICAL PROCESS>>                    <<01.3A>>02408000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02410000
VCST(5):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02412000
SCR1:=CORE(%1154D);<<MEMLOGP LOGICAL PROCESS>>                 <<01.3A>>02414000
SCR1:=(SCR1+PCBDSP)+7;                                         << MCW >>02416000
VCST(6):=(CORE(SCRATCH)&LSR(8));                               <<01.3A>>02418000
SCR1:=CORE(%1122D);<<PCREATE EXTERNAL LABEL>>                  <<01.3A>>02420000
VCST(7):=SCR1 LAND %377;                                       <<01.3A>>02422000
SCR1:=CORE(%1155D);<<MORGUE EXTERNAL LABEL(TERMINATE)>>        <<01.3A>>02424000
VCST(8):=SCR1 LAND %377;                                       <<01.3A>>02426000
SCR1:=CORE(%1157D);<<CIINIT EXTERNAL LABEL>>                   <<01.3A>>02428000
VCST(9):=SCR1 LAND %377;                                       <<01.3A>>02430000
SCR1:=CORE(%1162D);<<TRACE1' EXTERNAL LABEL>>                  <<01.3A>>02432000
VCST(10):=SCR1 LAND %377;                                      <<01.3A>>02434000
SCR1:=CORE(%1165D);<<SPOOLING EXTERNAL LABEL>>                 <<01.3A>>02436000
VCST(11):=SCR1 LAND %377;                                      <<01.3A>>02438000
GTCSTIDX:=TRUE;                                                <<01.3A>>02440000
END<<GTCSTIDX>>;                                               <<01.3A>>02442000
                                                                        02444000
$PAGE "CHKLDMAP: Compare dumped system with LOADMAP.PUB.SYS"            02446000
PROCEDURE CHKLDMAP;                                            <<01.3A>>02448000
COMMENT                                                                 02450000
                                                                        02452000
Purpose:                                                                02454000
  This procedure attempts to verify the external labels                 02456000
  obtained from the dump in procedure "GTCSTIDX" with the               02458000
  ascii equivalent in the file "LOADMAP.PUB.SYS" for the                02460000
  current file on this system!                                          02462000
                                                                        02464000
Input parameters:                                                       02466000
                                                                        02468000
Output parameters:                                                      02470000
                                                                        02472000
Globals Referenced:                                                     02474000
                                                                        02476000
Globals Altered:                                                        02478000
     SAME'SYS                                                           02480000
                                                                        02482000
Data Structures:                                                        02484000
     List of tables accessed as well as descriptions of tables          02486000
     used internally.                                                   02488000
                                                                        02490000
Algorithm:                                                              02492000
     Called by TAPE'TO'DISK, to decide if the system DPAN is            02494000
     running on has a LOADMAP that can be used with the dump            02496000
     file.  Compares LOADMAP and VCST array (set up by                  02498000
     SGTCSTID) and sets global SAME'SYS.                                02500000
                                                                        02502000
;                                                                       02504000
BEGIN                                                          <<01.3A>>02506000
                                                               <<01.3A>>02508000
                                                               <<01.3A>>02510000
INTEGER CNT := 6;     <<CHECK ONLY LABLES NOT PROCESSES>>      <<00750>>02512000
LOGICAL TEMP:=4;                                               <<01.3A>>02514000
LOGICAL TEMP1;                                                 <<01.3A>>02516000
ARRAY TMPBUF(0:63);                                            <<01.3A>>02518000
BYTE ARRAY BTMP(*)=TMPBUF;                                     <<01.3A>>02520000
BYTE POINTER BYYT;                                             <<01.3A>>02522000
BYTE ARRAY MPE3(0:20);                                         <<00221>>02524000
                                                               <<01.3A>>02526000
SAME'SYSTEM:=FALSE;  <<UNTIL PROVEN TRUE >>                    <<00221>>02528000
IF NOT GTCSTIDX THEN GO FINI;                                  <<01.3A>>02530000
LDFNUM:=FOPEN(LOADMAP,%3,0);                                   <<03083>>02532000
IF <> THEN GO FINI;                                            <<01.3A>>02534000
FREADDIR(LDFNUM,TMPBUF,-20,4D);                                <<01114>>02536000
IF <> THEN GO TO FINI;                                         <<01114>>02538000
DBUFFER(72) := CORE(VERNO);     <<VERSION ID>>                 <<01114>>02540000
DBUFFER(70) := CORE(UPNO);      <<UPDATE ID >>                 <<01114>>02542000
DBUFFER(71) := CORE(FNO);       << FIX ID   >>                 <<01114>>02544000
IF BTMP( 7) <> BBUF(144),(2) OR                                <<01114>>02546000
   BTMP(10) <> BBUF(140),(2) OR                                <<01114>>02548000
   BTMP(13) <> BBUF(142),(2) THEN GO TO FINI;                  <<01114>>02550000
FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));<<GET RECORD ZERO>>    <<01.3A>>02552000
IF <> THEN GO FINI;                                            <<01.3A>>02554000
SERIES := 1;   << THIS DPAN WILL NEVER WORK FOR     >>         << WBT >>02556000
               << A SERIES ONE DUMP.                >>         << WBT >>02558000
WHILE (CNT:=CNT+1)<=%13 DO                                     <<01.3A>>02560000
BEGIN                                                          <<01.3A>>02562000
  TEMP:=VCST(CNT);                                             <<01.3A>>02564000
  IF SERIES=0 THEN TEMP1:=TEMP ELSE                            <<01.3A>>02566000
  TEMP1:=(TEMP MOD 50)+4;                                      <<01.3A>>02568000
  FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP1));                    <<01.3A>>02570000
  IF <> THEN GO FINI;                                          <<01.3A>>02572000
  IF SERIES=0 THEN TEMP1:=4 ELSE                               <<01.3A>>02574000
  TEMP1:=((TEMP/50)*32)+4;                                     <<01.3A>>02576000
  @BYYT:=LOGICAL(@BTMP)+TEMP1;                                 <<01.3A>>02578000
  CASE (CNT-7) OF                                              <<00750>>02580000
  BEGIN                                                        <<01.3A>>02582000
    <<WITH THE ADVENT OF THE RESEGMENTED VERSION OF MPE>>      <<03754>>02584000
    <<THE NAMES OF ALMOST ALL SEGMENTS WERE CHANGED.   >>      <<03754>>02586000
    <<THE FOLLOWING STATEMENTS HAVE BEEN MODIFIED TO   >>      <<03754>>02588000
    <<CHECK FOR EITHER THE OLD NAMES OR THE NEW NAMES. >>      <<03754>>02590000
    IF BYYT <> "PCREATE" AND                                   <<03754>>02592000
       BYYT <> "PROCSEG'CREATE" THEN RETURN;                   <<03754>>02594000
    IF BYYT <> "MORGUE" AND                                    <<03754>>02596000
       BYYT <> "MOR'RIN'ABDP" THEN RETURN;                     <<03754>>02598000
    IF BYYT <> "CIINIT" AND                                    <<03754>>02600000
       BYYT <> "CI2" THEN RETURN;                              <<03754>>02602000
      ;                                                        << WBT >>02604000
      ;                                                        << WBT >>02606000
  END<<OF CASE>>;                                              <<01.3A>>02608000
END;                                                           <<01.3A>>02610000
SAME'SYS:=TRUE;                                                <<01.3A>>02612000
RETURN;                                                        <<01114>>02614000
                                                               <<01.3A>>02616000
FINI:                                                          <<01.3A>>02618000
FCLOSE(LDFNUM,0,0);                                            <<01114>>02620000
LDFNUM := 0;                                                   <<01114>>02622000
END<<CHKLDMAP>>;                                               <<01.3A>>02624000
                                                                        02626000
$PAGE "CHECKSTACK(DSTNO): Verify stack qualities, print header"         02628000
$CONTROL SEGMENT=UTIL                                                   02630000
COMMENT                                                                 02632000
                                                                        02634000
Purpose                                                                 02636000
     Given a DST number, attempts to verify whether it is      <<03076>>02638000
     indeed a stack, and if so, whether its markers are valid. <<03076>>02640000
     It then prints the basic stack marker information.        <<03076>>02642000
     Two global variables save this information for later      <<03076>>02644000
     use by FORMATSTACK: STACKFLAG for whether it is a stack,  <<03076>>02646000
     and MARKERS'OK for whether the markers seem reasonable.   <<03076>>02648000
     If more than just the markers is to be formatted,         <<03076>>02650000
     FORMATSTACK can be called right after CHECKSTACK.         <<03076>>02652000
                                                                        02654000
Input parameters:                                                       02656000
                                                                        02658000
Output parameters:                                                      02660000
                                                                        02662000
Globals Referenced:                                                     02664000
                                                                        02666000
Globals Altered:                                                        02668000
     STACKFLAG passed to FORMATSTACK                                    02670000
     MARKERS'OK passed to FORMATSTACK                                   02672000
                                                                        02674000
Data Structures:                                                        02676000
                                                                        02678000
Algorithm:                                                              02680000
                                                                        02682000
;                                                                       02684000
                                                               <<03076>>02686000
                                                               <<03076>>02688000
PROCEDURE CHECKSTACK(DSTNO);                                   <<03076>>02690000
VALUE DSTNO;                                                   <<03076>>02692000
LOGICAL DSTNO;                                                 <<03076>>02694000
BEGIN                                                          <<03076>>02696000
                                                               <<03076>>02698000
DOUBLE SCRATCH,SCRATCH2,SCRATCH3,SCRATCH4;                     <<03076>>02700000
LOGICAL INITQ;                                                 <<03076>>02702000
DOUBLE SCRATCH5;                                               <<03076>>02704000
INTEGER DELTQ,WORK3;                                           <<03076>>02706000
LOGICAL WORK1,WORK2,WORK4;                                     <<03076>>02708000
LOGICAL ARRAY SCR0(*)=SCRATCH2;                                <<03076>>02710000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<03076>>02712000
LOGICAL ARRAY SCR2(*)=INITQ;                                   <<03076>>02714000
LOGICAL ARRAY SCR3(*)=SCR2(1);                                 <<03076>>02716000
LOGICAL QI;                                                    <<03076>>02718000
DOUBLE LOCPCB,DSCRATCH,LSTADDR;                                << MCW >>02720000
LOGICAL LSTT,CSTX,CSTXMAP,NUMSEGS,LMAP:=FALSE;                 << MCW >>02722000
                                                               <<03076>>02724000
BLANKBUF;                                                               02726000
STACKFLAG:=FALSE; MARKERS'OK:=FALSE;                           << MCW >>02728000
CHARFLAG:=TRUE;    <<PRINT ASCII IN OCTALDUMP>>                <<03076>>02730000
SCRATCH:=DSTTOADDR(DSTNO);  <<BANK+ADDR OF DST>>               <<03076>>02732000
DSTNB:=DSTNO;                                                  <<03076>>02734000
WORK3:=CORE(4D);   <<GET CURRENT PROCESS>>                     <<03076>>02736000
SCRATCH2:=DOUBLE(WORK3) + PCBDEFIN;                            << MCW >>02738000
WORK4:=CORE(SCRATCH2+3D);  <<CURR PCB DST#>>                   <<03076>>02740000
CDSTN:=WORK4.(2:14);                                           << MCW >>02742000
                                                               <<03076>>02744000
BYPASSA:                                                       <<03076>>02746000
     WORK2:=CORE(DSTDEFIN+DOUBLE(4*DSTNB+1));<<WORD 1 OF DST>> <<03076>>02748000
     IF WORK2.(3:1)=0 THEN GO QUITX;  << STACK BIT >>          <<03076>>02750000
     SKIPLINES(2);                                             <<03076>>02752000
     MOVE BBUF(23):="******    PCBX AND STACK MARKERS FOR";    <<03076>>02754000
     MOVE BBUF(60):="DST      (PCB     )   ******";            <<b8222>>02756000
     @PBUF:=@BBUF+61;                                          <<03076>>02758000
     PUTNUMP(DSTNB);                                           <<03076>>02760000
     WORK3:=0;                                                 <<03076>>02762000
     SCRATCH3:=PCBDEFIN;     <<LOC PCB>>                      <<< MCW >>02764000
     IF SCRATCH3 < 1D THEN GO BIPASS;                          <<03076>>02766000
     WORK2:=CORE(SCRATCH3);     <<# ENTRYS IN PCB>>            <<03076>>02768000
     IF LOGICAL(WORK2) >1025 THEN GO BIPASS;                   << MCW >>02770000
      FOR WORK3:=1 UNTIL (INTEGER (WORK2)) DO                  <<03076>>02772000
      IF NOT ISFREEPCB(WORK3) THEN                             <<03076>>02774000
     BEGIN                                                     <<03076>>02776000
       WORK4:=CORE(SCRATCH3+DOUBLE(WORK3*21+3));               << MCW >>02778000
     WORK4:=WORK4.(2:14);                                      << MCW >>02780000
      IF DSTNB=INTEGER(WORK4) THEN GO BIPASS;                  <<03076>>02782000
     END;                                                      <<03076>>02784000
     GO QUITX;                                                 <<03076>>02786000
BIPASS:                                                        <<03076>>02788000
LSTT:=CORE(SCRATCH3+DOUBLE(WORK3*21+15));                      << MCW >>02790000
CSTX:=CORE(SCRATCH3+DOUBLE(WORK3*21+14));                      << MCW >>02792000
     STACKFLAG:=TRUE;      <<IT IS A STACK>>                   <<03076>>02794000
     @PBUF:=@BBUF+71;                                          <<b8222>>02796000
     PUTNUMP(WORK3);  << PIN# OF DST >>                        <<03076>>02798000
     PRINTLINE;                                                <<03076>>02800000
     IF DSTNB=CDSTN THEN                                       <<03076>>02802000
       BEGIN                                                   <<03076>>02804000
       MOVE BBUF(39):="**** CURRENT  PROCESS ****";            <<03076>>02806000
       INDXARAY((LSTSYSDST+1)*2+1):=PAGENO;                    <<03076>>02808000
       PRINTLINE;                                              <<03076>>02810000
       END;                                                    <<03076>>02812000
     SKIPLINES(2);                                             <<03076>>02814000
                                                               <<03076>>02816000
MOVE BBUF:="SEG REL   SEG REL    JMAT     JPCNT    JOB INPUT"; <<03076>>02818000
     MOVE BBUF(51):="JOB OUTPUT  JDT DST  JIT DST";            <<03076>>02820000
     MOVE BBUF(122):="JCUT";                                   <<03076>>02822000
     PRINTLINE;                                                <<03076>>02824000
MOVE BBUF:="DL        DB         INDEX    INDEX    LOG DEV#";  <<03076>>02826000
     MOVE BBUF(51):="LOG DEV #   INDEX    INDEX    JOB TYPE";  <<03076>>02828000
     MOVE BBUF(92):="DUPLICAT  INTERACT  INIT Q    INDEX";     <<03076>>02830000
     PRINTLINE;                                                <<03076>>02832000
     <<SCRATCH CONTAINS DATA SEGMENT ADDRESS>>                 <<03076>>02834000
     WORK2:=CORE(SCRATCH);     <<SEG REL DL>>                  <<03076>>02836000
     @PBUF:=@BBUF;                                             <<03076>>02838000
     PUTNUM(WORK2);                                            <<03076>>02840000
     WORK2:=CORE(SCRATCH+1D);     <<SEG REL DB>>               <<03076>>02842000
     @PBUF:=@BBUF+10;                                          <<03076>>02844000
     PUTNUM(WORK2);                                            <<03076>>02846000
     DBADR:=DOUBLE(WORK2);<<DB ADDRESS FOR DUMP>>              <<03076>>02848000
     WORK3:=CORE(SCRATCH+3D);                                  << MCW >>02850000
    <<JMAT INDEX>>                    <<03076>>                << MCW >>02852000
     @PBUF:=@BBUF+20;                                          <<03076>>02854000
     PUTNUMP(WORK3);                                           <<03076>>02856000
     WORK2:=CORE(SCRATCH+8D);    <<JOB INPUT LDEV>>            << MCW >>02858000
     @PBUF:=@BBUF+38;                                          <<03076>>02860000
     ASCII(WORK2,-10,BBUF(43));    <<LDEV IN DECIMAL>>         <<03076>>02862000
     WORK3:=CORE(SCRATCH+4D);                                  << MCW >>02864000
       <<JPCNT INDEX>>                   <<03076>>             << MCW >>02866000
     @PBUF:=@BBUF+30;                                          <<03076>>02868000
     PUTNUMP(WORK3);                                           <<03076>>02870000
     WORK2:=CORE(SCRATCH+9D);    <<JOB OUTPUT LDEV>>         <<<< MCW >>02872000
     @PBUF:=@BBUF+51;                                          <<03076>>02874000
     ASCII(WORK2,-10,BBUF(56));   <<LDEV IN DECIMAL>>          <<03076>>02876000
     WORK2:=CORE(SCRATCH+10D);     <<JDT DST INDEX>>          <<< MCW >>02878000
     @PBUF:=@BBUF+62;                                          <<03076>>02880000
     PUTNUMP(WORK2);                                           <<03076>>02882000
     WORK3:=CORE(SCRATCH+11D);                                 << MCW >>02884000
 << JIT DST INDEX. >>              <<03076>>                   << MCW >>02886000
     @PBUF:=@BBUF+72;                                          <<03076>>02888000
     PUTNUMP(WORK3);                                           <<03076>>02890000
     WORK2:=CORE(SCRATCH+6D);                                  << MCW >>02892000
     CASE * WORK2.(2:2) OF     <<TY>>                          <<03076>>02894000
     BEGIN                                                     <<03076>>02896000
       BEGIN     <<0>>                                         <<03076>>02898000
         MOVE BBUF(82):="UNDEF";                               <<03076>>02900000
       END;                                                    <<03076>>02902000
       BEGIN     <<1>>                                         <<03076>>02904000
         MOVE BBUF(82):="#S";                                  <<03076>>02906000
         ASCII(CORE(SCRATCH+%76D).(2:14),10,BBUF(84));         << MCW >>02908000
       END;                                                    <<03076>>02910000
       BEGIN     <<2>>                                         <<03076>>02912000
         MOVE BBUF(82):="#J";                                  <<03076>>02914000
         ASCII(CORE(SCRATCH+%76D).(2:14),10,BBUF(84));         << MCW >>02916000
       END;                                                    <<03076>>02918000
       BEGIN     <<3>>                                         <<03076>>02920000
         MOVE BBUF(82):="TASK";                                <<03076>>02922000
       END;                                                    <<03076>>02924000
     END;                                                      <<03076>>02926000
     IF WORK2.(4:1)=1 THEN MOVE BBUF(95):="YES" ELSE           <<03076>>02928000
     MOVE BBUF(95):="NO";                                      <<03076>>02930000
     IF WORK2.(5:1)=1 THEN MOVE BBUF(104):="YES" ELSE          <<03076>>02932000
     MOVE BBUF(104):="NO";                                     <<03076>>02934000
     WORK2:=CORE(SCRATCH+15D);     <<INITIAL Q>>               << MCW >>02936000
     SCRATCH5:=SCRATCH+DOUBLE(WORK2)+DBADR;  <<ABS INIT Q>>    <<03076>>02938000
     @PBUF:=@BBUF+112;                                         <<03076>>02940000
     PUTNUM(WORK2);                                            <<03076>>02942000
     WORK2:=CORE(SCRATCH+5D);     <<JCUT INDEX>>               << MCW >>02944000
     WORK2:=WORK2.(0:8);                                       <<03076>>02946000
     @PBUF:=@BBUF+121;                                         <<03076>>02948000
     PUTNUMP(WORK2);                                           <<03076>>02950000
     PRINTLINE;                                                <<03076>>02952000
     SKIPLINES(2);                                             <<03076>>02954000
                                                               <<03076>>02956000
MOVE BBUF:="ADDRESS    BANK         X       DELTA P   STATUS"; <<03076>>02958000
         MOVE BBUF(52):="DELTA Q   SEGMENT           PHY SEG"; << MCW >>02960000
     IF PMAPFILE <> 0 THEN                                     <<03076>>02962000
         MOVE BBUF(86):="OFFSET/PROCEDURE         MOD/PRODUCT";<<03076>>02964000
     PRINTLINE;                                                <<03076>>02966000
     SKIPLINES(1);                                             <<03076>>02968000
     MARKERS'OK:=FALSE;    <<ASSUME BAD MARKERS>>              <<03076>>02970000
     WORK2:=CORE(SCRATCH+1D);     <<SET TO PRINT STACK>>       <<03076>>02972000
      IF INTEGER(WORK2) < 1 THEN GO QUIT;                      <<03076>>02974000
     WORK3:=CORE(SCRATCH+13D);                                 << MCW >>02976000
     IF WORK3 <1 THEN GO QUIT;                                 <<03076>>02978000
     <<POINTER TO FIRST DELTA Q>>                              <<03076>>02980000
     SCRATCH2:=SCRATCH+DOUBLE(WORK2)+DOUBLE(WORK3-2);          <<03076>>02982000
     STACKSREG:=SCRATCH2;  <<STACK S REGISTER, SAME AS Q>>     <<03076>>02984000
     IF DSTNB=CDSTN THEN                                       <<03076>>02986000
     BEGIN                << CURRENT STACK >>                  <<03076>>02988000
       QI := CORE(5D);                                         <<03076>>02990000
       IF ZBANKREG = 0 AND                                     <<03076>>02992000
          SREG > QI AND SREG < LOGICAL(CORE(6D)) THEN          <<03076>>02994000
         BEGIN        << ON ICS AT TIME OF DUMP    >>          <<03076>>02996000
          TOS := CORE(DOUBLE(QI) - 5D);  << SBANK FROM ICS >>  <<03076>>02998000
          TOS := CORE(DOUBLE(QI) - 6D) +                       <<03076>>03000000
                 CORE(DOUBLE(QI) - 4D);  << S FROM ICS     >>  <<03076>>03002000
          STACKSREG := TOS;                                    <<03076>>03004000
          SCRATCH2 := STACKSREG - 2D;    << Q := S - 2     >>  <<03076>>03006000
         END                                                   <<03076>>03008000
         ELSE                                                  <<03076>>03010000
          BEGIN       << NOT ON ICS AT TIME OF DUMP >>         <<03076>>03012000
           TOS := ZBANKREG;                                    <<03076>>03014000
           TOS := QREG;                                        <<03076>>03016000
           SCRATCH2 := TOS;                                    <<03076>>03018000
           TOS := ZBANKREG;                                    <<03076>>03020000
           TOS := SREG;                                        <<03076>>03022000
           STACKSREG := TOS;                                   <<03076>>03024000
          END;                                                 <<03076>>03026000
     END;                                                      <<03076>>03028000
     STACKMARKER:=SCRATCH2;   <<REMEMBER TOP MARKER>>          <<03076>>03030000
     INITQ:=CORE(SCRATCH+14D);                                 << MCW >>03032000
                                                               <<03076>>03034000
     WHILE SCRATCH2 > SCRATCH5 DO   <<MARKER ABOVE INIT Q>>    <<03076>>03036000
     BEGIN                                                     <<03076>>03038000
       IF SCRATCH2 < 3D THEN GO QUIT;                          <<03076>>03040000
       @PBUF:=@BBUF;                                           <<03076>>03042000
       TOS:=SCRATCH2;                                          <<03076>>03044000
       WORK2:=TOS;                                             <<03076>>03046000
       WORK3:=TOS;                                             <<03076>>03048000
       PUTNUM(WORK2);     <<ADDRESS>>                          <<03076>>03050000
         @PBUF:=@BBUF + 8; <<DUMP BANK NUMBER>>                <<03076>>03052000
       PUTNUMP(WORK3);     <<BANK>>                            <<03076>>03054000
       WORK2:=CORE(SCRATCH2-3D);     <<X>>                     <<03076>>03056000
       @PBUF:=@BBUF+22;                                        <<03076>>03058000
       PUTNUM(WORK2);                                          <<03076>>03060000
       WORK2:=CORE(SCRATCH2-2D);     <<DELTA P>>               <<03076>>03062000
       IF (WORK2.(1:1)=0) AND (CORE(%1220D)) THEN LMAP:=TRUE   << MCW >>03064000
       ELSE LMAP:=FALSE;                                       << MCW >>03066000
       WORK2:=WORK2 LAND %137777;                              << MCW >>03068000
       WORK3:=WORK2;           <<SAVE THE DELTA P>>            <<03076>>03070000
       @PBUF:=@BBUF+32;                                        <<03076>>03072000
       PUTNUM(WORK2);                                          <<03076>>03074000
       WORK2:=CORE(SCRATCH2-1D);                               <<03076>>03076000
       @PBUF:=@BBUF+42;                                        <<03076>>03078000
       PUTNUM(WORK2);     <<STATUS>>                           <<03076>>03080000
       @PBUF:=@BBUF+60;                                        <<03076>>03082000
       WORK2:=WORK2.(8:8);                                     <<03076>>03084000
       PUTNUMP(WORK2);                                                  03086000
       IF LMAP THEN                                            << MCW >>03088000
         BEGIN                                                 <<03076>>03090000
           BBUF(39):="L";                                               03092000
           DSCRATCH:=DSTTOADDR(%43);                           << MCW >>03094000
           CSTXMAP:=CORE(DSCRATCH+DOUBLE(CSTX));               << MCW >>03096000
           DSCRATCH:=DSTTOADDR(%2);                            << MCW >>03098000
           NUMSEGS:=CORE(DSCRATCH+DOUBLE(CSTXMAP));            << MCW >>03100000
           IF WORK2>NUMSEGS THEN                               << MCW >>03102000
            BEGIN                                              << MCW >>03104000
              LSTADDR:=DSTTOADDR(LSTT);                        << MCW >>03106000
              @PBUF:=@BBUF+80;                                 << MCW >>03108000
              IF LSTADDR<>0D THEN                              << MCW >>03110000
                 PUTNUMP(CORE(LSTADDR+DOUBLE(WORK2*2)))        << MCW >>03112000
              ELSE                                             << MCW >>03114000
                 MOVE BBUF(82):="---";                         << MCW >>03116000
            END                                                << MCW >>03118000
           ELSE                                                << MCW >>03120000
             MOVE PBUF:=" USER SEGMENT";                       << MCW >>03122000
         END                                                   <<03076>>03124000
        ELSE                                                   <<03076>>03126000
          IF NOT(CORE(%1220 D)) AND WORK2>%277 THEN                     03128000
             MOVE PBUF:=" USER SEGMENT"                                 03130000
          ELSE                                                          03132000
            BEGIN                     <<CST SEGMENT>>          <<03076>>03134000
              IF CORE(%1220 D) THEN                                     03136000
                 BBUF(39):="P";                                         03138000
              NAMECST(WORK2);         <<NAME FROM LOADMAP>>    <<03076>>03140000
              NAMEPROC(WORK2,WORK3,86,112,115);  <<NAME IT>>   <<03076>>03142000
            END;                                               <<03076>>03144000
       DELTQ:=CORE(SCRATCH2);                                  <<03076>>03146000
       @PBUF:=@BBUF+52;                                        <<03076>>03148000
       PUTNUM(DELTQ);                                          <<03076>>03150000
       PRINTLINE;                                              <<03076>>03152000
       IF DELTQ < 1 THEN GO QUIT;                              <<03076>>03154000
       SCRATCH2:=SCRATCH2-DOUBLE(DELTQ);                       <<03076>>03156000
     END;                                                      <<03076>>03158000
     IF SCRATCH2 = SCRATCH5 THEN MARKERS'OK:=TRUE;  <<GOOD>>   <<03076>>03160000
     @PBUF:=@BBUF+9;                                           <<03076>>03162000
QUIT:                                                          <<03076>>03164000
     SKIPLINES(2);     <<STACK MARKER PRINTED>>                <<03076>>03166000
     RETURN;                                                   <<03076>>03168000
QUITX:                 <<NOT A STACK, OR NOT PRINTABLE>>       <<03076>>03170000
   END;                                                        <<03076>>03172000
                                                                        03174000
$PAGE "DSTTOADDR(DSTNO): Find address of given DST"                     03176000
$CONTROL SEGMENT=UTIL                                          <<03076>>03178000
DOUBLE PROCEDURE DSTTOADDR(DSTNO);                             <<03076>>03180000
VALUE DSTNO;                                                   <<03076>>03182000
LOGICAL DSTNO;                                                 <<03076>>03184000
COMMENT                                                                 03186000
                                                                        03188000
Purpose:                                                                03190000
     Given a DST # as input, looks it up in the DST table,     <<03076>>03192000
     and returns a doubleword bank+address.                    <<03076>>03194000
     A check is made to see if the requested DST is actually   <<04154>>03196000
     present in memory.  If not, an address of 0 is returned.  <<04154>>03198000
     Condition code is returned as follows:                    <<04154>>03200000
                                                               <<04154>>03202000
        CCE - segment present, address returned                <<04154>>03204000
        CCG - segment absent, address of zero returned         <<04154>>03206000
        CCL - not returned                                     <<04154>>03208000
                                                               <<04154>>03210000
                                                                        03212000
Input parameters:                                                       03214000
                                                                        03216000
Output parameters:                                                      03218000
                                                                        03220000
Globals Referenced:                                                     03222000
                                                                        03224000
Globals Altered:                                                        03226000
                                                                        03228000
Data Structures:                                                        03230000
                                                                        03232000
Algorithm:                                                              03234000
                                                                        03236000
;                                                                       03238000
                                                               <<03076>>03240000
BEGIN                                                          <<03076>>03242000
DOUBLE DSTENTRY;  <<ADR OF DSTNO IN DST TABLE>>                <<03076>>03244000
DOUBLE DSTADDR;   <<ADDR OF DST>>                              <<03076>>03246000
                                                               <<03076>>03248000
CC:=CCE;   <<ASSUME SEGMENT IS PRESENT>>                       <<04154>>03250000
DSTENTRY:=DOUBLE(DSTNO*4+CORE(2D)); <<ENTRY#OFFSET+TABLE BASE>><< MCW >>03252000
IF CORE(DSTENTRY).(0:1) = 1  AND                               <<04154>>03254000
   CORE(DSTENTRY+1D).(1:1)  = 0 THEN BEGIN                     <<04154>>03256000
   <<THE SPECIFIED DST IS NOT IN MEMORY>>                      <<04154>>03258000
   DSTTOADDR:=0D;                                              <<04154>>03260000
   CC:=CCG;                                                    <<04154>>03262000
   RETURN; END;                                                <<04154>>03264000
TOS:=CORE(DSTENTRY+2D);             <<BANKNO OF DST>>          <<03076>>03266000
TOS:=CORE(DSTENTRY+3D);             <<ADDR OF DST>>            <<03076>>03268000
DSTADDR:=TOS;                       << POP BANK+ADDR >>        <<03076>>03270000
DSTTOADDR:=DSTADDR;                 << RETURN VALUE >>         <<03076>>03272000
END;  <<DOUBLE PROCEDURE DSTTOADDR(DSTNO)>>                    <<03076>>03274000
                                                                        03276000
$PAGE "NAMECST(CSTENTRY): use LOADMAP.PUB.SYS to name CSTentry"         03278000
$CONTROL SEGMENT=UTIL                                                   03280000
LOGICAL PROCEDURE NAMECST(CSTENTRY);                           <<01.3A>>03282000
VALUE CSTENTRY;                                                <<01.3A>>03284000
LOGICAL CSTENTRY;                                              <<01.3A>>03286000
COMMENT                                                                 03288000
                                                                        03290000
Purpose:                                                                03292000
     this procedure will name the cst entry                             03294000
     according to the entry in the file                                 03296000
     loadmap.pub.sys.                                                   03298000
     the cst name is returned at pbuf, 17 bytes                         03300000
     There is currently some problem with accessing the loadmap         03302000
     when it is appended to the tape.                                   03304000
                                                                        03306000
Input parameters:                                                       03308000
                                                                        03310000
Output parameters:                                                      03312000
                                                                        03314000
Globals Referenced:                                                     03316000
                                                                        03318000
Globals Altered:                                                        03320000
     NAMECST flags successful naming                                    03322000
     PBUF and @PBUF are buffer for returned name                        03324000
                                                                        03326000
Data Structures:                                                        03328000
                                                                        03330000
Algorithm:                                                              03332000
                                                                        03334000
;                                                                       03336000
BEGIN                                                          <<01.3A>>03338000
                                                               <<01.3A>>03340000
LOGICAL TEMP;                                                  <<01.3A>>03342000
ARRAY TMPBUF(0:63);                                            <<01.3A>>03344000
       BYTE ARRAY BTMPBUF(*)=TMPBUF;                           <<00221>>03346000
DEFINE BTMP=BTMPBUF#; << FOR GSD RECODING >>                   <<00221>>03348000
BYTE POINTER BYYT;                                             <<01.3A>>03350000
                                                               <<01.3A>>03352000
NAMECST:=FALSE;                                                <<01.3A>>03354000
IF SAME'SYS THEN <<DUMPED = THIS SYSTEM>>                      <<01.3A>>03356000
        IF CSTENTRY < %301 THEN    <<IN RANGE SEGMENT>>        <<00221>>03358000
          BEGIN                                                <<00221>>03360000
            IF LMAPFNUM <> 0 THEN                              << WBT >>03362000
  BEGIN                                                        <<01.3A>>03364000
    IF SERIES=0 THEN TEMP:=CSTENTRY ELSE                       <<01.3A>>03366000
    TEMP:=(CSTENTRY MOD 50)+4;                                 <<01.3A>>03368000
    FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));                   <<01.3A>>03370000
    IF <> THEN RETURN;                                         <<01.3A>>03372000
    IF SERIES=0 THEN TEMP:=4 ELSE                              <<01.3A>>03374000
    TEMP:=((CSTENTRY/50)*32)+4;                                <<01.3A>>03376000
    @BYYT:=LOGICAL(@BTMP)+TEMP;                                <<01.3A>>03378000
MOVIT:                                                         <<01.3A>>03380000
                                                               <<01.3A>>03382000
    MOVE PBUF:=BYYT WHILE ANS,0;                               <<01.3A>>03384000
    @BYYT:=TOS;                                                <<01.3A>>03386000
    @PBUF:=TOS;<<SAVE POINTER ADDRESSES>>                      <<01.3A>>03388000
    IF BYYT="'" THEN                                           <<01.3A>>03390000
    BEGIN                                                      <<01.3A>>03392000
      PBUF:="'";                                               <<01.3A>>03394000
      @PBUF:=@PBUF+1;                                          <<01.3A>>03396000
      @BYYT:=@BYYT+1;                                          <<01.3A>>03398000
      GO MOVIT;                                                <<01.3A>>03400000
    END;                                                       <<01.3A>>03402000
    IF BYYT=" (" THEN                                          <<01.3A>>03404000
    BEGIN                                                      <<01.3A>>03406000
      MOVE PBUF:=BYYT,(6);<<MOVE 6 MORE BYTES>>                <<00221>>03408000
      @PBUF:=@PBUF+6;                                          <<00221>>03410000
    END;                                                       <<00221>>03412000
         <<IF PMAPFILE<>0 AND PROCINDEX(CSTENTRY)=0 THEN>>     <<02012>>03414000
         <<PBUF:="?";>>                                        <<02012>>03416000
         @PBUF:=@PBUF+1;                                       << WBT >>03418000
    NAMECST:=TRUE;                                             <<00221>>03420000
              END;                 <<ACCESSING LOADMAP>>       <<00221>>03422000
          END;                                                 <<00221>>03424000
   END;                                                        <<00221>>03426000
                                                                        03428000
$PAGE "NAMEPROC: Name procedure in given segment"                       03430000
$CONTROL SEGMENT=UTIL                                                   03432000
PROCEDURE NAMEPROC(SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL);          <<00221>>03434000
  VALUE SEGMENT,DELTAP,DPCOL,MDCOL,PDCOL;                      <<00221>>03436000
  LOGICAL SEGMENT,DELTAP;                                      <<00221>>03438000
  INTEGER DPCOL,MDCOL,PDCOL;    <<COLUMNS FOR OUTPUT>>         <<00221>>03440000
COMMENT                                                                 03442000
                                                                        03444000
Purpose:                                                                03446000
<<            NAME PROCEDURE                       >>          <<00221>>03448000
<<     THIS PROCEDURE WILL NAME THE PROCEDURE IN   >>          <<00221>>03450000
<<     THE SPECIFIED SEGMENT ALONG WITH THE DELTA  >>          <<00221>>03452000
<<     P, THE SOURCE MODULE NUMBER, AND THE PRODUCT>>          <<00221>>03454000
<<     NUMBER.  THIS INFORMATION IS OBTAINED FROM  >>          <<00221>>03456000
<<     THE FILE MPEPMAP.PUB.SYS.  IF THE FILE IS   >>          <<00221>>03458000
<<     NOT ON THE SYSTEM, NOTHINS IS PRINTED.  IF  >>          <<00221>>03460000
<<     THE FILE IS ON THE SYSTEM, THE HEADER RECORD>>          <<00221>>03462000
<<     THAT CONTAINS THE VERSION AND FIX MUST MATCH>>          <<00221>>03464000
<<     THE VERSION AND FIX ON THE SYSTEM.  ALSO,   >>          <<00221>>03466000
<<     THE SEGMENT LENGTHS MUST MATCH IN THE CST   >>          <<00221>>03468000
<<     AND IN THE FILE.                            >>          <<00221>>03470000
It seems that this code has fallen into disuse since there is           03472000
no rigorous maintainance of the MPEPMAP file from system to             03474000
system. Perhaps this procedure could use the SL instead.                03476000
                                                                        03478000
Input parameters:                                                       03480000
                                                                        03482000
Output parameters:                                                      03484000
                                                                        03486000
Globals Referenced:                                                     03488000
                                                                        03490000
Globals Altered:                                                        03492000
                                                                        03494000
Data Structures:                                                        03496000
                                                                        03498000
Algorithm:                                                              03500000
                                                                        03502000
;                                                                       03504000
                                                               <<00221>>03506000
  BEGIN                        <<NAME THE PROCEDURE>>          <<00221>>03508000
   INTEGER J;                  <<COUNTER>>                     <<00221>>03510000
   LOGICAL I,K,CORRECT;        <<FOR ASSEMBLING RELATIVE P>>   <<00221>>03512000
   LOGICAL ININFLAG;           <<HANDLE SPECIAL ININ>>         <<00221>>03514000
   LOGICAL ARRAY LNLINE(0:39);          <<FOR FREADDIR>>       <<00221>>03516000
   BYTE ARRAY NLINE(*)=LNLINE; <<LINE BUFFER>>                 <<00221>>03518000
   BYTE ARRAY OLINE(*)=LNLINE(20); <<OLD LINE BUFFER>>         <<00221>>03520000
   DOUBLE PMAPREC;             <<RECORD POINTER>>              <<00221>>03522000
   IF PROCINDEX(SEGMENT)+1 > 1 THEN                            <<00221>>03524000
    BEGIN                      <<SEGMENT MAP IS IN THE FILE>>  <<00221>>03526000
     PMAPREC:=DOUBLE(PROCINDEX(SEGMENT))+1D;    <<START SCAN>> <<00221>>03528000
     CORRECT:=0;              <<ASSUME NORMAL SEGMENT>>        <<00221>>03530000
     ININFLAG:= (SEGMENT = 1); <<IS ININ IF SEGMENT#=1>>       <<00221>>03532000
     NLINE:=" "; MOVE NLINE(1):=NLINE,(79);    <<BLANK>>       <<00221>>03534000
     I:=0;                      <<INITIAL FOUND DELTA P>>      <<00221>>03536000
     DO                                                        <<00221>>03538000
      BEGIN                    <<TILL END OF LIST>>            <<00221>>03540000
       K:=I;                   <<REMEMBER VERIFIED BASE ADDR>> <<00221>>03542000
       IF NLINE(18) <> OLINE(18),(6) THEN                      <<00221>>03544000
         MOVE OLINE:=NLINE,(40);       <<SAVE THE CANDIDATE>>  <<00221>>03546000
       FREADDIR(PMAPFILE,LNLINE,-40,PMAPREC);  <<GET REC>>     <<00221>>03548000
       IF <> THEN GO DONE;     <<IF PAST END>>                 <<00221>>03550000
       PMAPREC:=PMAPREC+1D;    <<FOR NEXT RECORD>>             <<00221>>03552000
       I:=0;    J:=0;     <<TEMP P, COUNTER>>                  <<00221>>03554000
       DO                                                      <<00221>>03556000
        BEGIN             <<CONVERT DELTA P TEXT>>             <<00221>>03558000
         I:=(I&LSL(3)) + (LOGICAL(NLINE(18+J)).(13:3));<<CONV> <<00221>>03560000
        END  UNTIL (J:=J+1) = 6;   <<PROC BASE TO I IN BINARY> <<00221>>03562000
       IF ININFLAG THEN        <<SPECIAL IF SEG=ININ>>         <<00221>>03564000
        IF I>0 THEN            <<FIRST SEGMENT IN ININ??>>     <<00221>>03566000
         BEGIN                 <<YES, COMPUTE CORRECTION>>     <<00221>>03568000
          CORRECT:=I;          <<THIS IS FOR PLABELS>>         <<00221>>03570000
          ININFLAG:=FALSE;     <<DISABLE THIS CHECK>>          <<00221>>03572000
         END;                  <<COMPUTE CORRECTION>>          <<00221>>03574000
       I:=I-CORRECT;           <<CORRECT FOR ININ AS NEEDED>>  <<00221>>03576000
      END                                                      <<00221>>03578000
       UNTIL (NLINE <> " " OR I > DELTAP);  <<LARGER ADDRESS>> <<00221>>03580000
DONE:               <<PROCEDURE NAME AND INFO IN OLINE>>       <<00221>>03582000
                                                               <<00221>>03584000
      I:=DELTAP-K;       <<RELATIVE DELTA P IN PROCEDURE>>     <<00221>>03586000
      @PBUF:=@BBUF+DPCOL;     <<WHERE DELTA P GOES>>           <<00221>>03588000
                                                               <<00221>>03590000
      PUTNUMP(I);        <<PUT RELATIVE DELTA P>>              <<00221>>03592000
      MOVE PBUF:=OLINE(1),(16);  <<MOVE THE NAME>>             <<00221>>03594000
      IF MDCOL > 0 THEN MOVE BBUF(MDCOL):=OLINE(32),(2);       <<00221>>03596000
      IF PDCOL > 0 THEN                                        <<00221>>03598000
       BEGIN                 <<DESIRE PRODUCT NAME>>           <<00221>>03600000
        I:=PDCOL+2;           <<PRODUCT NUMBER>>               <<00221>>03602000
        MOVE BBUF(PDCOL):="HP";  <<PREFIX>>                    <<00221>>03604000
        MOVE BBUF(I):=OLINE(34),(6);    <<PRODUCT NUMBER>>     <<00221>>03606000
        IF BBUF(I)="32002" THEN                                <<00221>>03608000
         MOVE BBUF(PDCOL):="MPE    ";       <<WAS MPE>>        <<00221>>03610000
        IF BBUF(I)="30131" THEN                                <<00221>>03612000
         MOVE BBUF(PDCOL):="CS     ";       <<COMMUNICATIONS>> <<00221>>03614000
        IF BBUF(I)="3219"  THEN                                <<00221>>03616000
         MOVE BBUF(PDCOL):="DS3000 ";       <<DISTRIBUTED 3K>> <<00221>>03618000
        IF BBUF(I)="32195" THEN                                <<00221>>03620000
         MOVE BBUF(PDCOL):="DS1000 ";       <<DISTRIBUTED 1K>> <<00221>>03622000
        IF BBUF(I)="32192" THEN                                <<00221>>03624000
         MOVE BBUF(PDCOL):="MRJE   ";       <<HASP MRJE>>      <<00221>>03626000
        IF BBUF(I)="32215" THEN                                <<00221>>03628000
         MOVE BBUF(PDCOL):="IMAGE  ";       <<IMAGE>>          <<00221>>03630000
        IF BBUF(I)="32208" THEN                                <<00221>>03632000
         MOVE BBUF(PDCOL):="KSAM   ";       <<KSAM>>           <<00221>>03634000
       END;                                                    <<00221>>03636000
    END;                                 <<SEGMENT IN MAP>>    <<00221>>03638000
  END;                           <<NAME SEGMENT>>              <<00221>>03640000
                                                                        03642000
$PAGE "VERIFYTBL: Compute base addresses for system DSTs"               03644000
$CONTROL SEGMENT=INIT                                          <<00221>>03646000
COMMENT                                                                 03648000
                                                                        03650000
Purpose:                                                                03652000
<<           COMPUTE BASE ADDRESS FOR SEGMENTS         >>      <<00221>>03654000
<<     THIS PROCEDURE COMPUTES THE BASE ADDRESS FOR    >>      <<00221>>03656000
<<     THE SYSTEM DST SEGMENTS.  THE DST, LOW CORE     >>      <<00221>>03658000
<<     AND SYSTEM GLOBAL LOCATIONS ARE USED TO VERIFY  >>      <<00221>>03660000
<<     THAT THE CORRECT ADDRESS IS ASSUMED.  IF A      >>      <<00221>>03662000
<<     DESCREPENCY EXISTS, A MESSAGE WILL BE PRINTED   >>      <<00221>>03664000
<<     AND A COMBINATION MAJORITY ALGORITHM AND        >>      <<00221>>03666000
<<     VALIDATED TABLE ENTRY SIZE WILL BE USED TO      >>      <<00221>>03668000
<<     SELECT A LIKELY ADDRESS TO BE USED IN PRODUCING >>      <<00221>>03670000
<<     THE DPAN DUMP.                                  >>      <<00221>>03672000
                                                               <<00221>>03674000
<<     THE ARRAY DSTDEF IS UPDATED AND CONTAINS ENCODED>>      <<00221>>03676000
<<      INFORMATION AS FOLLOWS:                        >>      <<00221>>03678000
<<    BIT      MEANING                                 >>      <<00221>>03680000
<<     15    PRESENT AND DEFINED                       >>      <<00221>>03682000
<<     14    ALL POINTERS TO DST AGREE                 >>      <<00221>>03684000
<<     13    DST POINTER OK                            >>      <<00221>>03686000
<<     12    SYSGLOB POINTER OK                        >>      <<00221>>03688000
<<     11    LOW CORE POINTER OK                       >>      <<00221>>03690000
<<     10    ASSUMED LOCATION OK                       >>      <<00221>>03692000
<<      9    **RESERVED**                              >>      <<00221>>03694000
<<      8    TABLE FORMATTED WITH NO ERRORS            >>      <<00221>>03696000
<<      7    ENTRY SIZE VERIFIED AND IS OK             >>      <<00221>>03698000
<<      6    ENTRY SIZE IS WRONG                       >>      <<00221>>03700000
                                                                        03702000
Input parameters:                                                       03704000
                                                                        03706000
Output parameters:                                                      03708000
                                                                        03710000
Globals Referenced:                                                     03712000
                                                                        03714000
Globals Altered:                                                        03716000
                                                                        03718000
Data Structures:                                                        03720000
                                                                        03722000
Algorithm:                                                              03724000
                                                                        03726000
;                                                                       03728000
                                                               <<00221>>03730000
                                                               <<00221>>03732000
PROCEDURE VERIFYTBL;                                           <<00221>>03734000
    BEGIN                  <<PROCEDURE VERIFYTBL>>             <<00221>>03736000
      LOGICAL ARRAY DSTGLOB(0:LSTSYSDST) = PB:=  <<SYSGLOB>>   <<00221>>03738000
          0,1,2,3,0,0,0,0,             <<00-07>>               <<00221>>03740000
          6,0,0,5,%16,%10,0,0,         <<10-17>>               <<00221>>03742000
          %55,0,0,%12,0,0,0,0,         <<20-27>>               << WBT >>03744000
          %15,0,0,0,0,0,0,0,           <<30-37>>               << WBT >>03746000
          0,0,0,%51,%13,0,0,%26,       <<40-47>>               << WBT >>03748000
            0,0,0,%14,0,0,0,0,         <<50-57>>               << MCW >>03750000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>03752000
          %17,0,0,0,0;                 <<70-74>>               <<01924>>03754000
      LOGICAL ARRAY DSTNTRYLOC(0:LSTSYSDST)=PB:= <<SIZE LOCN>> <<00221>>03756000
          0,3,3,3,0,0,0,0,             <<00-07>>               <<00221>>03758000
          3,0,0,3,3,1,0,0,             <<10-17>>               <<00221>>03760000
          0,0,0,3,0,0,0,0,             <<20-27>>               << WBT >>03762000
          0,0,0,0,0,0,0,0,             <<30-37>>               <<00221>>03764000
          0,0,0,0,0,0,0,0,             <<40-47>>               <<00221>>03766000
          0,0,0,0,0,0,0,0,             <<50-57>>               <<00221>>03768000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>03770000
          %3,0,0,0,0;                  <<70-74>>               <<01924>>03772000
      LOGICAL ARRAY DSTNTRYSIZ(0:LSTSYSDST)=PB:=<<ENTRY SIZE>> <<00221>>03774000
          0,4,4,%25,0,0,0,0,           <<00-07>>               << MCW >>03776000
          %201,0,0,%14,%20,%4,0,0,     <<10-17>>               << MCW >>03778000
          0,0,0,4,0,0,0,0,             <<20-27>>               << WBT >>03780000
          0,0,0,0,0,0,0,0,             <<30-37>>               <<00221>>03782000
          0,0,0,0,0,0,0,0,             <<40-47>>               <<00221>>03784000
          0,0,0,0,0,0,0,0,             <<50-57>>               <<00221>>03786000
          0,0,0,0,0,0,0,0,             <<60-67>>               << WBT >>03788000
          %20,0,0,0,0;                     <<70-74>>           << MCW >>03790000
      SWITCH CHKDEF:=DEF0,DEF1,DEF1,DEF2,DEF1,DEF2,DEF2,DEF3,  <<00221>>03792000
                     DEF1,DEF2,DEF2,DEF3,DEF2,DEF3,DEF3;       <<00221>>03794000
      LOGICAL ARRAY GUESSMASK(0:63) = PB:=                     <<00221>>03796000
          0,0,0,0, 1,0,0,0, 2,0,0,0, 1,2,0,0,                  <<00221>>03798000
          4,0,0,0, 1,4,0,0, 2,4,0,0, 1,2,4,0,                  <<00221>>03800000
          8,0,0,0, 1,8,0,0, 2,8,0,0, 1,2,8,0,                  <<00221>>03802000
          4,8,0,0, 1,4,8,0, 2,4,8,0, 1,2,4,8;                  <<00221>>03804000
                                                               <<00221>>03806000
      EQUATE DSTMAXCNT=%12;         <<NUMBER TO CHECK USE ON>> <<00221>>03808000
      ENTRY VERIFYUSE;              <<PRINT OUT UTILIZATION>>  <<00221>>03810000
                                                               <<00221>>03812000
      LOGICAL I,J,K,L,NMAX,DSTNDX,FLAGS,FIRSTFLAG;             << WBT >>03814000
      DOUBLE  ARRAY SCRATCH(0:4);                              <<00221>>03816000
      DOUBLE ARRAY SCRATCH1(*)=SCRATCH(1);                     <<00221>>03818000
      DOUBLE ARRAY SCRATCH2(*)=SCRATCH(2);                     <<00221>>03820000
      DOUBLE ARRAY SCRATCH3(*)=SCRATCH(3);                     <<00221>>03822000
      DOUBLE ARRAY SCRATCH4(*)=SCRATCH(4);                     <<00221>>03824000
      DOUBLE ARRAY SCRATCH0(0:3);     <<WORKING FOR COMPARE>>  <<00221>>03826000
      DOUBLE ARRAY SCRATCHA(*)=SCRATCH0;                       <<00221>>03828000
      DOUBLE ARRAY SCRATCHB(*)=SCRATCH0(1);                    <<00221>>03830000
      DOUBLE ARRAY SCRATCHC(*)=SCRATCH0(2);                    <<00221>>03832000
      LOGICAL ARRAY LSCRATCH(*)=SCRATCH; <<REDEFINE>>          <<00221>>03834000
      LOGICAL ARRAY SCRATCH1H(*)=LSCRATCH(2);  <<BANK OF DST>> <<00221>>03836000
      LOGICAL ARRAY SCRATCH1L(*)=LSCRATCH(3); <<OFFSET>>       <<00221>>03838000
      LOGICAL ARRAY SCRATCH2H(*)=LSCRATCH(4); << BANK >>       << MCW >>03840000
      LOGICAL ARRAY SCRATCH2L(*)=LSCRATCH(5); <<OFFSET>>       << MCW >>03842000
      LOGICAL ARRAY DEFN(0:3);         <<RECORD DEFINITIONS>>  <<00221>>03844000
                                                               <<00221>>03846000
      LOGICAL BAD'DEF;                 <<BAD DEFINITION #>>    <<00221>>03848000
    LOGICAL WORKFLAG, TEMPADD;         <<WORKING DST FLAG>>    << MCW >>03850000
    DOUBLE XADDR;              <<TEMP FOR SPLITTING>>          <<00221>>03852000
    LOGICAL ARRAY BADDR(*)=XADDR;  <<BANK AND OFFSET>>         <<00221>>03854000
                                                               <<00221>>03856000
$PAGE                                                          <<00221>>03858000
SUBROUTINE PUTADDR(DADDR);     <<PUT BANK AND OFFSET ADDRESS>> <<00221>>03860000
  VALUE DADDR;                                                 <<00221>>03862000
  DOUBLE DADDR;                                                <<00221>>03864000
    BEGIN         <<PRINT THE BANK AND OFFSET>>                <<00221>>03866000
     @PBUF:=@PBUF-4;           <<BANK IS ONLY TWO DIGITS>>     <<00221>>03868000
     XADDR:=DADDR;             <<GET THE ADDRESS>>             <<00221>>03870000
     BADDR:=BADDR.(10:6);      <<BANK ADDRESS>>                <<00221>>03872000
     PUTNUMP(BADDR);           <<OUTPUT BANK ADDRESS>>         <<00221>>03874000
     PUTNUM(BADDR(1));         <<OFFSET IN BANK>>              <<00221>>03876000
    END;          <<PRINT BANK AND OFFSET>>                    <<00221>>03878000
$PAGE                                                          <<00221>>03880000
         BEGIN                      <<VERIFYTBL>>              <<00221>>03882000
   <<FIND PAGE SIZE AND START OF LINKED MEMORY>>               << WBT >>03884000
   SYSGLOBX:=DOUBLE(CORE(%1377D)+%1000);                       << WBT >>03886000
   MMPAGESIZE:=DOUBLE(CORE(SYSGLOBX+5D));                      << WBT >>03888000
           FIRSTFLAG:=TRUE;        <<FIRST TIME IF AN ERROR>>  <<00221>>03890000
           DSTNDX:=2;              <<VERIFY DST FIRST>>        <<00221>>03892000
           BAD'DEF:=0;             <<NO BAD ONE NOW>>          <<00221>>03894000
           DO                                                  <<00221>>03896000
            BEGIN                  <<LOAD ADDRESSES FOR ALL>>  <<00221>>03898000
             IF DSTNDX = 2 THEN                                <<00221>>03900000
              BEGIN                <<IS DST, SPECIAL CASE>>    <<00221>>03902000
                             <<ASSUME DST FOLLOWS SYSGLOB EXT>><<01172>>03904000
               SCRATCH4:=DOUBLE(CORE(%1377D))+%1200D;          <<01172>>03906000
               SCRATCH3:=DOUBLE(CORE(2D));  <<FROM LOW CORE>>  <<00221>>03908000
               SCRATCH2:=DOUBLE(CORE(                          <<00221>>03910000
                 DOUBLE(%1000+DSTGLOB(2)))+%1000);<<SYSGLOB>>  <<00221>>03912000
               IF SCRATCH3 = SCRATCH2  THEN                    <<00221>>03914000
                BEGIN              <<ADDRESS IS OK FOR DST>>   <<00221>>03916000
                 SCRATCH:=SCRATCH2;<<REMEMBER GLOBAL>>         <<00221>>03918000
                 SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D)); <<DST> <<00221>>03920000
                 IF SCRATCH1 = SCRATCH3 THEN                   <<00221>>03922000
                   WORKFLAG:=%37   <<SO ALL OK>>               <<00221>>03924000
                 ELSE                                          <<00221>>03926000
                  BEGIN            <<TRY %1400 - - LONG SHOT>> <<00221>>03928000
                   BAD'DEF:=1;      <<DST IS BAD>>             <<00221>>03930000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH4+%13D));      <<01172>>03932000
                   IF SCRATCH1 = SCRATCH4 THEN WORKFLAG:=%45   <<01172>>03934000
                                        ELSE WORKFLAG:=0;      <<00221>>03936000
                  END;             <<TRY %1400 - - LONG SHOT>> <<00221>>03938000
                END                <<ADDRESS IS OK FOR DST>>   <<00221>>03940000
               ELSE                                            <<00221>>03942000
                BEGIN              <<LOW CORE <> SYSGLOB>>     <<00221>>03944000
                  IF SCRATCH3 = SCRATCH4 THEN                  <<01172>>03946000
                  BEGIN          <<GUESS LOW CORE, THEN GLOB>> <<00221>>03948000
                   BAD'DEF:=2;      <<GLOBAL IS BAD>>          <<00221>>03950000
                   SCRATCH:=SCRATCH3;  <<GET FROM LOW CORE>>   <<00221>>03952000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D));      <<00221>>03954000
                   IF SCRATCH1 = SCRATCH3 THEN WORKFLAG:=%25   <<00221>>03956000
                    ELSE                                       <<00221>>03958000
                     BEGIN         <<LAST CHANCE IS SYSGLOB>>  <<00221>>03960000
                      SCRATCH1:=DOUBLE(CORE(SCRATCH2+%13D));   <<00221>>03962000
                      IF SCRATCH1=SCRATCH2 THEN WORKFLAG:=%11  <<00221>>03964000
                                             ELSE WORKFLAG:=0; <<00221>>03966000
                      BAD'DEF:=IF WORKFLAG THEN 3 ELSE 2;      <<00221>>03968000
                     END;          <<LAST CHANCE IS SYSGLOB>>  <<00221>>03970000
                  END            <<GUESS LOW CORE, THEN GLOB>> <<00221>>03972000
                 ELSE                                          <<00221>>03974000
                  BEGIN      <<GUESS SYSGLOB, THEN LOW CORE>>  <<00221>>03976000
                   BAD'DEF:=3;      <<LOW CORE IS BAD>>        <<00221>>03978000
                   SCRATCH:=SCRATCH2;  <<LOAD FROM GLOBAL>>    <<00221>>03980000
                   SCRATCH1:=DOUBLE(CORE(SCRATCH2+%13D));      <<00221>>03982000
                   IF SCRATCH1 = SCRATCH2 THEN WORKFLAG:=%15   <<00221>>03984000
                    ELSE                                       <<00221>>03986000
                     BEGIN         <<LAST CHANCE IS LOW CORE>> <<00221>>03988000
                      SCRATCH1:=DOUBLE(CORE(SCRATCH3+%13D));   <<00221>>03990000
                      IF SCRATCH1=SCRATCH3 THEN WORKFLAG:=%21  <<00221>>03992000
                                             ELSE WORKFLAG:=0; <<00221>>03994000
                     END;          <<LAST CHANCE IS LOW CORE>> <<00221>>03996000
                  END;       <<GUESS SYSGLOB, THEN LOW CORE>>  <<00221>>03998000
                END;               <<LOW CORE <> SYSGLOB>>     <<00221>>04000000
              END                  <<IS DST, SPECIAL CASE>>    <<00221>>04002000
             ELSE                                              <<00221>>04004000
              BEGIN                <<ALL SEGMENTS EXCEPT DST>> <<00221>>04006000
               SCRATCH1:=0D;       <<NOT PRESENT YET>>         <<00221>>04008000
               SCRATCH2:=0D;       <<ASSUME NO SYSDB>>         <<00221>>04010000
               SCRATCH3:=0D;       <<LOW CORE>>                <<00221>>04012000
               SCRATCH4:=0D;       <<ASSUMED VALUE>>           <<00221>>04014000
               SCRATCHA:=0D;                                   <<00221>>04016000
               SCRATCHB:=0D;                                   <<00221>>04018000
               SCRATCHC:=0D;                                   <<00221>>04020000
               IF DSTNDX < %10 THEN                            <<00221>>04022000
                CASE DSTNDX OF                                 <<00221>>04024000
                 BEGIN        <<POSSIBLE LOW CORE OR ASSUMED>> <<00221>>04026000
                  ;    <<0>>                                   <<00221>>04028000
                  SCRATCH3:=DOUBLE(CORE(0D)); <<CST LOW CORE>> <<00221>>04030000
                  ;    <<DST IS SPECIAL CASE>>                 <<00221>>04032000
                  SCRATCH3:=DOUBLE(CORE(3D)); <<PCB LOW CORE>> <<00221>>04034000
                  ;    <<NO HELP FOR CSTX>>                    <<00221>>04036000
                  SCRATCH4:=%1000D;            <<SYSGLOB>>     <<00221>>04038000
                  SCRATCH4:=0D;                <<LOW CORE>>    <<00221>>04040000
                  SCRATCH3:=DOUBLE(CORE(5D))-%100D; <<ICS>>    << WBT >>04042000
                 END;         <<POSSIBLE LOW CORE OR ASSUMED>> <<00221>>04044000
               IF DSTGLOB(DSTNDX) <> 0 THEN                    <<00221>>04046000
                BEGIN                                          << MCW >>04048000
                  TEMPADD:=CORE(%1000D+                        << MCW >>04050000
                       DOUBLE(DSTGLOB(DSTNDX)));               << MCW >>04052000
                  SCRATCH2H:=TEMPADD LAND %37;                 << MCW >>04054000
                  SCRATCH2L:=(TEMPADD LAND %177740) + %1000;   << MCW >>04056000
        IF DSTNDX=16 THEN SCRATCH2:=DOUBLE(TEMPADD+%1000);     << MCW >>04058000
                END;                                           << MCW >>04060000
                                                               <<00221>>04062000
               SCRATCH:=DSTADDR(2)+DOUBLE(DSTNDX*4); <<DST>>   <<00221>>04064000
               IF DSTDEF(2) THEN        <<DEFINED DST>>        <<00221>>04066000
               IF CORE(SCRATCH).(0:1) = 0 LAND                 <<00221>>04068000
                  (CORE(SCRATCH).(1:15) <> 0 LAND              <<00221>>04070000
                   CORE(SCRATCH+3D) <> 0 )    THEN             <<00221>>04072000
               BEGIN          <<DEFINED IN DST>>               <<00221>>04074000
                SCRATCH1H:=CORE(SCRATCH+2D);  <<BANK>>         << WBT >>04076000
                SCRATCH1L:=CORE(SCRATCH+3D);       <<OFFSET>>  <<00221>>04078000
               END;           <<DEFINED IN DST>>               <<00221>>04080000
            <<** CHECK AND VERIFY DST DEFINITION>>             <<00221>>04082000
               J:=0;   I:=1;    <<SCANNERS>>                   <<00221>>04084000
               FLAGS:=0;        <<DEFINITION SOURCES>>         <<00221>>04086000
               DO                                              <<00221>>04088000
               BEGIN        <<CHECK DST, GLOB, LOW, ASSUMED>>  <<00221>>04090000
                FLAGS:=FLAGS&LSR(1);   <<UPDATE BIT MASK>>     <<00221>>04092000
               IF SCRATCH(I)<>0D THEN                          <<00221>>04094000
                BEGIN            <<HAVE A POINTER>>            <<00221>>04096000
                 SCRATCH0(J):=SCRATCH(I);  <<SAVE GUESS>>      <<00221>>04098000
                 DEFN(J):=I;    <<RECORD WHAT GUESS IS>>       <<00221>>04100000
                 J:=J+1;         <<UPDATE FOR NEXT GUESS>>     <<00221>>04102000
                 FLAGS:=FLAGS+%40;  <<REMEMBER THIS IS HERE>>  <<00221>>04104000
                END;             <<HAVE A POINTER>>            <<00221>>04106000
               END UNTIL (I:=I+1)>4;  <<ALL LOOKED AT>>        <<00221>>04108000
                                                               <<00221>>04110000
               IF DSTNDX=6 THEN FLAGS:=%44;                    <<00221>>04112000
                                                               <<00221>>04114000
               I:=DSTNTRYSIZ(DSTNDX);  <<ENTRY SIZE>>          <<00221>>04116000
               J:=DSTNTRYLOC(DSTNDX);  <<ENTRY LOCN>>          <<00221>>04118000
               BAD'DEF:=0;             <<NOT BAD YET>>         <<00221>>04120000
               GOTO CHKDEF(FLAGS&LSR(2));   <<SWITCH>>         <<00221>>04122000
$PAGE                                                          <<00221>>04124000
DEF0:    <<TABLE IS NOT DEFINED ANYWHERE>>                     <<00221>>04126000
              SCRATCH:=0D;       <<DUMMY ADDRESS>>             <<00221>>04128000
              WORKFLAG:=0;       <<NOT DEFINED>>               <<00221>>04130000
              GOTO DEFX;         <<GO CLEAN UP>>               <<00221>>04132000
                                                               <<00221>>04134000
DEF1:    <<TABLE IS DEFINED FROM ONE SOURCE>>                  <<00221>>04136000
              WORKFLAG:=FLAGS + 3; <<DEFINED AND PTRS AGREE>>  <<00221>>04138000
              SCRATCH:=SCRATCHA;     <<REMEMBER DEFINITION>>   <<00221>>04140000
              IF J<>0 THEN                                     <<00221>>04142000
               BEGIN            <<CAN VERIFY ENTRY SIZE>>      <<00221>>04144000
                K:=CORE(SCRATCHA+1D);                          << MCW >>04146000
                WORKFLAG.(6:2):=IF K=I THEN 1 ELSE 2;          <<00221>>04148000
               END;             <<CAN VERIFY ENTRY SIZE>>      <<00221>>04150000
              GOTO DEFX;                                       <<00221>>04152000
                                                               <<00221>>04154000
DEF2:    <<TABLE IS DEFINED IN TWO SOURCES>>                   <<00221>>04156000
              WORKFLAG:=FLAGS;   <<REMEMBER DEFN FIELDS>>      <<00221>>04158000
              IF SCRATCHA=SCRATCHB THEN  <<MATCH??>>           <<00221>>04160000
               BEGIN             <<POINTERS DO AGREE>>         <<00221>>04162000
                WORKFLAG:=WORKFLAG+3;  <<DEFINED AND AGREE>>   <<00221>>04164000
                SCRATCH:=SCRATCHA;     <<REMEMBER VALUE>>      <<00221>>04166000
                IF J<>0 THEN                                   <<00221>>04168000
                 BEGIN           <<CHECK OUT ENTRYSIZE>>       <<00221>>04170000
                  K:=CORE(SCRATCHA+1D);                        << MCW >>04172000
                  WORKFLAG.(6:2):=IF K=I THEN 1 ELSE 2;        <<00221>>04174000
                 END;            <<CHECK OUT ENTRYSIZE>>       <<00221>>04176000
               END               <<POINTERS DO AGREE>>         <<00221>>04178000
              ELSE                                             <<00221>>04180000
               BEGIN             <<POINTERS DISAGREE>>         <<00221>>04182000
                IF J<>0 THEN                                   <<00221>>04184000
                BEGIN            <<TRY BY ENTRY SIZE>>         <<00221>>04186000
                K:=CORE(SCRATCHA+1D);                          << MCW >>04188000
                L:=CORE(SCRATCHB+1D);                          << MCW >>04190000
                IF I=L LOR I=K THEN                            <<00221>>04192000
                 BEGIN           <<THERE IS A CANDIDATE>>      <<00221>>04194000
                  IF I=K THEN                                  <<00221>>04196000
                   BEGIN         <<TAKE FIRST GUESS>>          <<00221>>04198000
                    WORKFLAG.(10:4):=GUESSMASK(FLAGS);         <<00221>>04200000
                    SCRATCH:=SCRATCHA;   <<TAKE GUESS>>        <<00221>>04202000
                    BAD'DEF:=DEFN(1);    <<REMEMBER BAD ONE>>  <<00221>>04204000
                   END           <<TAKE FIRST GUESS>>          <<00221>>04206000
                  ELSE                                         <<00221>>04208000
                   BEGIN         <<TAKE SECOND GUESS>>         <<00221>>04210000
                    WORKFLAG.(10:4):=GUESSMASK(FLAGS+1);       <<00221>>04212000
                    SCRATCH:=SCRATCHB;  <<TAKE GUESS>>         <<00221>>04214000
                    BAD'DEF:=DEFN;     <<REMEMBER BAD ONE>>    <<00221>>04216000
                   END;          <<TAKE SECOND GUESS>>         <<00221>>04218000
                  WORKFLAG.(14:2):=1;   <<DEFINED,DISAGREE>>   <<00221>>04220000
                  WORKFLAG.(6:2):=1;    <<SIZE OK>>            <<00221>>04222000
                 END             <<THERE IS A CANDIDATE>>      <<00221>>04224000
                ELSE                                           <<00221>>04226000
                 BEGIN           <<NO APPARENT CANDIDATE>>     <<00221>>04228000
                  WORKFLAG:=%1000;    <<ENTRY SIZE ERROR>>     <<00221>>04230000
                  SCRATCH:=0D;        <<NO VALUE>>             <<00221>>04232000
                  BAD'DEF:=-1;         <<ALL ARE BAD>>         <<00221>>04234000
                 END;            <<NO APPARENT CANDIDATE>>     <<00221>>04236000
                END              <<TRY BY ENTRY SIZE>>         <<00221>>04238000
               ELSE                                            <<00221>>04240000
                BEGIN            <<NO WAY TO TELL, PUNT>>      <<00221>>04242000
                 WORKFLAG:=%0;   <<NO DEFN, NO VERIFICATION>>  <<00221>>04244000
                 SCRATCH:=0D;    <<VALUE TO RECORD>>           <<00221>>04246000
                 BAD'DEF:=-1;    <<ALL ARE BAD>>               <<00221>>04248000
                END;             <<NO WAY TO TELL, PUNT>>      <<00221>>04250000
               END;              <<POINTERS DISAGREE>>         <<00221>>04252000
             GOTO DEFX;                                        <<00221>>04254000
                                                               <<00221>>04256000
DEF3:    <<TABLE IS DEFINED FROM THREE SOURCES>>               <<00221>>04258000
             WORKFLAG:=FLAGS;                                  <<00221>>04260000
             IF SCRATCHA=SCRATCHB AND SCRATCHB=SCRATCHC THEN   <<00221>>04262000
              BEGIN        <<THEY ALL AGREE>>                  <<00221>>04264000
               WORKFLAG:=WORKFLAG+3;                           <<00221>>04266000
               IF J<>0 THEN                                    <<00221>>04268000
                BEGIN        <<TRY TO VALIDATE ENTRY SIZE>>    <<00221>>04270000
                 K:=CORE(SCRATCHA+1D);                         << MCW >>04272000
                 WORKFLAG.(6:2):=IF I=K THEN 1 ELSE 2;         <<00221>>04274000
                END;         <<TRY TO VALIDATE ENTRY SIZE>>    <<00221>>04276000
               SCRATCH:=SCRATCHA;    <<REMEMBER GUESS>>        <<00221>>04278000
              END          <<THEY ALL AGREE>>                  <<00221>>04280000
             ELSE                                              <<00221>>04282000
              BEGIN        <<TRY A MAJORITY>>                  <<00221>>04284000
               IF   SCRATCHA=SCRATCHB  LOR                     <<00221>>04286000
                    SCRATCHB=SCRATCHC LOR                      <<00221>>04288000
                    SCRATCHA=SCRATCHC  THEN                    <<00221>>04290000
                BEGIN        <<HAVE A MAJORITY, USE IT>>       <<00221>>04292000
                 WORKFLAG:=1;   <<DEFINED>>                    <<00221>>04294000
                 IF SCRATCHA = SCRATCHB LOR                    <<00221>>04296000
                    SCRATCHA = SCRATCHC THEN                   <<00221>>04298000
                  BEGIN      <<USE FIRST GUESS>>               <<00221>>04300000
                   SCRATCH:=SCRATCHA;   <<RECORD GUESS>>       <<00221>>04302000
                   BAD'DEF:=DEFN(1);    <<REMEMBER BAD ONE>>   <<00221>>04304000
                   WORKFLAG.(10:4):=GUESSMASK(FLAGS);          <<00221>>04306000
                  END        <<USE FIRST GUESS>>               <<00221>>04308000
                 ELSE                                          <<00221>>04310000
                  BEGIN      <<USE SECOND GUESS>>              <<00221>>04312000
                   SCRATCH:=SCRATCHB;   <<RECORD GUESS>>       <<00221>>04314000
                   BAD'DEF:=DEFN;       <<REMEMBER BAD ONE>>   <<00221>>04316000
                   WORKFLAG.(10:4):=GUESSMASK(FLAGS+1);        <<00221>>04318000
                  END;       <<USE SECOND GUESS>>              <<00221>>04320000
                 IF J<>0 THEN                                  <<00221>>04322000
                  BEGIN      <<VALIDATE ENTRY SIZE>>           <<00221>>04324000
                   K:=CORE(SCRATCH+1D);                        << MCW >>04326000
                   WORKFLAG.(6:2):=IF I=K THEN 1 ELSE 2;       <<00221>>04328000
                  END;       <<VALIDATE ENTRY SIZE>>           <<00221>>04330000
                END          <<HAVE A MAJORITY, USE IT>>       <<00221>>04332000
               ELSE                                            <<00221>>04334000
                BEGIN        <<THREE DIFFERENT VALUES>>        <<00221>>04336000
                 WORKFLAG:=0;                                  <<00221>>04338000
                 SCRATCH:=0D;                                  <<00221>>04340000
                 BAD'DEF:=-1;    <<ALL ARE BAD>>               <<00221>>04342000
                END;         <<THREE DIFFERENT VALUES>>        <<00221>>04344000
              END;           <<TRY A MAJORITY>>                <<00221>>04346000
              GOTO DEFX;                                       <<00221>>04348000
                                                               <<00221>>04350000
DEFX:                                                          <<00221>>04352000
              END;                 <<ALL SEGMENTS EXCEPT DST>> <<00221>>04354000
             DSTADDR(DSTNDX):=SCRATCH;                         <<00221>>04356000
             DSTDEF(DSTNDX):=WORKFLAG;    <<SAVE FOR REF>>     <<00221>>04358000
         IF DSTNDX=2 THEN                                      <<01791>>04360000
           BEGIN TOS:=SCRATCH; DSTFLG:=TOS; DEL; END;          <<01791>>04362000
             IF BAD'DEF <> 0 THEN                              <<00221>>04364000
              BEGIN           <<ERROR ON DST>>                 <<00221>>04366000
               IF 1 <= INTEGER(DSTNDX) <= 3 THEN               <<01080>>04368000
                 BAD'DST(DSTNDX-1) := TRUE;                    <<01080>>04370000
               IF FIRSTFLAG THEN                               <<00221>>04372000
                BEGIN         <<FIRST BAD ONE, PRINT HEADER>>  <<00221>>04374000
                 FIRSTFLAG:=FALSE;                             <<00221>>04376000
                 NEWPAGE;     <<NEW PAGE>>                     <<00221>>04378000
                 MOVE BBUF(40):=                               <<00221>>04380000
               "****** SYSTEM TABLE DEFINITION ERRORS ******"; <<00221>>04382000
                 PRINTLINE;                                    <<00221>>04384000
                 SKIPLINES(2);                                 <<00221>>04386000
                 MOVE BBUF:="DST     DST DEFINITION";          <<00221>>04388000
       MOVE BBUF(45):="  (DST)    ";   <<DST DEFINITION>>      <<00221>>04390000
       MOVE BBUF(57):="(SYS GLOB) ";   <<SYS GLOB DEFN>>       <<00221>>04392000
       MOVE BBUF(69):="(LOW CORE) ";   <<LOW CORE DEFN>>       <<00221>>04394000
       MOVE BBUF(81):=" (ASSUMED) ";   <<ASSUMED VALUE>>       <<00221>>04396000
       MOVE BBUF(92):="(DEFINITION)   SOURCE OF ERROR";        <<00221>>04398000
                 PRINTLINE;                                    <<00221>>04400000
                 SKIPLINES(1);                                 <<00221>>04402000
                END;          <<FIRST BAD ONE, PRINT HEADER>>  <<00221>>04404000
               @PBUF:=@BBUF-3;                                 <<00221>>04406000
               PUTNUMP(DSTNDX);                                <<00221>>04408000
               @PBUF:=@PBUF+3;                                 <<00221>>04410000
               MEMBUFP:=DSTNDX;     <<SAVE FOR FORMATTING>>    <<00221>>04412000
NAMEDST; <<NAME THE SEGMENT TABLE>>                            <<00221>>04414000
               @PBUF:=@BBUF+45;                                <<00221>>04416000
               IF SCRATCH1<>0D THEN PUTADDR(SCRATCH1);         <<00221>>04418000
               @PBUF:=@BBUF+57;                                <<00221>>04420000
               IF SCRATCH2<>0D THEN PUTADDR(SCRATCH2);         <<00221>>04422000
               @PBUF:=@BBUF+69;                                <<00221>>04424000
               IF SCRATCH3<>0D THEN PUTADDR(SCRATCH3);         <<00221>>04426000
               @PBUF:=@BBUF+81;                                <<00221>>04428000
               IF SCRATCH4<>0D THEN PUTADDR(SCRATCH4);         <<00221>>04430000
               @PBUF:=@BBUF+93;                                <<00221>>04432000
               IF SCRATCH<>0D LAND WORKFLAG THEN               <<00221>>04434000
                 PUTADDR(SCRATCH);                             <<00221>>04436000
               @PBUF:=@BBUF+105;   <<USE LOCATIONS>>           <<00221>>04438000
               CASE BAD'DEF+1 OF                               <<00221>>04440000
                BEGIN            <<TELL WHAT IS USED>>         <<00221>>04442000
                 MOVE PBUF:="** CANNOT DEFINE TABLE **";       <<00221>>04444000
                 ;     <<0>>                                   <<00221>>04446000
                 MOVE PBUF:="BAD VALUE FROM DST";              <<00221>>04448000
                 MOVE PBUF:="BAD VALUE FROM SYS GLOBAL";       <<00221>>04450000
                 MOVE PBUF:="BAD VALUE FROM LOW CORE";         <<00221>>04452000
                 MOVE PBUF:="BAD ASSUMED ADDRESS VALUE";       <<00221>>04454000
                END;             <<TELL WHAT IS USED>>         <<00221>>04456000
               IF WORKFLAG.(15:1)=0 THEN                       <<00221>>04458000
                MOVE PBUF:="TABLE CANNOT BE DEFINED   ";       <<00221>>04460000
               PRINTLINE;        <<PRINT THE LINE>>            <<00221>>04462000
              END;               <<ERROR IN DEFINITION>>       <<00221>>04464000
                                                               <<00221>>04466000
                                                               <<00221>>04468000
             CASE DSTNDX OF                                    <<00221>>04470000
              BEGIN       <<SPECIAL BEGINNING SEQUENCE>>       <<00221>>04472000
               ;    <<0>>                                      <<00221>>04474000
               DSTNDX:=2;      <<1  NEXT INDEX IS 3>>          <<00221>>04476000
               DSTNDX:=0;      <<2  NEXT INDEX IS 1>>          <<00221>>04478000
              END;        <<SPECIAL BEGINNING SEQUENCE>>       <<00221>>04480000
                                                               <<00221>>04482000
            END                    <<LOAD ADDRESSES FOR ALL>>  <<00221>>04484000
             UNTIL (DSTNDX:=DSTNDX+1)>LSTSYSDST;               <<00221>>04486000
         END;                       <<VERIFYTBL>>              <<00221>>04488000
VERIFYUSE:                                                     <<00221>>04490000
    END;                   <<PROCEDURE VERIFYTBL>>             <<00221>>04492000
                                                                        04494000
$PAGE "CORE: Retrieve data from core dump file"                         04496000
$CONTROL SEGMENT=UTIL                                                   04498000
COMMENT                                                                 04500000
                                                                        04502000
Purpose:                                                                04504000
<<     THIS PROCEDURE RETURNS THE CONTENTS OF CORE LOCATION ADR.   >>   04506000
<<     IF THE BLOCK OF DATA IS NOT PRESENT A CALL IS MADE TO THE   >>   04508000
<<     FILE SYSTEM TO REPLACE THE 4096 WORD BLOCK WITH THE ONE     >>   04510000
<<     CONTAINING THE SPECIFIED ADR.                               >>   04512000
                                                               <<00221>>04514000
<<    THE MEMORY SWAP LOG FILE THAT IS WRITTEN OUT WITH    >>  <<00221>>04516000
<<     EACH SWAP HAS THE FOLLOWING FORMAT:                 >>  <<00221>>04518000
<<       1-10 SWAP TAG (NUMBERED FROM 1 UPWARDS)           >>  <<00221>>04520000
<<      11-12 BANK NUMBER OF THE LOCATION REQUESTED        >>  <<00221>>04522000
<<         13  BLANK                                       >>  <<00221>>04524000
<<      14-19 MEMORY LOCATION REQUESTED                    >>  <<00221>>04526000
<<         20  BLANK                                       >>  <<00221>>04528000
<<      21-22 BLOCK REQUESTED                              >>  <<00221>>04530000
<<         23  BLANK                                       >>  <<00221>>04532000
<<      24-25 BLOCK PRESENT                                >>  <<00221>>04534000
<<         26  BLANK                                       >>  <<00221>>04536000
<<      27-36 NUMBER OF FETCHES FROM PREVIOUS BLOCK        >>  <<00221>>04538000
<<      37-38  BLANK                                       >>  <<00221>>04540000
<<      39-40 DPAN SEGMENT NUMBER THAT REQUESTED LOCATION  >>  <<00221>>04542000
<<         41 "."                                          >>  <<00221>>04544000
<<      42-47 DPAN DELTA P WITHIN A SEGMENT                >>  <<00221>>04546000
<<         48  BLANK                                       >>  <<00221>>04548000
<<      49-50 ACTIVITY TAG.  USER DEFINED WITHIN DPAN.     >>  <<00221>>04550000
                                                                        04552000
Input parameters:                                                       04554000
                                                                        04556000
Output parameters:                                                      04558000
                                                                        04560000
Globals Referenced:                                                     04562000
                                                                        04564000
Globals Altered:                                                        04566000
                                                                        04568000
Data Structures:                                                        04570000
                                                                        04572000
Algorithm:                                                              04574000
                                                                        04576000
;                                                                       04578000
                                                               <<00221>>04580000
LOGICAL PROCEDURE CORE(ADR);                                  <<<01.02>>04582000
       VALUE ADR;                                                       04584000
       DOUBLE ADR;                                                      04586000
       BEGIN                                                            04588000
         INTEGER SNDX;      <<FOR SWAP MONTORING>>             <<00221>>04590000
         LOGICAL DLTAP=Q-2; <<FOR ERROR>>                      <<00221>>04592000
         LOGICAL STAT=Q-1;  <<FOR ERROR>>                      <<00221>>04594000
         LOGICAL XSAVE,SSAVE;<<FOR SAVING XREG,BANK>>          <<00221>>04596000
          INTEGER LOC=X;                                                04598000
          OWN INTEGER S:=-1;                                            04600000
          INTEGER BANKNUMBER=ADR;                              <<00.01>>04602000
                                                               <<*9003>>04604000
          IF ADR>MAXMEM THEN                                            04606000
          BEGIN                                                         04608000
BADSTUF:                                                                04610000
            MOVE BBUF:="PGM ERROR INVALID ADDRESS  XXXXXX";             04612000
            @PBUF:=@BBUF+27;                                            04614000
            PUTDNUM(ADR);                                               04616000
            MOVE PBUF:="    DPAN DELTA P=";                    <<00221>>04618000
            @PBUF:=@PBUF+18;                                   <<00221>>04620000
            PUTNUM(DLTAP);                                     <<00221>>04622000
            MOVE PBUF:="    DPAN SEGMENT=";                    <<00221>>04624000
            @PBUF:=@PBUF+18;                                   <<00221>>04626000
            PUTNUM(STAT.(10:6)-1);                             <<00221>>04628000
           IF SERIES'33'THRU'MM THEN PRINTLINE;                <<s7922>>04630000
            CORE:=0;                                                    04632000
            GO BOUT;                                                    04634000
          END;                                                          04636000
          IF ADR < 0D THEN GO BADSTUF;                                  04638000
          TOS:=ADR;                                                     04640000
          LOC:=S0.(4:12);                                               04642000
          TOS:=TOS&DLSR(12);                                            04644000
          DELB;                                                         04646000
          IF S0<>S THEN << NOT PRESENT READ IT IN >>                    04648000
             BEGIN                                                      04650000
                SSAVE:=S;       <<SAVE OLD BLOCK NUMBER>>      <<00221>>04652000
                S:=TOS;                                                 04654000
                SNDX:=S;       <<FOR SWAP MONITORING>>         <<00221>>04656000
                FREADDIR(COREF,COREBUF,4096,DOUBLE(S));                 04658000
                IF <> THEN                                              04660000
                BEGIN                                                   04662000
                   MOVE DBUFFER:="CC <> ON FREAD TO DISK";              04664000
                   PRINTLINE;                                           04666000
                   PRINT'FILE'INFO(COREF);                              04668000
                   ERROR;                                               04670000
                END;                                                    04672000
              XSAVE:=LOC;    <<SAVE OFFSET>>                   <<00221>>04674000
              IF DPANSWAP <> 0 THEN                            <<00221>>04676000
               BEGIN                <<MONITORING SWAPS>>       <<00221>>04678000
                MSWLIN:=" ";  MOVE MSWLIN(1):=MSWLIN,(49);     <<00221>>04680000
                MSWAPS:=MSWAPS+1;  <<NEXT TAG>>                <<00221>>04682000
                ASCII(MSWAPS,-10,MSWLIN(9));                   <<00221>>04684000
                 ASCII(BANKNUMBER,-10,MSWLIN(11));             <<*9003>>04686000
                ASCII(SSAVE,-10,MSWLIN(24));                   <<00221>>04688000
                ASCII(SNDX,-10,MSWLIN(21));                    <<00221>>04690000
                ASCII(XSAVE,8,MSWLIN(13));                     <<00221>>04692000
                ASCII(STAT.(10:6)-1,8,MSWLIN(34));  <<STATUS>> <<00221>>04694000
                MOVE MSWLIN(34):="    ";                       <<00221>>04696000
                DASCII(MFETCH,8,MSWLIN(25));                   <<00221>>04698000
                MSWLIN(25):=" ";                               <<00221>>04700000
                ASCII(DLTAP,8,MSWLIN(41));                     <<00221>>04702000
                ASCII(MACTAG,10,MSWLIN(49));                   <<00221>>04704000
                FWRITE(DPANSWAP,LMSWLIN,-50,0);                <<00221>>04706000
                MFETCH:=0D;             <<NUMBER OF FETCHES>>  <<00221>>04708000
               END;                 <<SWAP IS MONITORED>>      <<00221>>04710000
              LOC:=XSAVE;    <<RESTORE OFFSET>>                <<00221>>04712000
             END;                                                       04714000
              MFETCH:=MFETCH+1D;     <<ANOTHER FETCH DONE>>    <<00221>>04716000
          CORE:=COREBUF(LOC);                                           04718000
BOUT:                                                                   04720000
      END;                                                              04722000
                                                                        04724000
$PAGE "DCORE: Look up and return doubleword from core"                  04726000
$CONTROL SEGMENT=UTIL                                                   04728000
COMMENT                                                                 04730000
                                                                        04732000
Purpose:                                                                04734000
     Simplify access to core dump file.  See also CORE.                 04736000
                                                                        04738000
Input parameters:                                                       04740000
                                                                        04742000
Output parameters:                                                      04744000
                                                                        04746000
Globals Referenced:                                                     04748000
                                                                        04750000
Globals Altered:                                                        04752000
                                                                        04754000
Data Structures:                                                        04756000
                                                                        04758000
Algorithm:                                                              04760000
                                                                        04762000
;                                                                       04764000
DOUBLE PROCEDURE DCORE(ADR);                                   << WBT >>04766000
VALUE ADR; DOUBLE ADR;                                         << WBT >>04768000
BEGIN                                                          << WBT >>04770000
   TOS:=CORE(ADR);                                             << WBT >>04772000
   TOS:=CORE(ADR+1D);                                          << WBT >>04774000
   DCORE:=TOS;                                                 << WBT >>04776000
END;                                                           << WBT >>04778000
                                                                        04780000
$PAGE "SYSGLOB(ADR): Return sysglob relative core dump data"            04782000
$CONTROL SEGMENT=UTIL                                                   04784000
LOGICAL PROCEDURE SYSGLOB(ADR);                                << WBT >>04786000
COMMENT                                                                 04788000
                                                                        04790000
Purpose:                                                                04792000
     Simplify access to core dump data.  See also CORE.                 04794000
                                                                        04796000
Input parameters:                                                       04798000
                                                                        04800000
Output parameters:                                                      04802000
                                                                        04804000
Globals Referenced:                                                     04806000
                                                                        04808000
Globals Altered:                                                        04810000
                                                                        04812000
Data Structures:                                                        04814000
                                                                        04816000
Algorithm:                                                              04818000
                                                                        04820000
;                                                                       04822000
   VALUE ADR; LOGICAL ADR;                                     << WBT >>04824000
   BEGIN                                                       << WBT >>04826000
      ENTRY SYSDB;                                             << WBT >>04828000
      SYSDB:                                                   << WBT >>04830000
      SYSGLOB:=CORE(DOUBLE(%1000+ADR));                        << WBT >>04832000
   END;                                                        << WBT >>04834000
                                                                        04836000
$PAGE "ONFREELIST(TABLEBASE,INDEX): is entry on free list?"             04838000
$CONTROL SEGMENT=UTIL                                                   04840000
COMMENT                                                                 04842000
                                                                        04844000
Purpose:                                                                04846000
                                                               << WBT >>04848000
THIS PROCEDURE DETERMINES WHETHER A TABLE ENTRY IS             << WBT >>04850000
ON THE FREE ENTRY LIST OF THE TABLE.  INDEX IS THE             << WBT >>04852000
INDEX OF THE ENTRY IN QUESTION, AND TABLEBASE IS THE           << WBT >>04854000
TABLE BASE                                                     << WBT >>04856000
     Used by PRINTCST and INTERACTIVE'DIALOG                            04858000
                                                                        04860000
Input parameters:                                                       04862000
                                                                        04864000
Output parameters:                                                      04866000
                                                                        04868000
Globals Referenced:                                                     04870000
                                                                        04872000
Globals Altered:                                                        04874000
                                                                        04876000
Data Structures:                                                        04878000
                                                                        04880000
Algorithm:                                                              04882000
                                                                        04884000
;                                                                       04886000
LOGICAL PROCEDURE ONFREELIST(TABLEBASE, INDEX);                << WBT >>04888000
                                                               << WBT >>04890000
VALUE TABLEBASE, INDEX;                                        << WBT >>04892000
DOUBLE TABLEBASE;                                              << WBT >>04894000
LOGICAL INDEX;                                                 << WBT >>04896000
                                                               << WBT >>04898000
BEGIN                                                          << WBT >>04900000
                                                               << WBT >>04902000
   LOGICAL LISTLENGTH, FREEX;                                  << WBT >>04904000
                                                               << WBT >>04906000
   ONFREELIST := TRUE;                                         << WBT >>04908000
   LISTLENGTH := NUMFREE;                                      << WBT >>04910000
   IF LISTLENGTH > NUMCONFIG THEN LISTLENGTH := NUMCONFIG;     << WBT >>04912000
                                                               << WBT >>04914000
   FREEX := FIRSTFREEX;                                        << WBT >>04916000
   WHILE LISTLENGTH>0 AND FREEX<>0 DO                          << WBT >>04918000
      BEGIN                                                    << WBT >>04920000
      IF FREEX=INDEX THEN RETURN;                              << WBT >>04922000
      FREEX:=NEXTFREEX;                                        << WBT >>04924000
      LISTLENGTH:=LISTLENGTH-1;                                << WBT >>04926000
      END;                                                     << WBT >>04928000
                                                               << WBT >>04930000
   ONFREELIST := FALSE;                                        << WBT >>04932000
   END;                                                        << WBT >>04934000
                                                                        04936000
$PAGE "VERIFYP: Verify agreement of system DB and DST pointers"         04938000
$CONTROL SEGMENT=UTIL                                                   04940000
COMMENT                                                                 04942000
                                                                        04944000
Purpose:                                                                04946000
<<             VERIFY DST/SYSDB POINTER                          >>     04948000
<<    THIS PROCEDURE WILL VERIFY THAT THE SYSTEM DB AND DST      >>     04950000
<<    POINTERS AGREE.                                             >>    04952000
<<IF THEY DO NOT AGREE, THEN A SERIES OF RANGE TESTS ARE>>     <<01.02>>04954000
<<PERFORMED SUCH THAT THE MOST LIKELY ABSOLUTE ADDRESS>>       <<01.02>>04956000
<<IS PASSED BACK AS THE VALUE TO USE FOR THE TABLE. IF >>      <<01.02>>04958000
<<NONE CAN BE FOUND, THEN A ZERO WILL BE RETURNED.>>           <<01.02>>04960000
<<THE CONDITION CODES PASSED BACK ARE AS FOLLOWS: >>           <<01.02>>04962000
<<   CCL=ABS. VALUE RETURNED IS FROM SYSGLOB      >>           <<01.02>>04964000
<<   CCG=ABS. VALUE RETURNED IS FROM DST TABLE    >>           <<01.02>>04966000
<<   CCE=ABS. VALUE IS A GOOD COMPARE AND ABS. SYSDB VALUE>>   <<01.02>>04968000
<<            IS BEING RETURNED.                      >>       <<01.02>>04970000
<<NOTE: IF CCL/CCG IS RETURNED, A DOUBLE ZERO MAY ALSO>>       <<01.02>>04972000
<<BE RETURNED...THUS YOU MUST CHECK THE CC AND THE VALUE>>     <<01.02>>04974000
                                                                        04976000
Input parameters:                                                       04978000
                                                                        04980000
Output parameters:                                                      04982000
                                                                        04984000
Globals Referenced:                                                     04986000
                                                                        04988000
Globals Altered:                                                        04990000
                                                                        04992000
Data Structures:                                                        04994000
                                                                        04996000
Algorithm:                                                              04998000
                                                                        05000000
;                                                                       05002000
DOUBLE PROCEDURE VERIFYP(DSTNO,SYSDBP);                        <<01.02>>05004000
VALUE DSTNO,SYSDBP;                                            <<01.02>>05006000
DOUBLE SYSDBP;                                                 <<01.02>>05008000
INTEGER DSTNO;                                                 <<01.02>>05010000
BEGIN                                                          <<01.02>>05012000
  IF DSTDEF(DSTNO) THEN                                        <<00221>>05014000
   BEGIN                  <<TABLE IS DEFINED>>                 <<00221>>05016000
    VERIFYP:=DSTADDR(DSTNO);   <<RETURN VALUE>>                <<00221>>05018000
    IF DSTDEF(DSTNO).(14:1) THEN CC:=CCE  <<ALL AGREE>>        <<00221>>05020000
                            ELSE CC:=CCL; <<DISAGREE>>         <<00221>>05022000
   END                    <<TABLE IS DEFINED>>                 <<00221>>05024000
                                                               <<00221>>05026000
  ELSE                                                         <<00221>>05028000
   BEGIN                  <<NOT DEFINED>>                      <<00221>>05030000
    VERIFYP:=0D;    <<RETURN A ZERO>>                          <<00221>>05032000
    CC:=CCG;                                                   <<00221>>05034000
   END;                   <<NOT DEFINED>>                      <<00221>>05036000
                                                               <<00221>>05038000
END;                     <<VERIFYP>>                           <<00221>>05040000
                                                                        05042000
$PAGE "WARNING: Print warning message"                                  05044000
$CONTROL SEGMENT=UTIL                                                   05046000
COMMENT                                                                 05048000
                                                                        05050000
Purpose:                                                                05052000
<<THIS PROCEDURE PRINTS A WARNING OF TWO FORMS>>               <<01.02>>05054000
                                                                        05056000
Input parameters:                                                       05058000
                                                                        05060000
Output parameters:                                                      05062000
                                                                        05064000
Globals Referenced:                                                     05066000
                                                                        05068000
Globals Altered:                                                        05070000
                                                                        05072000
Data Structures:                                                        05074000
                                                                        05076000
Algorithm:                                                              05078000
                                                                        05080000
;                                                                       05082000
PROCEDURE WARNING;                                             <<01.02>>05084000
BEGIN                                                          <<01.02>>05086000
                                                               <<01.02>>05088000
LOGICAL FLAG:=FALSE;                                           <<01.02>>05090000
ENTRY NOFORMT';                                                <<00221>>05092000
                                                               <<01.02>>05094000
<<BEGIN BODY OF PROCEDURE>>                                    <<01.02>>05096000
IF FLAG THEN                                                   <<01.02>>05098000
NOFORMT':                                                      <<00221>>05100000
   FLAG:=TRUE;                                                 <<01.02>>05102000
SKIPLINES(1);                                                  <<01.02>>05104000
MOVE DBUFFER:="**** WARNING! ";                                <<01.02>>05106000
IF FLAG THEN                                                   <<01.02>>05108000
BEGIN                                                          <<01.02>>05110000
   MOVE DBUFFER(7):=                                           <<01.02>>05112000
"UNABLE TO FORMAT TABLE. ADDRESS POINTERS INVALID ****";       <<03752>>05114000
END ELSE                                                       <<01.02>>05116000
BEGIN                                                          <<01.02>>05118000
   MOVE DBUFFER(7):=                                           <<01.02>>05120000
"ADDRESS POINTERS DO NOT AGREE. ATTEMPTING TO CONTINUE****";   <<01.02>>05122000
END;                                                           <<01.02>>05124000
PRINTLINE;                                                     <<01.02>>05126000
SKIPLINES(1);                                                  <<01.02>>05128000
END<<WARNING/NOFORMT'>>;                                       <<00221>>05130000
                                                                        05132000
$PAGE  "MODIFY'TAPE: Copy extra system files on dump tape"              05134000
$CONTROL SEGMENT=INIT                                                   05136000
PROCEDURE MODIFY'TAPE(TAPEF,FILE'REQUIRED);                    <<03083>>05138000
COMMENT                                                                 05140000
                                                                        05142000
Purpose:                                                                05144000
The reading in of the LOADMAP file does not seem to work 12/82.         05146000
          THIS PROCEDURE WAS DESIGNED TO PERFORM ONE OF THE    <<03083>>05148000
          FOLLOWING TASKS:                                     <<03083>>05150000
          1.  ADD NECESSARY SYSTEM FILES TO MEMORY DUMP TAPE   <<03083>>05152000
              IF THEY ARE NOT PRESENT -- AS DETERMINED BY      <<03083>>05154000
              SUBROUTINE CHECK'TAPE'FILES OF TAPE'TO'DISC.     <<03083>>05156000
          2.  COPY SYSTEM FILES INTO TEMPORARY DISC FILES IF   <<03083>>05158000
              THEY ARE CORRECTLY PRESENT ON THE TAPE AND       <<03083>>05160000
              PREPARE DPAN4 TO USE THESE FILES IN PLACE OF     <<03083>>05162000
              CURRENT SYSTEM FILES THEY REPRESENT.             <<03083>>05164000
                                                               <<03083>>05166000
          THE PROCEDURE USES THE LOGICAL FILES'REQUIRED TO     <<03083>>05168000
          SET IN THE CHECK'TAPE'SUBROUTINE TO DETERMINE FILE   <<03083>>05170000
          REQUIREMENTS AND PROCESS THE TAPE ACCORDINGLY.       <<03083>>05172000
                                                               <<03083>>05174000
          SUBROUTINE DISC'TO'TAPE IS THE COPYING LOOP FOR THE  <<03083>>05176000
            TRANSFER OF RECORDS FROM DISC TO TAPE AND IS USED  <<03083>>05178000
            IN THE TAPE COMPLETION PROCESS.                    <<03083>>05180000
                                                               <<03083>>05182000
          SUBROUTINE FILES'TO'DISC IS THE COPYING LOOP FOR     <<03083>>05184000
            THE TRANSFER OF RECORDS FROM TAPE FILES TO DISC.   <<03083>>05186000
            THE SUBROUTINE IS USED WHEN THE FILES ARE ALREADY  <<03083>>05188000
            PRESENT ON TAPE AND ARE TO BE USED IN PLACE OF     <<03083>>05190000
            CURRENT SYSTEM FILES.                              <<03083>>05192000
                                                               <<03083>>05194000
          SUBROUTINE CHECK'UNOPENED'FILE IS CALLED WHEN ONE    <<03083>>05196000
            OF THE SYSTEM FILES NORMALLY COPIED TO TAPE IS     <<03083>>05198000
            NOT PRESENT ON THE SYSTEM.  THE SUBROUTINE INFORMS <<03083>>05200000
            THE USER OF THIS AND WRITES CHECK RECORD TO TAPE   <<03083>>05202000
                                                                        05204000
Input parameters:                                                       05206000
                                                                        05208000
Output parameters:                                                      05210000
                                                                        05212000
Globals Referenced:                                                     05214000
                                                                        05216000
Globals Altered:                                                        05218000
                                                                        05220000
Data Structures:                                                        05222000
                                                                        05224000
Algorithm:                                                              05226000
                                                                        05228000
;                                                                       05230000
INTEGER TAPEF;                                                 <<03083>>05232000
LOGICAL FILE'REQUIRED;                                         <<03083>>05234000
BEGIN                                                          <<03083>>05236000
                                                               <<03083>>05238000
 INTEGER DFILENUM,                                             <<03083>>05240000
         RLENGTH,                                              <<03083>>05242000
         REC'LENGTH,                                           <<03083>>05244000
         FILECODE,                                             <<03083>>05246000
         FILECOUNT,                                            <<*8813>>05248000
         DEVTYPE,                                              <<*8813>>05250000
         LDEV;                                                 <<*8813>>05252000
 ARRAY   FILEBUF(0:127);                                       <<03083>>05254000
 BYTE ARRAY FILENAME(0:19);                                    <<03083>>05256000
 BYTE ARRAY BFILEBUF(*)=FILEBUF;                               <<03083>>05258000
 LOGICAL FILEOPTIONS,                                          <<03083>>05260000
         EOF;                                                  <<03083>>05262000
                                                               <<03083>>05264000
 SUBROUTINE DISC'TO'TAPE;                                      <<03083>>05266000
 BEGIN                                                         <<03083>>05268000
   EOF:=FALSE;                                                 <<03083>>05270000
   WHILE EOF=FALSE DO                                          <<03083>>05272000
     BEGIN                                                     <<03083>>05274000
     RLENGTH:=FREAD(DFILENUM,FILEBUF,REC'LENGTH);              <<03083>>05276000
     IF = THEN                                                 <<03083>>05278000
       BEGIN                                                   <<03083>>05280000
       FWRITE(TAPEF,FILEBUF,REC'LENGTH,0);                     <<03083>>05282000
       IF <> THEN                                              <<03083>>05284000
         TAPE'MODIFY'ERROR(0,TAPEF);                           <<03083>>05286000
       END                                                     <<03083>>05288000
     ELSE                                                      <<03083>>05290000
       BEGIN                                                   <<03083>>05292000
       IF > THEN                                               <<03083>>05294000
         BEGIN                                                 <<03083>>05296000
         FCONTROL(TAPEF,6,FILEOPTIONS);                        <<03083>>05298000
         IF <> THEN                                            <<03083>>05300000
           TAPE'MODIFY'ERROR(3,TAPEF);                         <<03083>>05302000
         EOF:=TRUE;                                            <<03083>>05304000
         END                                                   <<03083>>05306000
       ELSE                                                    <<03083>>05308000
         TAPE'MODIFY'ERROR(2,DFILENUM);                        <<03083>>05310000
       END;                                                    <<03083>>05312000
     END;                                                      <<03083>>05314000
 END;                                                          <<03083>>05316000
                                                               <<03083>>05318000
$PAGE                                                          <<03083>>05320000
 SUBROUTINE FILES'TO'DISC;                                     <<03083>>05322000
 BEGIN                                                         <<03083>>05324000
   EOF:=FALSE;                                                 <<03083>>05326000
   WHILE NOT EOF DO                                            <<03083>>05328000
     BEGIN                                                     <<03083>>05330000
     RLENGTH:=FREAD(TAPEF,FILEBUF,REC'LENGTH);                 <<03083>>05332000
     IF = THEN                                                 <<03083>>05334000
       BEGIN                                                   <<03083>>05336000
       IF BFILEBUF <> "MPECHECK.PUB.SYS NOT PRESENT" THEN      <<03083>>05338000
         BEGIN                                                 <<03083>>05340000
         FWRITE(DFILENUM,FILEBUF,REC'LENGTH,0);                <<03083>>05342000
         IF <> THEN                                            <<03083>>05344000
           TAPE'MODIFY'ERROR(1,TAPEF);                         <<03083>>05346000
         END                                                   <<03083>>05348000
       ELSE                                                    <<03083>>05350000
         BEGIN                                                 <<03083>>05352000
         FCLOSE(DFILENUM,0,0);                                 <<03083>>05354000
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<03083>>05356000
         EOF:=TRUE                                             <<03083>>05358000
         END;                                                  <<03083>>05360000
       END                                                     <<03083>>05362000
     ELSE                                                      <<03083>>05364000
       BEGIN                                                   <<03083>>05366000
       IF > THEN                                               <<03083>>05368000
         BEGIN                                                 <<03083>>05370000
         FCLOSE(DFILENUM,%2,0);                                <<03083>>05372000
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<03083>>05374000
         EOF:=TRUE;                                            <<03083>>05376000
         END                                                   <<03083>>05378000
       ELSE                                                    <<03083>>05380000
         TAPE'MODIFY'ERROR(8,TAPEF);                           <<03083>>05382000
       END;                                                    <<03083>>05384000
   END;                                                        <<03083>>05386000
 END;                                                          <<03083>>05388000
                                                               <<03083>>05390000
                                                               <<03083>>05392000
$PAGE                                                          <<03083>>05394000
 SUBROUTINE CHECK'UNOPENED'FILE;                               <<03083>>05396000
 BEGIN                                                         <<03083>>05398000
   MOVE DBUFFER:="DISCFILE OPEN ERROR";                        <<03083>>05400000
   PRINT(DBUFFER,-19,0);                                       <<03083>>05402000
   IF FILENAME = "MPECHECK" THEN                               <<03083>>05404000
     BEGIN                                                     <<03083>>05406000
     MOVE DBUFFER:="MPECHECK.PUB.SYS NOT PRESENT ON SYSTEM";   <<03083>>05408000
     PRINT(DBUFFER,-38,0);                                     <<03083>>05410000
     FWRITE(TAPEF,DBUFFER,19,0);                               <<03083>>05412000
     IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                    <<03083>>05414000
     FCONTROL(TAPEF,6,FILEOPTIONS);                            <<03083>>05416000
     IF <> THEN TAPE'MODIFY'ERROR(3,TAPEF);                    <<03083>>05418000
     END                                                       <<03083>>05420000
   ELSE                                                        <<03083>>05422000
     BEGIN                                                     <<03083>>05424000
     IF FILENAME = "CONFDATA" THEN                             <<03083>>05426000
       BEGIN                                                   <<03083>>05428000
       MOVE DBUFFER:="CONFDATA.PUB.SYS NOT PRESENT ON SYSTEM"; <<03083>>05430000
       FWRITE(TAPEF,DBUFFER,19,0);                             <<03083>>05432000
       IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                  <<03083>>05434000
       FCONTROL(TAPEF,6,FILEOPTIONS);                          <<03083>>05436000
       IF <> THEN TAPE'MODIFY'ERROR(3,TAPEF);                  <<03083>>05438000
       PRINT(DBUFFER,-39,0);                                   <<03083>>05440000
       END                                                     <<03083>>05442000
     ELSE                                                      <<03083>>05444000
       TAPE'MODIFY'ERROR(5,DFILENUM);                          <<03083>>05446000
     END;                                                      <<03083>>05448000
 END;                                                          <<03083>>05450000
                                                               <<03083>>05452000
                                                               <<03083>>05454000
$PAGE                                                          <<03083>>05456000
   << CHECK IF TAPE WAS DETERMINED TO BE COMPLETE >>           <<03083>>05458000
 IF FILE'REQUIRED THEN                                         <<03083>>05460000
   BEGIN                                                       <<03083>>05462000
   FGETINFO(TAPEF,,,,,DEVTYPE,LDEV);                           <<*8813>>05464000
   IF DEVTYPE.(8:8)<>0 AND DEVTYPE.(8:8)<>3 THEN               <<*8813>>05466000
       BEGIN                                                   <<*8813>>05468000
   FILECOUNT:=0;                                               <<03083>>05470000
   << LOOP TO PREPARE FOR COPYING OF SYSTEM FILES TO TAPE >>   <<03083>>05472000
   WHILE FILECOUNT < 3 DO                                      <<03083>>05474000
     BEGIN                                                     <<03083>>05476000
     CASE FILECOUNT OF                                         <<03083>>05478000
       BEGIN                                                   <<03083>>05480000
         BEGIN                                                 <<03083>>05482000
         MOVE FILENAME:="LOADMAP.PUB.SYS; ";                   <<03083>>05484000
         REC'LENGTH:=-128;                                     <<03083>>05486000
         FILEOPTIONS:=%5;                                      <<03083>>05488000
         END;                                                  <<03083>>05490000
                                                               <<03083>>05492000
         BEGIN                                                 <<03083>>05494000
         MOVE FILENAME:="MPECHECK.PUB.SYS;";                   <<03083>>05496000
         REC'LENGTH:=128;                                      <<03083>>05498000
         FILEOPTIONS:=%1;                                      <<03083>>05500000
         END;                                                  <<03083>>05502000
                                                               <<03083>>05504000
         BEGIN                                                 <<03083>>05506000
         MOVE FILENAME:="CONFDATA.PUB.SYS;";                   <<03083>>05508000
         REC'LENGTH:=128;                                      <<03083>>05510000
         FILEOPTIONS:=%1;                                      <<03083>>05512000
         END;                                                  <<03083>>05514000
       END;                                                    <<03083>>05516000
     DFILENUM:=FOPEN(FILENAME,FILEOPTIONS,%0,REC'LENGTH);      <<03083>>05518000
     IF <> THEN                                                <<03083>>05520000
       CHECK'UNOPENED'FILE                                     <<03083>>05522000
     ELSE                                                      <<03083>>05524000
       BEGIN                                                   <<03083>>05526000
       DISC'TO'TAPE;                                           <<03083>>05528000
       FCLOSE(DFILENUM,0,0);                                   <<03083>>05530000
       IF <> THEN TAPE'MODIFY'ERROR(7,DFILENUM);               <<03083>>05532000
       END;                                                    <<03083>>05534000
     FILECOUNT:=FILECOUNT + 1;                                 <<03083>>05536000
     END;                                                      <<03083>>05538000
                                                               <<03083>>05540000
     MOVE BCHECKBUF(37):="TAPE COMP.";                         <<03083>>05542000
     FWRITE(TAPEF,CHECKBUF,-46,0);                             <<03083>>05544000
     IF <> THEN TAPE'MODIFY'ERROR(0,TAPEF);                    <<03083>>05546000
     FCONTROL(TAPEF,6,FILEOPTIONS);                            <<03083>>05548000
     IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                    <<03083>>05550000
       END;                                                    <<*8813>>05552000
     MOVE BBUF:="DUMP FILE DATE:  ";                           <<03083>>05554000
     MOVE BBUF(17):=BCHECKBUF(18),(17);                        <<03083>>05556000
     PRINT(DBUFFER,0,0);                                       <<03083>>05558000
     IF <> THEN ERROR;                                         <<03083>>05560000
    PRINT(DBUFFER,-34,0);                                      <<03752>>05562000
     IF <> THEN ERROR;                                         <<03083>>05564000
   END                                                         <<03083>>05566000
 ELSE                                                          <<03083>>05568000
   BEGIN                                                       <<03083>>05570000
   FILECOUNT:=0;                                               <<03083>>05572000
   << LOOP TO PREPARE FOR COPYING OF TWO TAPE FILES TO DISC >> <<03083>>05574000
   WHILE FILECOUNT < 2 DO                                      <<03083>>05576000
     BEGIN                                                     <<03083>>05578000
     CASE FILECOUNT OF                                         <<03083>>05580000
       BEGIN                                                   <<03083>>05582000
         BEGIN                                                 <<03083>>05584000
         MOVE FILENAME:="DPANLMP.PUB.SYS;";                    <<03083>>05586000
         REC'LENGTH:=-128;                                     <<03083>>05588000
         FILEOPTIONS:=%4;                                      <<03083>>05590000
         FILECODE:=0;                                          <<03083>>05592000
         MOVE LOADMAP:="DPANLMP.PUB.SYS;";                     <<03083>>05594000
         END;                                                  <<03083>>05596000
                                                               <<03083>>05598000
         BEGIN                                                 <<03083>>05600000
         MOVE FILENAME:="DPANPMAP.PUB.SYS;";                   <<03083>>05602000
         REC'LENGTH:=128;                                      <<03083>>05604000
         FILEOPTIONS:=%0;                                      <<03083>>05606000
         FILECODE:=1023;                                       <<03083>>05608000
         MOVE MAPNAME:="DPANPMAP.PUB.SYS;";                    <<03083>>05610000
         END;                                                  <<03083>>05612000
       END;                                                    <<03083>>05614000
     DFILENUM:=FOPEN(FILENAME,FILEOPTIONS,%4,                  <<03083>>05616000
                     REC'LENGTH,,,,,,,,,FILECODE);             <<03083>>05618000
     IF <> THEN                                                <<03083>>05620000
       TAPE'MODIFY'ERROR(5,DFILENUM);                          <<03083>>05622000
     FILES'TO'DISC;                                            <<03083>>05624000
     FILECOUNT:=FILECOUNT+1;                                   <<03083>>05626000
     END;                                                      <<03083>>05628000
     FCONTROL(TAPEF,9,FILEOPTIONS);                            <<03083>>05630000
     IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                    <<03083>>05632000
   END;                                                        <<03083>>05634000
END;                                                           <<03083>>05636000
                                                                        05638000
$PAGE "TAPETODISK: Copy dump to disc file/open files/print regs"        05640000
$CONTROL SEGMENT=INIT                                                   05642000
COMMENT                                                                 05644000
                                                                        05646000
Purpose:                                                                05648000
<<    THIS PROCEDURE WILL READ THE COLD DUMP TAPE AND BUILD A     >>    05650000
<<    CORE IMAGE DISK FILE REPRESENTING MEMORY AS IT WAS AT THE   >>    05652000
<<    TIME THE COLD DUMP TAPE WAS CREATED.                        >>    05654000
Series II/III dumps have two "first record"s.  The first holds the      05656000
firmware area.                                                          05658000
                                                                        05660000
Input parameters:                                                       05662000
                                                                        05664000
Output parameters:                                                      05666000
                                                                        05668000
Globals Referenced:                                                     05670000
                                                                        05672000
Globals Altered:                                                        05674000
                                                                        05676000
Data Structures:                                                        05678000
                                                                        05680000
Algorithm:                                                              05682000
                                                                        05684000
;                                                                       05686000
                                                                        05688000
PROCEDURE TAPETODISK;                                                   05690000
      BEGIN                                                             05692000
         INTEGER PMAPCODE;       <<FOR CHECKING FILETYPE>>     <<00221>>05694000
         DOUBLE SCANP;           <<PMAP SCAN POINTER>>         <<00221>>05696000
         INTEGER SCANL;          <<CST INDEX>>                 <<00221>>05698000
         LOGICAL ARRAY PMAPBUF(0:50);  <<PMAP BUFFER>>         <<MS.00>>05700000
         BYTE ARRAY BPMAPBUF(*)=PMAPBUF;                       <<00221>>05702000
         LOGICAL ARRAY LOADBUF(0:19);  <<LOAD MAP BUFFER>>     <<00221>>05704000
         BYTE ARRAY BLOADBUF(*)=LOADBUF;                       <<00221>>05706000
         LOGICAL MDUMPLDEV;                                    <<00221>>05708000
          INTEGER TAPEF,TLOG,BUFSAV,ADDRD,S;                   <<03083>>05710000
         DOUBLE CURREC;                                        <<03083>>05712000
         LOGICAL SMODE,OPT,PRM,JNK,PROPERVOLUME,CURRENTVOL:=0; <<01114>>05714000
         REAL TIME:=1.0;                                      <<<01.02>>05716000
         LOGICAL RETRYCNT:=0;    <<RETRY COUNT ON TAPE>>       <<00221>>05718000
LOGICAL EOF;                                                   <<03083>>05720000
         LOGICAL INCOMPLETE'TAPE := FALSE;                     <<01377>>05722000
         LOGICAL CHECK'MULTI'VOL;                              <<01377>>05724000
         INTEGER DEVTYPE,CHECKSUM,LDEV,I;                     <<01.LEN>>05726000
         ARRAY TRAILBUF(0:10);                                          05728000
         EQUATE REWINDUNLOAD=9;                                         05730000
         DOUBLE T'CONVERT;                                     <<01543>>05732000
         REAL TICK'TO'MS := 9.14566375E-2;                     <<01543>>05734000
                                                               <<01875>>05736000
LOGICAL SUBROUTINE FIXIT(W);                                   <<01875>>05738000
VALUE W; LOGICAL W;                                            <<01875>>05740000
BEGIN                                                          <<01875>>05742000
   << CHECK EACH BYTE OF W TO SEE THAT IT IS >>                <<01875>>05744000
   << A PRINTABLE ASCII CHARACTER.  IF NOT,  >>                <<01875>>05746000
   << REPLACE WITH BLANK                     >>                <<01875>>05748000
   IF W.(0:8)<%40 OR W.(0:8)>%176 THEN W.(0:8):=%40;           <<01875>>05750000
   IF W.(8:8)<%40 OR W.(8:8)>%176 THEN W.(8:8):=%40;           <<01875>>05752000
   FIXIT:=W;                                                   <<01875>>05754000
END;                                                           <<01875>>05756000
                                                               <<01875>>05758000
                                                               <<00.01>>05760000
      SUBROUTINE GET35CONTEXT;                                 <<00.01>>05762000
         BEGIN                                                 <<00.01>>05764000
         XREG:=M35XREG;                                        <<00.01>>05766000
         DLREG:=M35DLREG;                                      <<00.01>>05768000
         DBBANKREG:=M35DBANKREG;                               <<00.01>>05770000
         DBREG:=M35DBREG;                                      <<00.01>>05772000
         QREG:=M35QREG;                                        <<00.01>>05774000
         SREG:=M35SMREG;                                       <<00.01>>05776000
         ZBANKREG:=M35SBANKREG;                                <<00.01>>05778000
         ZREG:=M35ZREG;                                        <<00.01>>05780000
         STAREG:=M35STATUSREG;                                 <<00.01>>05782000
         PBBANKREG:=M35PBANKREG;                               <<00.01>>05784000
         PBREG:=M35PBREG;                                      <<00.01>>05786000
         PREG:=M35PREG;                                        <<00.01>>05788000
         PLREG:=M35PLREG;                                      <<00.01>>05790000
         CIRREG:=M35CIREG;                                     <<00.01>>05792000
         CPX1:=M35CPX1;                                        <<00.01>>05794000
         CPX2:=M35CPX2;                                        <<00.01>>05796000
         SP1:=M35SP1REG;                                       <<00.01>>05798000
         SP2:=M35SP2REG;                                       <<00.01>>05800000
         IF CNSTARFISH <> 0 THEN                               <<02519>>05802000
            BEGIN                                              <<02519>>05804000
            I := CNSTARFISH*4; << COMPUTE LOCATION OF DRT >>   <<02519>>05806000
            COREBUF(I) := CNDRT0;                              <<02519>>05808000
            COREBUF(I+1) := CNDRT1;                            <<02519>>05810000
            COREBUF(I+2) := CNDRT2;                            <<02519>>05812000
            COREBUF(I+3) := CNDRT3;                            <<02519>>05814000
            END                                                <<02519>>05816000
         ELSE                                                  <<02519>>05818000
            COREBUF(24) := M35CONTENTS24;                      <<02519>>05820000
         TOS:=M35NUMBANKS; TOS:=0;                             <<00.01>>05822000
         MAXMEM:=TOS-1D;                                       <<00.01>>05824000
MEMSIZE:=M35NUMBANKS;                                          <<00221>>05826000
         END  <<GET35CONTEXT>>;                                <<00.01>>05828000
                                                               <<00.01>>05830000
      SUBROUTINE GET25CONTEXT;                                 <<00.01>>05832000
         BEGIN                                                 <<00.01>>05834000
         XREG:=M25XREG;                                        <<00.01>>05836000
         DLREG:=M25DLREG;                                      <<00.01>>05838000
         DBBANKREG:=M25DBANKREG;                               <<00.01>>05840000
         DBREG:=M25DBREG;                                      <<00.01>>05842000
         QREG:=M25QREG;                                        <<00.01>>05844000
         SREG:=M25SREG;                                        <<00.01>>05846000
         ZBANKREG:=M25SBANKREG;                                <<00.01>>05848000
         ZREG:=M25ZREG;                                        <<00.01>>05850000
         STAREG:=M25STATUSREG;                                 <<00.01>>05852000
         PBBANKREG:=M25PBANKREG;                               <<00.01>>05854000
         PBREG:=M25PBREG;                                      <<00.01>>05856000
         PREG:=M25PREG;                                        <<00.01>>05858000
         PLREG:=M25PLREG;                                      <<00.01>>05860000
         CIRREG:=M25CIREG;                                     <<00.01>>05862000
         NIR:=M25NIRREG;                                       <<00.01>>05864000
         ISR:=M25ISR;                                          <<00.01>>05866000
         IF MACHINEID = ICF55                                  <<03013>>05868000
         THEN BEGIN                                            <<03013>>05870000
           NIR := M55NIRREG;                                   <<03013>>05872000
           CPX1 := M55CPX1;                                    <<03013>>05874000
           CPX2 := M55CPX2;                                    <<03013>>05876000
         END;                                                  <<03013>>05878000
         TOS:=M25NUMBANKS; TOS:=0;                             <<00.01>>05880000
         MAXMEM:=TOS-1D;                                       <<00.01>>05882000
MEMSIZE:=M25NUMBANKS;                                          <<00221>>05884000
         END  <<GET25CONTEXT>>;                                <<00.01>>05886000
                                                               <<01377>>05888000
                                                               <<01377>>05890000
SUBROUTINE INVALIDTAPE;                                        <<01377>>05892000
                                                               <<01377>>05894000
<< THE DUMP TAPE HAS BEEN FOUND TO BE INVALID.  PRINT >>       <<01377>>05896000
<< AN ERROR MESSAGE AND TERMINATE.                    >>       <<01377>>05898000
                                                               <<01377>>05900000
BEGIN                                                          <<01377>>05902000
                                                               <<01377>>05904000
   MOVE BBUF :=                                                <<01377>>05906000
      "***INVALID DUMP TAPE.  UNABLE TO PROCESS DUMP.  ";      <<01377>>05908000
   PRINT( DBUFFER, -48, 0 );                                   <<01377>>05910000
   MOVE BBUF :=                                                <<01377>>05912000
      "   SEE THE CONSOLE OPERATOR'S GUIDE FOR FURTHER ";      <<01377>>05914000
   PRINT( DBUFFER, -48, 0 );                                   <<01377>>05916000
   MOVE BBUF := "   INFORMATION.";                             <<01377>>05918000
   PRINT( DBUFFER, -15, 0 );                                   <<01377>>05920000
                                                               <<01377>>05922000
   TERMINATE;                                                  <<01377>>05924000
                                                               <<01377>>05926000
END;  << INVALID TAPE >>                                       <<01377>>05928000
                                                               <<03083>>05930000
                                                               <<03083>>05932000
SUBROUTINE CHECK'TAPE'FILES;                                   <<03083>>05934000
                                                               <<03083>>05936000
    << IN SUBROUTINE CHECK'TAPE'FILES TESTS ARE MADE FOR  >>   <<03083>>05938000
    << DETERMINING THE PRESENT TAPE ORGANIZATION. FIRST,  >>   <<03083>>05940000
    << THE RECORD AFTER THE END OF THE MEMORY DUMP IS READ>>   <<03083>>05942000
    << IF IT IS NOT AN END OF FILE MARK AN EOF IS ADDED,  >>   <<03083>>05944000
    << THE VERIFICATION RECORD IS ADDED AND THE LOGICAL   >>   <<03083>>05946000
    << FILES'REQUIRED IS SET TRUE TO INDICATE THE SYSTEM  >>   <<03083>>05948000
    << FILES ARE TO BE ADDED TO TAPE. OTHERWISE THE NEXT  >>   <<03083>>05950000
    << RECORD IS READ AND COMPARED TO THE VERIFICATION    >>   <<03083>>05952000
    << RECORD CONFIGURED PREVIOUSLY. IF A MATCH IS FOUND  >>   <<03083>>05954000
    << AND THE COMPLETE TAPE INDICATOR IS SET THE LOGICAL >>   <<03083>>05956000
    << FILES REQUIRED IS SET FALSE TO INDICATE FILES ARE  >>   <<03083>>05958000
    << TO BE COPIED FROM TAPE TO DISC.  IF THE VERIFI-    >>   <<03083>>05960000
    << CATION RECORD IS NOT FOUND OR IS INCORRECT THE     >>   <<03083>>05962000
    << VALID VERIFICATION RECORD IS WRITEN AND THE LOGICAL>>   <<03083>>05964000
    << FILES'REQUIRED IS SET TRUE.  IF THE COMPLETE TAPE  >>   <<03083>>05966000
    << INDICATOR IS NOT SET THE TAPE IS PREPARED FOR AN   >>   <<03083>>05968000
    << ATTEMP TO WRITE THE SYSTEM FILES TO TAPE AGAIN     >>   <<03083>>05970000
    << ASSUMING AN ERROR WAS FOUND IN THE LAST ATTEMPT.   >>   <<03083>>05972000
                                                               <<03083>>05974000
BEGIN                                                          <<03083>>05976000
                                                               <<03083>>05978000
    << SET UP VERIFICATION RECORD TO BE ADDED TO TAPE  >>      <<03083>>05980000
                                                               <<03083>>05982000
MOVE CHECKBUF:=24("  ");                                       <<03083>>05984000
MOVE BCHECKBUF:="DPAN HP/3000    ";                            <<03083>>05986000
RECOVER'DATE(TBUF);                                            <<03083>>05988000
MOVE BCHECKBUF(18):=STRING,(17);                               <<03083>>05990000
FILE'REQUIRED:=FALSE;                                          <<03083>>05992000
TLOG:=FREAD(TAPEF,COREBUF,4096);                               <<03083>>05994000
IF <= THEN                                                     <<03083>>05996000
  BEGIN                                                        <<03083>>05998000
  FSPACE(TAPEF,-1);                                            <<03083>>06000000
  FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                           <<03083>>06002000
  IF <> THEN                                                   <<03083>>06004000
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<03083>>06006000
  FWRITE(TAPEF,CHECKBUF,23,0);                                 <<03083>>06008000
  IF <> THEN                                                   <<03083>>06010000
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<03083>>06012000
  FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                           <<03083>>06014000
  IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                       <<03083>>06016000
  FILE'REQUIRED:=TRUE;                                         <<03083>>06018000
  END                                                          <<03083>>06020000
ELSE                                                           <<03083>>06022000
  BEGIN                                                        <<03083>>06024000
  COREBUF:="  "; MOVE COREBUF(1):=COREBUF,(4095);              <<*8893>>06026000
  TLOG:=FREAD(TAPEF,COREBUF,18);                               <<03083>>06028000
  IF <> OR BCOREBUF <> BCHECKBUF,(34) THEN                     <<03083>>06030000
    BEGIN                                                      <<03083>>06032000
    FSPACE(TAPEF,-1);                                          <<03083>>06034000
    IF < THEN                                                  <<03083>>06036000
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<03083>>06038000
    FWRITE(TAPEF,CHECKBUF,23,0);                               <<03083>>06040000
    IF <> THEN                                                 <<03083>>06042000
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<03083>>06044000
    FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                         <<03083>>06046000
    IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                     <<03083>>06048000
    FILE'REQUIRED:=TRUE;                                       <<03083>>06050000
    END                                                        <<03083>>06052000
  ELSE                                                         <<03083>>06054000
    BEGIN                                                      <<03083>>06056000
    FSPACE(TAPEF,1);                                           <<03083>>06058000
    IF <= THEN                                                 <<03083>>06060000
      BEGIN                                                    <<03083>>06062000
      FSPACE(TAPEF,-1);                                        <<03083>>06064000
      IF <> THEN TAPE'MODIFY'ERROR(4,TAPEF);                   <<03083>>06066000
      FCONTROL(TAPEF,6,INCOMPLETE'TAPE);                       <<03083>>06068000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06070000
      FILE'REQUIRED:=TRUE;                                     <<03083>>06072000
      END                                                      <<03083>>06074000
    ELSE                                                       <<03083>>06076000
      BEGIN                                                    <<03083>>06078000
                                                               <<03083>>06080000
     << IN THIS SECTION OF CODE THE ADDITIONAL FILES ARE >>    <<03083>>06082000
     << CHECKED FOR COMPLETENESS.  THE TAPE IS SEARCHED  >>    <<03083>>06084000
     << TO FIND THE COMPLETE TAPE INDICATOR WHICH IS     >>    <<03083>>06086000
     << PLACED AFTER THE THIRD ADDITIONAL FILE.  AFTER   >>    <<03083>>06088000
     << THE COMPLETE TAPE INDICATOR IS FOUND THE TAPE IS >>    <<03083>>06090000
     << REWOUND AND PLACED AT THE BEGINNING OF THE FIRST >>    <<03083>>06092000
     << ADDITIONAL FILE SO THAT THE COPYING PROCEDURE CAN>>    <<03083>>06094000
     << BEGIN.                                           >>    <<03083>>06096000
                                                               <<03083>>06098000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06100000
      IF <> THEN                                               <<03083>>06102000
         BEGIN                                                 <<03083>>06104000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06106000
         GO EXIT;                                              <<03083>>06108000
         END;                                                  <<03083>>06110000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06112000
      IF <> THEN                                               <<03083>>06114000
         BEGIN                                                 <<03083>>06116000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06118000
         GO EXIT;                                              <<03083>>06120000
         END;                                                  <<03083>>06122000
      FCONTROL(TAPEF,7,INCOMPLETE'TAPE);                       <<03083>>06124000
      IF <> THEN                                               <<03083>>06126000
         BEGIN                                                 <<03083>>06128000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06130000
         GO EXIT;                                              <<03083>>06132000
         END;                                                  <<03083>>06134000
      FREAD(TAPEF,COREBUF,-47);                                <<03083>>06136000
      IF <> THEN                                               <<03083>>06138000
         BEGIN                                                 <<03083>>06140000
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<03083>>06142000
         GO EXIT;                                              <<03083>>06144000
         END;                                                  <<03083>>06146000
      IF BCOREBUF <> BCHECKBUF,(23) THEN                       <<03083>>06148000
        FILE'REQUIRED:=TRUE;                                   <<03083>>06150000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06152000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06154000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06156000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06158000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06160000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06162000
      FCONTROL(TAPEF,8,INCOMPLETE'TAPE);                       <<03083>>06164000
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<03083>>06166000
      FSPACE(TAPEF,1);                                         <<03083>>06168000
      IF < THEN TAPE'MODIFY'ERROR(4,TAPEF);                    <<03083>>06170000
    EXIT:                                                      <<03083>>06172000
      END;                                                     <<03083>>06174000
    END;                                                       <<03083>>06176000
  END;                                                         <<03083>>06178000
END;                                                           <<03083>>06180000
$PAGE                                                          <<01377>>06182000
SUBROUTINE INCOMPLETE;                                         <<01377>>06184000
                                                               <<01377>>06186000
<< THE INPUT DUMP FILE HAS BEEN FOUND TO BE INCOMPLETE.  >>    <<01377>>06188000
<< PRINT ERROR MESSAGE AND HANDLE CONTINUATION OPTION.   >>    <<01377>>06190000
                                                               <<01377>>06192000
BEGIN                                                          <<01377>>06194000
   MOVE BBUF := "INCOMPLETE DUMP:    K WORDS SHORT";           <<01377>>06196000
   @PBUF := @BBUF + 17;                                        <<01377>>06198000
   ASCII( (NUMREC*4), 10, PBUF );                              <<01377>>06200000
   PRINT( DBUFFER, -33, 0 );                                   <<01377>>06202000
   MOVE BBUF := "  ";                                          <<01377>>06204000
   PRINT( DBUFFER, -2, 0 );                                    <<01377>>06206000
                                                               <<01377>>06208000
<< IF IN A SESSION, THERE IS THE OPTION OF CONTINUING.   >>    <<01377>>06210000
   IF DUPLICATIVE THEN                                         <<01377>>06212000
   BEGIN                                                       <<01377>>06214000
      MOVE BBUF :=                                             <<01377>>06216000
         "THE DUMP TAPE HAS BEEN FOUND TO BE INCOMPLETE.";     <<01377>>06218000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06220000
      MOVE BBUF :=                                             <<01377>>06222000
         "THE RESULTING DUMP LISTING IS OFTEN OF LITTLE ";     <<01377>>06224000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06226000
      MOVE BBUF :=                                             <<01377>>06228000
         "VALUE.  SEE THE CONSOLE OPERATOR'S GUIDE FOR  ";     <<01377>>06230000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06232000
      MOVE BBUF :=                                             <<01377>>06234000
         "FURTHER INFORMATION.                          ";     <<01377>>06236000
      PRINT( DBUFFER, -46, 0 );                                <<01377>>06238000
      MOVE BBUF :=                                             <<01377>>06240000
         "    ";                                               <<01377>>06242000
      PRINT( DBUFFER, -4, 0 );                                 <<01377>>06244000
      MOVE BBUF :=                                             <<01377>>06246000
         "DO YOU WISH TO PRINT THIS INCOMPLETE DUMP (Y OR N)?";<<01377>>06248000
      PRINT( DBUFFER, -52, 0 );                                <<01377>>06250000
                                                               <<01377>>06252000
   << READ THE RESPONSE FROM THE USER.                   >>    <<01377>>06254000
      READX (DBUFFER,-1);                                      <<03079>>06256000
      IF BBUF = "Y"  OR BBUF = "y"                             <<01377>>06258000
         THEN INCOMPLETE'TAPE := TRUE                          <<01377>>06260000
         ELSE TERMINATE;                                       <<01377>>06262000
                                                               <<01377>>06264000
   END     << USER WAS IN A SESSION. >>                        <<01377>>06266000
   ELSE                                                        <<01377>>06268000
   BEGIN   << USER WAS IN A JOB.     >>                        <<01377>>06270000
                                                               <<01377>>06272000
      MOVE BBUF :=                                             <<01377>>06274000
         "RUN DPAN4 FROM A SESSION TO PRINT INCOMPLETE DUMPS"; << WBT >>06276000
      PRINT( DBUFFER, -50, 0 );                                <<01377>>06278000
      TERMINATE;                                               <<01377>>06280000
                                                               <<01377>>06282000
   END;                                                        <<01377>>06284000
                                                               <<01377>>06286000
END;  << INCOMPLETE. >>                                        <<01377>>06288000
$PAGE                                                          <<01377>>06290000
SUBROUTINE GET'SERIESII'CONTEXT;                               <<01377>>06292000
                                                               <<01377>>06294000
<< THE DEFAULT MACHINE CONTEXT IS THE OLD SERIES II.     >>    <<01377>>06296000
<< OTHER OPTIONS (HANDLED ELSEWHERE) ARE MODELS 25 & 35. >>    <<01377>>06298000
                                                               <<01377>>06300000
BEGIN                                                          <<01377>>06302000
                                                               <<01377>>06304000
   ADDRD := COREBUF( 0 );                                      <<01377>>06306000
   IF LOGICAL( ADDRD ) > %1010 THEN                            <<01377>>06308000
   BEGIN                                                       <<01377>>06310000
      MOVE BBUF := "INVALID DUMP TAPE.";                       <<01377>>06312000
      PRINT( DBUFFER, -19, 0 );                                <<01377>>06314000
      ERROR;                                                   <<01377>>06316000
   END;                                                        <<01377>>06318000
                                                               <<01377>>06320000
<< SAVE PERTENIENT PARTS OF FIRST RECORD.                >>    <<01377>>06322000
   MOVE SCRBUF := COREBUF(1), (26);                            <<01377>>06324000
   BUFSAV := ADDRD + 1;                                        <<01377>>06326000
                                                               <<01377>>06328000
<< READ NEXT RECORD AND RESTORE SAVED INFORMATION.       >>    <<01377>>06330000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>06332000
   IF <> THEN INCOMPLETE;                                      <<01377>>06334000
   MOVE REGSAVE := COREBUF( BUFSAV+1 ), (26);                  <<01377>>06336000
   MOVE COREBUF( BUFSAV ) := SCRBUF, (26);                     <<01377>>06338000
   MOVE COREBUF( BUFSAV-7 ) := REGSAVE, (6);                   <<01377>>06340000
   COREBUF( BUFSAV-1 ) := REG6;                                <<01377>>06342000
   COREBUF( BUFSAV )   := REG7;                                <<01377>>06344000
                                                               <<01377>>06346000
   TOS := MEMSIZE LAND %7770;                                  <<01377>>06348000
   DEL;                                                        <<01377>>06350000
                                                               <<01377>>06352000
   TOS := 0;                                                   <<01377>>06354000
   TOS := MEMSIZE;                                             <<01377>>06356000
   TOS := TOS&DCSR(3)&LSL(3);                                  <<01377>>06358000
   ASB( XCH );                                                 <<01377>>06360000
   TOS := TOS&CSL(3);                                          <<01377>>06362000
   ASB( XCH );                                                 <<01377>>06364000
   TOS := TOS - 1D;                                            <<01377>>06366000
   IF < THEN BEGIN DDEL; TOS := %777777D; END;  << 256 K >>    <<01833>>06368000
   MAXMEM := TOS;                                              <<01377>>06370000
                                                               <<01377>>06372000
END;  << GET'SERIESII'CONTEXT >>                               <<01377>>06374000
$PAGE                                                          <<01377>>06376000
SUBROUTINE MULTIVOL;                                           <<01377>>06378000
                                                               <<01377>>06380000
<< WHILE COPYING THE DUMP FILE TO THE CORE DISK FILE,IT  >>    <<01377>>06382000
<< WAS FOUND THAT THE DUMP FILE WAS SHORT; BUT THERE     >>    <<01377>>06384000
<< EXISTS THE POSSIBILITY THAT THE DUMP FILE OCCUPIES    >>    <<01377>>06386000
<< MULTIPLE VOLUMES.  THIS ROUTINE REQUESTS THAT THE     >>    <<01377>>06388000
<< NEXT VOLUME IS MOUNTED.                               >>    <<01377>>06390000
<<                                                       >>    <<01377>>06392000
<< NOTE:  THIS ROUTINE BECOMES AN INFINITE LOOP IF THE   >>    <<01377>>06394000
<<        PROPER NEXT VOLUME IS NOT FOUND.  SINCE THIS   >>    <<01377>>06396000
<<        ROUTINE REPEATED CALLS THE OPERATOR, HOWEVER,  >>    <<01377>>06398000
<<        IT CAN BE ABORTED WHEN THE OPERATOR CAN'T      >>    <<01377>>06400000
<<        FIND THE RIGHT VOLUME.                         >>    <<01377>>06402000
                                                               <<01377>>06404000
BEGIN                                                          <<01377>>06406000
                                                               <<01377>>06408000
<< CHECK FOR MULTIPLE VOLUME INPUT BY TRYING TO GET THE  >>    <<01377>>06410000
<< TRAILER OF THE CURRENT VOLUME.                        >>    <<01377>>06412000
                                                               <<01377>>06414000
   TLOG := FREAD( TAPEF, TRAILBUF, 10 );                       <<01377>>06416000
   CURRENTVOL := CURRENTVOL + 1;                               <<01377>>06418000
   IF TLOG <> 10  OR  TRAILBUF <> CURRENTVOL  THEN             <<01377>>06420000
   BEGIN                                                       <<01377>>06422000
      INCOMPLETE;                                              <<01377>>06424000
      RETURN;                                                  <<01377>>06426000
   END;                                                        <<01377>>06428000
                                                               <<01377>>06430000
<< SEARCH FOR THE PROPER VOLUME.                         >>    <<01377>>06432000
   DO                                                          <<01377>>06434000
   BEGIN                                                       <<01377>>06436000
                                                               <<01377>>06438000
      FCONTROL( TAPEF, REWINDUNLOAD, PARM );                   <<01377>>06440000
      PRINTOP( MNV, 9, 0 );                                    <<01377>>06442000
      IF DEVTYPE.(8:8) = SERDISC                               <<01377>>06444000
         THEN FCONTROL( TAPEF, 7, JNK );                       <<01377>>06446000
      TLOG := FREAD( TAPEF, TRAILBUF, 10 );                    <<01377>>06448000
      PROPERVOLUME :=                                          <<01377>>06450000
         IF TLOG = 10  AND  TRAILBUF = CURRENTVOL              <<01377>>06452000
            THEN TRUE                                          <<01377>>06454000
            ELSE FALSE;                                        <<01377>>06456000
      IF NOT PROPERVOLUME                                      <<01377>>06458000
         THEN PRINTOP( IMPV, 8, PARM );                        <<01377>>06460000
                                                               <<01377>>06462000
   END  UNTIL PROPERVOLUME;                                    <<01377>>06464000
                                                               <<01377>>06466000
<< READ AND CHECK NEXT RECORD.                           >>    <<01377>>06468000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>06470000
   IF < THEN BEGIN                                             <<01377>>06472000
      INVALIDTAPE;                                             <<01377>>06474000
      RETURN;                                                  <<01377>>06476000
   END                                                         <<01377>>06478000
   ELSE IF >                                                   <<01377>>06480000
      THEN WHILE CHECK'MULTI'VOL DO MULTIVOL                   <<01377>>06482000
   ELSE                                                        <<01377>>06484000
      CHECK'MULTI'VOL := FALSE;                                <<01377>>06486000
                                                               <<01377>>06488000
END;  << MULTIVOL >>                                           <<01377>>06490000
$PAGE                                                          <<01377>>06492000
                                                               <<01377>>06494000
<<  M A I N    B O D Y                                   >>    <<01377>>06496000
                                                               <<01377>>06498000
      WHO( JSM );                                              <<01377>>06500000
      IF JSM.(15:1) = 1 THEN OPT := %400                       <<01377>>06502000
      ELSE OPT:=%410;     <<STDLIST>>                                   06504000
      IF DUPLICATIVE THEN                                      <<01114>>06506000
      BEGIN                                                   <<<01.02>>06508000
         TBUF:="  ";                                          <<<01.02>>06510000
         MOVE TBUF(1):=TBUF,(74);                             <<<01.02>>06512000
         MOVE TBUF:=DPN4,(5);                                  << WBT >>06514000
         MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                   <<04665>>06516000
         MOVE TBUF(5):=LVL,(4);                               <<<01.02>>06518000
         MOVE TBUF(9):=COPYRITE,(14);                         <<<01.02>>06520000
         PRINT(TBUF,24,0);                                    <<<01.02>>06522000
      END; <<PRINT IDENTIFIER ON SESSION DEVICE>>             <<<01.02>>06524000
      IF NOT PRTNPRT THEN BEGIN                                         06526000
      LPF:=FOPEN(LPN,OPT,1,,LPND,,,,16);                      <<<01.02>>06528000
      IF <> THEN                                                        06530000
      BEGIN                                                             06532000
        PRINT'FILE'INFO(LPF);                                           06534000
        ERROR;                                                          06536000
      END;                                                              06538000
      END;                                                              06540000
         DPANSWAP:=FOPEN(MSWLIN,%64,1,-50);                    <<00221>>06542000
          IF = THEN  MOVE MSWLIN:="        ";   <<BLANK NAME>> <<00221>>06544000
         MOVE BBUF:="COREFILE ";          <<TEMP DISK FILE>>   <<*8815>>06546000
         COREF:=FOPEN(BBUF,0,%504,4096,,,,,,1024D,32,4);       <<*8815>>06548000
         IF <> THEN                                                     06550000
         BEGIN                                                          06552000
           MOVE DBUFFER:="CC <> ON FOPEN TO DISK";                      06554000
           PRINT(DBUFFER,-22,0);                               <<01057>>06556000
           PRINT'FILE'INFO(COREF);                                      06558000
           ERROR;                                                       06560000
         END;                                                           06562000
         COREBUF:=0;                                                    06564000
       FWRITEDIR(COREF,COREBUF,1,255D);<<OPEN LAST EXTENT>>    <<MS.00>>06566000
         IF <> THEN                                                     06568000
         BEGIN                                                          06570000
                                                                        06572000
PDISK:                                                                  06574000
           MOVE DBUFFER:="CC <> ON FWRITE TO DISK";                     06576000
           PRINT(DBUFFER,-23,0);                               <<01057>>06578000
           PRINT'FILE'INFO(COREF);                                      06580000
           ERROR;                                                       06582000
         END;                                                           06584000
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<03083>>06586000
         IF = THEN GO TAPET;                                            06588000
   MOVE COREDUMP(5):=".PUB.SYS";                               <<01833>>06590000
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<03083>>06592000
   IF = THEN GO TAPET;                                         <<01833>>06594000
   TAPEF:=FOPEN(DPANIN,%200,%504,4096,TAPE);                   <<03083>>06596000
         IF <> THEN                                                     06598000
         BEGIN                                                          06600000
            MOVE DBUFFER:="CC <> ON FOPEN TO TAPE";                     06602000
            PRINT(DBUFFER,-22,0);                              <<01057>>06604000
            PRINT'FILE'INFO(TAPEF);                                     06606000
            ERROR;                                                      06608000
         END;                                                           06610000
                                                               <<03659>>06612000
         <<THE FOLLOWING FWRITE OF ZERO LENGTH IS USED TO>>    <<03659>>06614000
         <<FORCE THE FILE SYSTEM TO VERIFY THAT A WRITE  >>    <<03659>>06616000
         <<RING IS PRESENT ON THE TAPE (SINCE WE WILL BE >>    <<03659>>06618000
         <<WRITING ON THE TAPE TO APPEND FILES).  IT     >>    <<03659>>06620000
         <<SHOULD LEAVE THE TAPE AT THE LOAD POINT.  IT  >>    <<03659>>06622000
         <<IS IMPORTANT THAT THE FILE BE OPENED WITH     >>    <<03659>>06624000
         <<UNDEFINED LENGTH RECORDS SPECIFIED, OTHERWISE >>    <<03659>>06626000
         <<THIS FWRITE WILL OVERWRITE PART OF THE TAPE   >>    <<03659>>06628000
         FWRITE(TAPEF,COREBUF,0,0);                            <<03659>>06630000
         IF <> THEN                                            <<03659>>06632000
         BEGIN                                                 <<03659>>06634000
            MOVE DBUFFER:="CC <> ON FWRITE TO TAPE";           <<03659>>06636000
            PRINT(DBUFFER,-23,0);                              <<03659>>06638000
            PRINT'FILE'INFO(TAPEF);                            <<03659>>06640000
            ERROR;                                             <<03659>>06642000
         END;                                                  <<03659>>06644000
TAPET:                                                                  06646000
         FGETINFO(TAPEF,,,,,DEVTYPE,LDEV);                    <<01.LEN>>06648000
         IF DEVTYPE.(8:8)=3 THEN GO BOTFOUND;                  <<04543>>06650000
         IF DEVTYPE.(8:8)=0 THEN                               <<00.01>>06652000
            GOTO BOTFOUND;                                     <<00.01>>06654000
         IF DEVTYPE.(8:8) = SERDISC THEN                       <<00.01>>06656000
            BEGIN                                              <<00.01>>06658000
            FCONTROL(TAPEF,7,JNK);                            <<00.01>> 06660000
            GO BOTFOUND;                                       <<00.01>>06662000
            END;                                               <<00.01>>06664000
         IF DEVTYPE.(8:8) <> MAGTAPE THEN                      <<00.01>>06666000
            BEGIN  <<INVALID DPAN DEVICE>>                     <<00.01>>06668000
            MOVE DBUFFER:="INVALID INPUT DEVICE";              <<00.01>>06670000
            PRINT(DBUFFER,-20,0);                              <<01057>>06672000
            PRINT'FILE'INFO(TAPEF);                            <<00.01>>06674000
            ERROR;                                             <<00.01>>06676000
            END;                                               <<00.01>>06678000
BOTFOUND:                                                     <<<01.02>>06680000
                                                               <<01377>>06682000
<< READ THE FIRST RECORD IN THE DUMP FILE.               >>    <<01377>>06684000
   NUMREC := 256;   << 2 MB WORDS / 4 K WORDS PER REC.   >>    <<01377>>06686000
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<01377>>06688000
   IF <> THEN       << FREAD ERROR ON FIRST RECORD.      >>    <<01377>>06690000
   BEGIN                                                       <<01377>>06692000
      INVALIDTAPE;                                             <<01377>>06694000
      GO ERRLEAVE;                                             <<01377>>06696000
   END;                                                        <<01377>>06698000
                                                               <<01377>>06700000
<< GET MACHINE ID AND APPROPRIATE MACHINE CONTEXT.       >>    <<01377>>06702000
   MACHINEID := CNMACHINEID;                                   <<01377>>06704000
   IF      MACHINEID = MODEL35                                 <<01377>>06706000
      THEN GET35CONTEXT                                        <<01377>>06708000
   ELSE IF SERIES'33'THRU'MM                                   <<s7922>>06710000
      THEN GET25CONTEXT                                        <<01377>>06712000
   ELSE    GET'SERIESII'CONTEXT;                               <<01377>>06714000
                                                               <<01377>>06716000
<< COPY THE DUMP FILE TO THE CORE DISK FILE.             >>    <<01377>>06718000
   FWRITEDIR( COREF, COREBUF, 4096, 0D );                      <<01377>>06720000
   IF <> THEN                                                  <<01377>>06722000
   BEGIN                                                       <<01377>>06724000
      MOVE DBUFFER := "* CC <> ON FWRITE TO DISK.";            <<01377>>06726000
      PRINT( DBUFFER, -26, 0 );                                <<01377>>06728000
      PRINT'FILE'INFO( COREF );                                <<01377>>06730000
      ERROR;                                                   <<01377>>06732000
   END;                                                        <<01377>>06734000
                                                               <<01377>>06736000
   NUMREC := INTEGER( MAXMEM&DLSR(12) );                       <<01377>>06738000
   WHILE  NUMREC > 0  AND  NOT INCOMPLETE'TAPE   DO            <<01377>>06740000
   BEGIN                                                       <<01377>>06742000
                                                               <<01377>>06744000
   << READ AND CHECK THE NEXT RECORD.                    >>    <<01377>>06746000
      TLOG := FREAD( TAPEF, COREBUF, 4096 );                   <<01377>>06748000
      IF < THEN INCOMPLETE      << FREAD ERROR.          >>    <<01377>>06750000
      ELSE IF > THEN            << FREAD SHORT.          >>    <<01377>>06752000
      BEGIN                                                    <<01377>>06754000
         CHECK'MULTI'VOL := TRUE;                              <<01377>>06756000
         WHILE CHECK'MULTI'VOL DO                              <<01377>>06758000
         BEGIN                                                 <<01377>>06760000
            MULTIVOL;                                          <<01377>>06762000
            IF INCOMPLETE'TAPE THEN GO ERRLEAVE;               <<01377>>06764000
         END;                                                  <<01377>>06766000
                                                               <<01377>>06768000
                                                               <<00.01>>06770000
                                                               <<01377>>06772000
      END;  << FREAD SHORT. >>                                 <<01377>>06774000
                                                               <<01377>>06776000
   << WRITE THE RECORD TO THE CORE DISK FILE.            >>    <<01377>>06778000
      FWRITE( COREF, COREBUF, 4096, 0 );                       <<01377>>06780000
      IF <> THEN                                               <<01377>>06782000
      BEGIN                                                    <<01377>>06784000
         MOVE DBUFFER := "**CC <> ON FWRITE TO DISK";          <<01377>>06786000
         PRINT( DBUFFER, -25, 0 );                             <<01377>>06788000
         PRINT'FILE'INFO( COREF );                             <<01377>>06790000
         ERROR;                                                <<01377>>06792000
      END;                                                     <<01377>>06794000
                                                               <<01377>>06796000
      NUMREC := NUMREC - 1;                                    <<01377>>06798000
                                                               <<01377>>06800000
   END;  << COPYING LOOP >>                                    <<01377>>06802000
                                                               <<01377>>06804000
CHECK'TAPE'FILES;                                              <<03083>>06806000
                                                               <<03083>>06808000
    << THE FOLLOWING CODE WAS ADDED TO PREVENT DUMPS  >>       <<03083>>06810000
    << FROM ONE SYSTEM LEVEL (I.E. 44'S, 30/33'S)     >>       <<03083>>06812000
    << HAVING THE NECESSARY SYSTEM FILES OF ANOTHER   >>       <<03083>>06814000
    << SYSTEM LEVEL APPENDED TO THE END OF THE MEMORY >>       <<03083>>06816000
    << DUMP TAPE.  THE NECESSARY INFORMATION COULD    >>       <<03083>>06818000
    << NOT BE OBTAINED TO IMPLEMENT THIS TYPE OF CHECK>>       <<03083>>06820000
    << ON SYSTEMS OF THE SAME LEVEL.                  >>       <<03083>>06822000
                                                               <<03083>>06824000
CPUMACHINECODE:=THISCPU;                                       <<03083>>06826000
CASE CPUMACHINECODE OF                                         <<03083>>06828000
  BEGIN                                                        <<03083>>06830000
  ;                                                            <<03083>>06832000
  ;                                                            <<03083>>06834000
  CPUMACHINECODE:=3;                                           <<03083>>06836000
  CPUMACHINECODE:=2;                                           <<03083>>06838000
  ;                                                                     06840000
  END;                                                         <<03083>>06842000
IF FILE'REQUIRED AND CPUMACHINECODE -1 <> MACHINEID            <<03083>>06844000
   THEN GO ERRLEAVE;                                           <<03083>>06846000
MODIFY'TAPE(TAPEF,FILE'REQUIRED);                              <<03083>>06848000
                                                               <<03083>>06850000
ERRLEAVE:                                                               06852000
         FCLOSE(TAPEF,0,0);                                             06854000
         CHKLDMAP;                                             <<01114>>06856000
                                                               <<MS.00>>06858000
            IF SAME'SYSTEM THEN                                <<MS.00>>06860000
            BEGIN                                              <<MS.00>>06862000
PMAPFILE:=FOPEN(MAPNAME,%7,%200);                              <<03083>>06864000
             IF = THEN                                         <<MS.00>>06866000
             BEGIN                                             <<MS.00>>06868000
              FGETINFO(PMAPFILE,,,,,,,,PMAPCODE);              <<MS.00>>06870000
              IF PMAPCODE = 1023 THEN                          <<00740>>06872000
              BEGIN                                            <<MS.00>>06874000
               SCANP:=0D; << START OF RECORD >>                <<MS.00>>06876000
               DBUFFER(72) := FIXIT(CORE(MITVERNO));<<MIT VERSI<<01924>>06878000
               DBUFFER(70) := FIXIT(CORE(MITUPNO)); <<MIT UPDAT<<01924>>06880000
               DBUFFER(71) := FIXIT(CORE(MITFNO));  <<MIT FIX I<<01924>>06882000
             FREADDIR(PMAPFILE,PMAPBUF,-60,SCANP);             <<MS.00>>06884000
               IF <> THEN GO DONEBLD;<< EMPTY >>               <<MS.00>>06886000
               MOVE BLOADBUF    :="%";                         <<MS.00>>06888000
               MOVE BLOADBUF( 1):=BPMAPBUF    ,(6);            <<MS.00>>06890000
               MOVE BLOADBUF( 7):="%";                         <<MS.00>>06892000
               MOVE BLOADBUF( 8):=BPMAPBUF( 7),(6);            <<MS.00>>06894000
               MOVE BLOADBUF(14):="%";                         <<MS.00>>06896000
               MOVE BLOADBUF(15):=BPMAPBUF(14),(6);            <<MS.00>>06898000
               LOADBUF(20):=BINARY(BLOADBUF    ,7);            <<MS.00>>06900000
               LOADBUF(21):=BINARY(BLOADBUF( 7),7);            <<MS.00>>06902000
               LOADBUF(22):=BINARY(BLOADBUF(14),7);            <<MS.00>>06904000
                BEGIN                                          <<MS.00>>06906000
                 SCANL:=0; << INITIALIZE INDEX CNTR >>         <<MS.00>>06908000
                 @MEMBUFP:=@MEMBUF;<<INITIALIZE TBL ADDR>>     <<MS.00>>06910000
                 WHILE (SCANL:=SCANL+1) < 300 DO               <<MS.00>>06912000
                 BEGIN                                         <<MS.00>>06914000
                  SCANP:=SCANP + 1D; << INCR. REC. CNTR >>     <<MS.00>>06916000
                  FREADDIR(PMAPFILE,DBUFFER,25,SCANP);         <<MS.00>>06918000
                  IF <> THEN GO DONEBLD; << FIN >>             <<MS.00>>06920000
                  MOVE MEMBUFP:=DBUFFER,(8); <<SEG.NAME>>      <<MS.00>>06922000
                  MOVE BBUF(24):="%";                          <<MS.00>>06924000
                  MOVE BBUF(34):="%";                          <<MS.00>>06926000
                  MEMBUFP( 8):=BINARY(BBUF(24),7);<<SEG.LEN>>  <<MS.00>>06928000
                  MEMBUFP(10):=BINARY(BBUF(34),7);<<CKSUM>>    <<MS.00>>06930000
                  MEMBUFP(14):=LOGICAL(SCANP);<<SECTOR>>       <<MS.00>>06932000
                  @MEMBUFP:=@MEMBUFP + 15; <<BUMP ADDR.>>      <<MS.00>>06934000
                 END; << END: WHILE STATEMENT >>               <<MS.00>>06936000
                                                               <<MS.00>>06938000
DONEBLD:                                                       <<MS.00>>06940000
                MEMBUFP(14):=0; << TERMINATOR >>               <<MS.00>>06942000
                IF  (SCANP<>0D OR SCANP<>1D) THEN GO HEADER';  <<MS.00>>06944000
               END; << VER./UPD/FIX NEQ >>                     <<MS.00>>06946000
             END; << PMAPCODE <> 1023 >>                       <<00740>>06948000
            END; << CC: NEQ - FOPEN >>                         <<MS.00>>06950000
           FCLOSE(PMAPFILE,0,0); << CLOSE IT >>                <<MS.00>>06952000
           PMAPFILE := 0;  << MAKE IT NON-EXISTENT >>          <<MS.00>>06954000
           END; << SAME'SYSTEM = FALSE >>                      <<MS.00>>06956000
                                                               <<MS.00>>06958000
HEADER':                                                       <<MS.00>>06960000
        TBUF:="  ";     <<ITS A WORD NOT A BYTE>>              <<00221>>06962000
         MOVE TBUF(1):=TBUF,(74);     <<BLANK BUFFER>>                  06964000
         MOVE TBUF:="HP3000     MEMORY DUMP";                  <<04711>>06966000
         MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                   <<04665>>06968000
         MOVE TBUF(11):=LVL, (4);                             <<<01.02>>06970000
         MOVE TBUF(15):="OF SYS VER";                         <<<01.02>>06972000
         MOVE TBUF(22):="UPDATE      FIX     DUMP TIME ";               06974000
   TBUF(20):=FIXIT(CORE(VERNO));                               <<01875>>06976000
   TBUF(26):=FIXIT(CORE(UPNO));                                <<01875>>06978000
   TBUF(30):=FIXIT(CORE(FNO));                                 <<01875>>06980000
RECOVER'DATE(TBUF);                                            <<03083>>06982000
         PAGENO:=0;                                                     06984000
         BANKNO:=0;                                                     06986000
         INDXARAY:=0;                                                   06988000
         MOVE INDXARAY (1) := INDXARAY, ((LSTSYSDST+2) * 2);   <<03556>>06990000
         MPEMIT2:=FOPEN(MPEMIT2N,5,0);     <<OPEN MPEMIT2>>    <<00221>>06992000
          IF = THEN                                            <<00221>>06994000
           BEGIN          <<SEE IF CUSTOM, IF NOT FCLOSE>>     <<00221>>06996000
            FGETINFO(MPEMIT2,,,,,,,,MPEFCODE);                 <<00221>>06998000
            IF MPEFCODE<>1020 THEN                             <<00221>>07000000
             BEGIN        <<NOT TO BE LISTED>>                 <<00221>>07002000
              FCLOSE(MPEMIT2,0,0);   <<CLOSE IT>>              <<00221>>07004000
              MPEMIT2:=0;                                      <<00221>>07006000
             END          <<NOT TO BE LISTED>>                 <<00221>>07008000
            ELSE                                               <<00221>>07010000
             BEGIN        <<READ HEADER LINES>>                <<00221>>07012000
              FREAD(MPEMIT2,COPYRITE(16),-56);                 <<00221>>07014000
              FREAD(MPEMIT2,COPYRITE(45),-40);                 <<00221>>07016000
             END;         <<READ HEADER LINES>>                <<00221>>07018000
           END;           <<SEE IF CUSTOM, IF NOT FCLOSE>>     <<00221>>07020000
      END;                                                              07022000
                                                                        07024000
$PAGE "RECOVER'DATE: Convert calender and clock to date and time"       07026000
$CONTROL SEGMENT=INIT                                                   07028000
COMMENT                                                                 07030000
                                                                        07032000
Purpose:                                                                07034000
     Dig out a date from data in TBUF.  Called by TAPETODISK.           07036000
                                                                        07038000
Input parameters:                                                       07040000
                                                                        07042000
Output parameters:                                                      07044000
                                                                        07046000
Globals Referenced:                                                     07048000
                                                                        07050000
Globals Altered:                                                        07052000
                                                                        07054000
Data Structures:                                                        07056000
                                                                        07058000
Algorithm:                                                              07060000
                                                                        07062000
;                                                                       07064000
PROCEDURE RECOVER'DATE(TBUF);                                  <<03083>>07066000
ARRAY TBUF;                                                    <<03083>>07068000
BEGIN                                                          <<03083>>07070000
   EQUATE TRLDSTNO=%23;                                        <<s8446>>07072000
   INTEGER D,D',Y,M,H;                                         <<03083>>07074000
   DOUBLE LOCTRL,T'CONVERT;                                    <<03083>>07076000
   DEFINE TIME'MOD'TOS=ASSEMBLE(DDIV;DELB)#,                   <<03083>>07078000
          DUPLICATE=ASSEMBLE(DUP)#;                            <<03083>>07080000
   REAL TICK'TO'MS :=9.14566375E-2;                            <<03083>>07082000
         LOCTRL:=DSTTOADDR(TRLDSTNO);                          <<s8446>>07084000
         TOS:=CORE(LOCTRL+7D);  <<YEAR:JULIAN DAY>>            <<03083>>07086000
         DUPLICATE;                                            <<03083>>07088000
         D:=TOS.(7:9);          <<JULIAN DAY>>                 <<03083>>07090000
         Y:=TOS.(0:7);          <<YEAR>>                       <<03083>>07092000
         TOS:=CORE(LOCTRL+5D);                                 <<03083>>07094000
         TOS:=CORE(LOCTRL+6D);                                 <<03083>>07096000
         IF MACHINEID = MODEL25 THEN                           <<03083>>07098000
         BEGIN                                                 <<03083>>07100000
                                                               <<03083>>07102000
         << BACKWARDS COMPATABILITY CHECK:  CHANGE TO 33   >>  <<03083>>07104000
         << INTRODUCED IN B.01.01.  BEFORE THEN, THE THREE >>  <<03083>>07106000
         << CELLS CHECKED HERE WERE NOT USED AND           >>  <<03083>>07108000
         << INITIALLY WERE SET TO ZERO.                    >>  <<03083>>07110000
         << THESE CELLS ARE THE SYSGLOB EXTENSION VERSION, >>  <<03083>>07112000
         << UPDATE, AND FIX LEVELS (MIT NUMBERS, NOT       >>  <<03083>>07114000
         << MODIFYABLE.                                    >>  <<03083>>07116000
         IF  CORE( SYSGLOBX'VER ) = 0  AND                     <<03083>>07118000
             CORE( SYSGLOBX'UPD ) = 0  AND                     <<03083>>07120000
             CORE( SYSGLOBX'FIX ) = 0  THEN                    <<03083>>07122000
         BEGIN                                                 <<03083>>07124000
                                                               <<03083>>07126000
            << SERIES 33'S STORE NUMBER OF TICKS, NOT MS. >>   <<03083>>07128000
               T'CONVERT := TOS;                               <<03083>>07130000
               T'CONVERT:=FIXR( REAL(T'CONVERT)*TICK'TO'MS);   <<03083>>07132000
               TOS := T'CONVERT;                               <<03083>>07134000
                                                               <<03083>>07136000
            END;  << BACKWARDS COMPATABILITY CHECK. >>         <<03083>>07138000
                                                               <<03083>>07140000
         END;                                                  <<03083>>07142000
         TOS:=60000D;                                          <<03083>>07144000
         ASSEMBLE(DDIV; DDEL); <<MINUTES>>                     <<03083>>07146000
         TOS:=60D;                                             <<03083>>07148000
         TIME'MOD'TOS;     <<HOURS>>                           <<03083>>07150000
         M:=TOS;           <<REMAINDER=MINUTES>>               <<03083>>07152000
         TOS:=24D;                                             <<03083>>07154000
         TIME'MOD'TOS;      <<DAYS>>                           <<03083>>07156000
         H:=TOS;     <<REMAINDER= HOURS>>                      <<03083>>07158000
         ASSEMBLE(DELB);                                       <<03083>>07160000
         D:=D+TOS;     <<UPDATE JULIAN DAY>>                   <<03083>>07162000
         TOS:=Y;                                               <<03083>>07164000
         TOS:=4;                                               <<03083>>07166000
         ASSEMBLE(DIV);     <<TEST FOR LEAP YEAR>>             <<03083>>07168000
         IF TOS=0 THEN D':=366                                 <<03083>>07170000
         ELSE D':=365;                                         <<03083>>07172000
         ASSEMBLE(DEL);                                        <<03083>>07174000
         TOS:=D;                                               <<03083>>07176000
         TOS:=D';                                              <<03083>>07178000
         ASSEMBLE(DIV);     <<GET EXTRA YEARS>>                <<03083>>07180000
         D:=TOS;     <<REMAINDER= DAYS>>                       <<03083>>07182000
       D:=D+INTEGER(CORE(LOCTRL+3D));                          <<s7922>>07184000
         Y:=Y+TOS;                                             <<03083>>07186000
         IF Y > 99 THEN Y:=Y-100;                              <<03083>>07188000
         TOS.(0:7):=Y;                                         <<03083>>07190000
         TOS.(7:9):=D;                                         <<03083>>07192000
         CALENDAR:=TOS;                                        <<03083>>07194000
         TOS.(0:8):=H;                                         <<03083>>07196000
         TOS.(8:8):=M;                                         <<03083>>07198000
         CLOCK:=TOS;                                           <<03083>>07200000
         GETDATE;                                              <<03083>>07202000
END;                                                           <<03083>>07204000
                                                                        07206000
$PAGE "GETDATE: Format date"                                            07208000
$CONTROL SEGMENT=INIT                                          <<01.3A>>07210000
COMMENT                                                                 07212000
                                                                        07214000
Purpose:                                                                07216000
    Do some work for RECOVER'DATE, which is the sole caller.            07218000
                                                                        07220000
Input parameters:                                                       07222000
                                                                        07224000
Output parameters:                                                      07226000
                                                                        07228000
Globals Referenced:                                                     07230000
                                                                        07232000
Globals Altered:                                                        07234000
                                                                        07236000
Data Structures:                                                        07238000
                                                                        07240000
Algorithm:                                                              07242000
                                                                        07244000
;                                                                       07246000
PROCEDURE GETDATE;                                                      07248000
      BEGIN                                                             07250000
         INTEGER ARRAY DAYSPERMONTH(0:11)=PB:=                          07252000
         0,31,60,91,121,152,182,213,244,274,305,335;                    07254000
         INTEGER DATE=Q+1,TIME=Q+2,YEAR=Q+3,DAY=Q+4,X=X,HOUR=DAY;       07256000
         EQUATE NOON=12*256;                                            07258000
                                                                        07260000
                                                                        07262000
         SUBROUTINE CONVERT(N,POSITION);                                07264000
         VALUE N,POSITION;                                              07266000
         INTEGER N,POSITION;                                            07268000
         BEGIN                                                          07270000
            X:=POSITION;                                                07272000
            TOS:=N;                                                     07274000
            ASSEMBLE(LDI 10;DIV,XCH);                                   07276000
            STRING(X):=TOS+"0";                                         07278000
            STRING(X:=X+1):=TOS+"0";                                    07280000
         END;    <<CONVERT>>                                            07282000
         TOS:=CALENDAR;                                                 07284000
         TOS:=CLOCK;                                                    07286000
         TOS:=DATE.(0:7);TOS:=DATE.(7:9);                               07288000
         X:=((YEAR-1)&ASR(2)+YEAR+DAY) MOD 7*3;  <<DAY OF WEEK>>        07290000
         MOVE STRING:="  /  /  ,   :  AM";                              07292000
         IF YEAR.(14:2) <> 0 AND DAY >=60 THEN DAY:=DAY+1;              07294000
         IF 1 <= DAY <= 366 THEN ELSE RETURN;                  <<01.KS>>07296000
            << PREVENT OUT OF BOUNDS DAYSPERMONTH INDEX>>      <<08.EB>>07298000
         X:=12;                                                         07300000
         DO X:=X-1 UNTIL DAYSPERMONTH(X)< DAY;                          07302000
         DAY:=DAY-DAYSPERMONTH(X);                                      07304000
         CONVERT(X:=X+1,0);                                             07306000
         IF STRING="0" THEN STRING:=" ";                                07308000
         CONVERT(DAY,3);                                                07310000
         CONVERT(YEAR,6);                                               07312000
         TOS:=(TIME.(0:8)+11) MOD 12+1;                                 07314000
         CONVERT(*,10);                                                 07316000
         IF STRING(10)="0" THEN STRING(10):=" ";                        07318000
         CONVERT(TIME.(8:8),13);                                        07320000
         IF TIME >= NOON THEN STRING(15):="P";                          07322000
         END;                                                           07324000
                                                                        07326000
$PAGE "TAPE'MODIFY'ERROR: Note tape modification errors"                07328000
$CONTROL SEGMENT=INIT                                                   07330000
PROCEDURE TAPE'MODIFY'ERROR(MSGNUM,FILENUM);                   <<03083>>07332000
  VALUE MSGNUM;                                                <<03083>>07334000
  INTEGER MSGNUM,                                              <<03083>>07336000
          FILENUM;                                             <<03083>>07338000
COMMENT                                                                 07340000
                                                                        07342000
Purpose:                                                                07344000
                                                                        07346000
Input parameters:                                                       07348000
                                                                        07350000
Output parameters:                                                      07352000
                                                                        07354000
Globals Referenced:                                                     07356000
                                                                        07358000
Globals Altered:                                                        07360000
                                                                        07362000
Data Structures:                                                        07364000
                                                                        07366000
Algorithm:                                                              07368000
                                                                        07370000
;                                                                       07372000
  BEGIN                                                        <<03083>>07374000
    INTEGER ERRORCODE;                                         <<03083>>07376000
                                                               <<03083>>07378000
    MOVE DBUFFER:="** DPAN ERROR --";                          <<03083>>07380000
    PRINT(DBUFFER,-16,%320);                                   <<03083>>07382000
    CASE MSGNUM OF                                             <<03083>>07384000
      BEGIN                                                    <<03083>>07386000
      MOVE DBUFFER:="FWRITE FAILURE IN WRITE TO TAPE     ";    <<03083>>07388000
      MOVE DBUFFER:="FWRITE ERROR TEMP FILE WRITE FAILURE";    <<03083>>07390000
      MOVE DBUFFER:="FREAD ERROR IN READ FROM DISC FILE  ";    <<03083>>07392000
      MOVE DBUFFER:="FCONTROL ERROR IN EOF WRITE TO TAPE ";    <<03083>>07394000
      MOVE DBUFFER:="FSPACE ERROR IN MOVEMENT OF TAPE    ";    <<03083>>07396000
      MOVE DBUFFER:="FOPEN ERROR -- DISC FILE OPEN FAILED";    <<03083>>07398000
      MOVE DBUFFER:="FCLOSE ERROR -- TEMP FILE NOT CLOSED";    <<03083>>07400000
      MOVE DBUFFER:="FCLOSE ERROR -- DISC FILE NOT CLOSED";    <<03083>>07402000
      BEGIN                                                    <<03083>>07404000
        FCHECK(FILENUM,ERRORCODE);                             <<03083>>07406000
        IF ERRORCODE = 38 THEN                                 <<03083>>07408000
          BEGIN                                                <<03083>>07410000
          MOVE LOADMAP:="LOADMAP.PUB.SYS;";                    <<03083>>07412000
          MOVE MAPNAME:="MPECHECK.PUB.SYS;";                   <<03083>>07414000
          MOVE DBUFFER:="TAPE PARITY ERROR -- FILES INVALID";  <<03083>>07416000
          PRINT(DBUFFER,-34,0);                                <<03083>>07418000
          MOVE DBUFFER:="DUMP MAY INCLUDE SEVERAL INVALID";    <<03083>>07420000
          PRINT(DBUFFER,-32,0);                                <<03083>>07422000
          MOVE DBUFFER:="FILE REFERENCES IN FORMATTED TABLE  ";<<03083>>07424000
          END                                                  <<03083>>07426000
        ELSE                                                   <<03083>>07428000
          BEGIN                                                <<03083>>07430000
          MOVE DBUFFER:="FWRITE FAILURE IN WRITE TO TAPE     ";<<03083>>07432000
          MSGNUM:=0;                                           <<03083>>07434000
          END;                                                 <<03083>>07436000
      END;                                                     <<03083>>07438000
      BEGIN                                                    <<03083>>07440000
        MOVE DBUFFER:="INVALID DUMP TAPE -- CATASTROPHIC TAPE";<<03083>>07442000
        PRINT(DBUFFER,-38,0);                                  <<03083>>07444000
        MOVE DBUFFER:="ERRORS -- UNABLE TO READ DUMP       ";  <<03083>>07446000
        MSGNUM:=0;                                             <<03083>>07448000
      END;                                                     <<03083>>07450000
      BEGIN                                                    <<03083>>07452000
        FILE'REQUIRED:=TRUE;                                   <<03083>>07454000
        MOVE DBUFFER:="TAPE INCORRECTLY PREPARED           ";  <<03083>>07456000
      END;                                                     <<03083>>07458000
      END;                                                     <<03083>>07460000
    PRINT(DBUFFER,-36,0);                                      <<03083>>07462000
    IF MSGNUM <> 10 THEN                                       <<03083>>07464000
      PRINT'FILE'INFO(FILENUM);                                <<03083>>07466000
    IF MSGNUM < 6 THEN                                         <<03083>>07468000
       QUIT(MSGNUM);                                           <<03083>>07470000
  END;                                                         <<03083>>07472000
                                                                        07474000
$PAGE "PRINTING UTILITIES"                                              07476000
$CONTROL SEGMENT=UTIL                                                   07478000
COMMENT                                                                 07480000
                                                                        07482000
Purpose:                                                                07484000
     There are several printing utilities available in DPAN.            07486000
     These not only make output easier, but maintain global             07488000
     variables like PAGENO.                                             07490000
                                                                        07492000
Input parameters:                                                       07494000
                                                                        07496000
Output parameters:                                                      07498000
                                                                        07500000
Globals Referenced:                                                     07502000
     DBUFFER is the print buffer.                                       07504000
     BBUF is the byte equivalent of DBUFFER                             07506000
     @BBUF points to BBUF                                               07508000
     LPF fileno of output file DPANLIST                                 07510000
     PAGENO current page number                                         07512000
     LINECOUNT current line number on page                              07514000
     LNSPERPG maximum lines per page                                    07516000
                                                                        07518000
Globals Altered:                                                        07520000
                                                                        07522000
Data Structures:                                                        07524000
                                                                        07526000
Algorithm:                                                              07528000
                                                                        07530000
;                                                                       07532000
<<             PUT NUMBER                                         >>    07534000
<<    THIS PROCEDURE CONVERTS A NUMBER INTO AN ASCII              >>    07536000
<<    REPRESENTATION OF OCTAL AND STORES IT INTO THE PRINT BUFFER >>    07538000
<<    AT THE CURRENT POINTER AND ADVANCES THE POINTER.            >>    07540000
<<    THE NUMBER ALWAYS OCCUPIES A SEVEN POSITION FIELD WITH A << WBT >>07542000
<<    TRAILING BLANK.  PUTNUM DOES NOT SUPPRESS LEADING ZEROS. << WBT >>07544000
<<    PUTNUMP SUPPRESSES LEADING ZEROS AND DOES NOT ALTER THE  << WBT >>07546000
<<    LOCATIONS WHERE THEY WOULD HAVE BEEN PUT.  THE NUMBERS AR<< WBT >>07548000
<<    RIGHT JUSTIFIED IN THE FIELD (EXCEPT FOR THE TRAILING BLA<< WBT >>07550000
<<                                                             << WBT >>07552000
PROCEDURE PUTNUM(NUM);                                                  07554000
      VALUE NUM;                                                        07556000
      INTEGER NUM;                                                      07558000
      BEGIN                                                             07560000
         INTEGER I:=5;                                                  07562000
         LOGICAL FLAG:=FALSE;                                           07564000
         ENTRY PUTNUMP;                                                 07566000
         FLAG:=TRUE;                                                    07568000
PUTNUMP:                                                                07570000
        BBUF(140):=" ";                                                 07572000
        MOVE BBUF(141):=BBUF(140),(15);                                 07574000
        TOS:=NUM;                                                       07576000
        TOS:=TOS&CSL(1);                                                07578000
        TOS:=S0.(15:1);                                                 07580000
LOOP:                                                                   07582000
        IF <> OR FLAG OR I=0 THEN                                       07584000
        BEGIN                                                           07586000
           PBUF:=TOS+"0";                                               07588000
           FLAG:=TRUE;                                                  07590000
        END ELSE                                                        07592000
        BEGIN                                                           07594000
           DEL;                                                         07596000
        END;                                                            07598000
        @PBUF:=@PBUF+1;                                                 07600000
        I:=I-1;                                                         07602000
        IF < THEN                                                       07604000
        BEGIN                                                           07606000
           PBUF:=" ";                                                   07608000
           @PBUF:=@PBUF+1;                                              07610000
           RETURN;                                                      07612000
        END;                                                            07614000
        TOS:=TOS&CSL(3);                                                07616000
        TOS:=S0.(13:3);                                                 07618000
        GO LOOP;                                                        07620000
     END;                                                               07622000
                                                                        07624000
$PAGE "PUTNZ(NUM,COL): Put non-zero numbers in PBUF"                    07626000
$CONTROL SEGMENT=UTIL                                                   07628000
COMMENT                                                                 07630000
                                                                        07632000
Purpose:                                                                07634000
          PLACE NUM IN PRINT BUFFER WITH RIGHTMOST DIGIT       << WBT >>07636000
          AT COLUMN COL.  IF ZERO, DO NOTHING                  << WBT >>07638000
                                                                        07640000
Input parameters:                                                       07642000
                                                                        07644000
Output parameters:                                                      07646000
                                                                        07648000
Globals Referenced:                                                     07650000
                                                                        07652000
Globals Altered:                                                        07654000
                                                                        07656000
Data Structures:                                                        07658000
                                                                        07660000
Algorithm:                                                              07662000
                                                                        07664000
;                                                                       07666000
   PROCEDURE PUTNZ(NUM, COL);                                  << WBT >>07668000
      VALUE NUM, COL;                                          << WBT >>07670000
      LOGICAL NUM;                                             << WBT >>07672000
      INTEGER COL;                                             << WBT >>07674000
      BEGIN                                                    << WBT >>07676000
      ENTRY PUTOCTALP;                                         << WBT >>07678000
         IF NUM=0 THEN RETURN;                                 << WBT >>07680000
PUTOCTALP:  @PBUF:=@BBUF+COL-6;                                << WBT >>07682000
         PUTNUMP(NUM);                                         << WBT >>07684000
      END;                                                     << WBT >>07686000
                                                                        07688000
$PAGE "PUTOCTAL(NUM,COL): Write octal value to PBUF"                    07690000
$CONTROL SEGMENT=UTIL                                                   07692000
COMMENT                                                                 07694000
                                                                        07696000
Purpose:                                                                07698000
     Simplify writing octal values to PBUF.                             07700000
                                                                        07702000
Input parameters:                                                       07704000
                                                                        07706000
Output parameters:                                                      07708000
                                                                        07710000
Globals Referenced:                                                     07712000
                                                                        07714000
Globals Altered:                                                        07716000
                                                                        07718000
Data Structures:                                                        07720000
                                                                        07722000
Algorithm:                                                              07724000
                                                                        07726000
;                                                                       07728000
   PROCEDURE PUTOCTAL(NUM, COL);                               << WBT >>07730000
   VALUE NUM, COL;                                             << WBT >>07732000
   LOGICAL NUM; INTEGER COL;                                   << WBT >>07734000
   BEGIN                                                       << WBT >>07736000
      @PBUF:=@BBUF+COL-6;                                      << WBT >>07738000
      PUTNUM(NUM);                                             << WBT >>07740000
   END;                                                        << WBT >>07742000
                                                                        07744000
$PAGE "DCONS(HI,LO): Join HI and LO into a doubleword"                  07746000
$CONTROL SEGMENT=UTIL                                                   07748000
COMMENT                                                                 07750000
                                                                        07752000
Purpose:                                                                07754000
                                                                        07756000
Input parameters:                                                       07758000
                                                                        07760000
Output parameters:                                                      07762000
                                                                        07764000
Globals Referenced:                                                     07766000
                                                                        07768000
Globals Altered:                                                        07770000
                                                                        07772000
Data Structures:                                                        07774000
                                                                        07776000
Algorithm:                                                              07778000
                                                                        07780000
;                                                                       07782000
DOUBLE PROCEDURE DCONS(HI,LO);                                 <<01875>>07784000
VALUE HI, LO; LOGICAL HI,LO;                                   <<01875>>07786000
BEGIN                                                          <<01875>>07788000
   TOS:=HI;                                                    <<01875>>07790000
   TOS:=LO;                                                    <<01875>>07792000
   DCONS:=TOS;                                                 <<01875>>07794000
END;                                                           <<01875>>07796000
                                                                        07798000
$PAGE "PUTDNUM: Convert doubleword value to ascii, place in PBUF"       07800000
$CONTROL SEGMENT=UTIL                                                   07802000
COMMENT                                                                 07804000
                                                                        07806000
Purpose:                                                                07808000
<<             PUT DOUBLE NUMBER                                  >>    07810000
<<    THIS PROCEDURE CONVERTS A DOUBLE WORD NUMBER INTO AN ASCII  >>    07812000
<<    REPRESENTATION OF OCTAL AND STORES IT INTO THE PRINT BUFFER >>    07814000
<<    AT THE CURRENT POINTER AND ADVANCES THE POINTER             >>    07816000
<<                                                                >>    07818000
                                                                        07820000
Input parameters:                                                       07822000
                                                                        07824000
Output parameters:                                                      07826000
                                                                        07828000
Globals Referenced:                                                     07830000
                                                                        07832000
Globals Altered:                                                        07834000
                                                                        07836000
Data Structures:                                                        07838000
                                                                        07840000
Algorithm:                                                              07842000
                                                                        07844000
;                                                                       07846000
PROCEDURE PUTDNUM(DNUM);                                                07848000
      VALUE DNUM;                                                       07850000
      DOUBLE DNUM;                                                      07852000
      BEGIN                                                             07854000
         LOGICAL FLAG:=FALSE;                                           07856000
         INTEGER I:=10;                                        <<01.02>>07858000
         ENTRY PUTDNUMP;                                       <<01.02>>07860000
         FLAG:=TRUE;                                           <<01.02>>07862000
PUTDNUMP:                                                      <<01.02>>07864000
           BBUF(140):=" ";                                     <<01.02>>07866000
           MOVE BBUF(141):=BBUF(140),(15);                     <<01.02>>07868000
           TOS:=DNUM;                                          <<01.02>>07870000
           TOS:=TOS&DCSL(1);<<GET LOW ORDER BIT>>              <<01.02>>07872000
           TOS:=S0.(15:1);                                     <<01.02>>07874000
           IF <> THEN                                          <<01.02>>07876000
           BEGIN                                               <<01.02>>07878000
              PBUF:="-"; DEL;                                  <<01.02>>07880000
              @PBUF:=@PBUF+1;                                  <<01.02>>07882000
              TOS:=TOS&DCSR(1);                                <<*8814>>07884000
              TOS:=-TOS;                                       <<*8814>>07886000
              IF S0=0 THEN S1:=-S1                             <<*8814>>07888000
              ELSE S1:=-S1-1;                                  <<*8814>>07890000
              TOS:=TOS&DCSL(1);                                <<*8814>>07892000
           END ELSE DEL;                                       <<01.02>>07894000
           TOS:=TOS&DCSL(1);<<GET NEXT LOW ORDER BIT>>         <<01.02>>07896000
           TOS:=S0.(15:1);                                     <<01.02>>07898000
LOOP:                                                          <<01.02>>07900000
           IF <> OR FLAG OR I=0 THEN                           <<01.02>>07902000
           BEGIN                                               <<01.02>>07904000
              PBUF:=TOS+"0";                                   <<01.02>>07906000
              FLAG:=TRUE;                                      <<01.02>>07908000
              @PBUF:=@PBUF+1;                                  <<01.02>>07910000
           END ELSE DEL;                                       <<01.02>>07912000
           I:=I-1;                                             <<01.02>>07914000
           IF < THEN                                           <<01.02>>07916000
           BEGIN                                               <<01.02>>07918000
              PBUF:=" ";                                       <<01.02>>07920000
              @PBUF:=@PBUF+1;                                  <<01.02>>07922000
              RETURN;                                          <<01.02>>07924000
           END;                                                <<01.02>>07926000
           TOS:=TOS&DCSL(3);                                   <<01.02>>07928000
           TOS:=S0.(13:3);                                     <<01.02>>07930000
           GO LOOP;                                            <<01.02>>07932000
        END;<<PUTDNUM/PUTDNUMP>>                               <<01.02>>07934000
                                                                        07936000
$PAGE "PRINTLINE: Print line and maintain LINECOUNT and newpage"        07938000
$CONTROL SEGMENT=UTIL                                                   07940000
PROCEDURE PRINTLINE;                                                    07942000
COMMENT                                                                 07944000
                                                                        07946000
Purpose:                                                                07948000
<<             PRINTLINE                                          >>    07950000
<<    THIS PROCEDURE WILL OUTPUT A LINE TO THE LINE PRINTER FROM  >>    07952000
<<    DBUFFER. AFTER PRINTING LINECOUNT IS INCREMENTED BY 1 AND   >>    07954000
<<    CHECKED FOR =60. IF SO NEWPAGE IS CALLED TO PRINT HEADER .  >>    07956000
<<    NEWPAGE WILL RESET LINECOUNT TO 0 PRIOR TO PRINTING         >>    07958000
<<    HEADER. AFTER PRINTING THE PRINT BUFFER IS FILLED WITH      >>    07960000
<<    BLANKS.                                                     >>    07962000
<<                                                                >>    07964000
                                                                        07966000
Input parameters:                                                       07968000
                                                                        07970000
Output parameters:                                                      07972000
                                                                        07974000
Globals Referenced:                                                     07976000
                                                                        07978000
Globals Altered:                                                        07980000
                                                                        07982000
Data Structures:                                                        07984000
                                                                        07986000
Algorithm:                                                              07988000
                                                                        07990000
;                                                                       07992000
      BEGIN                                                             07994000
         ENTRY BLANKBUF;                                                07996000
         IF NOPRFLAG THEN GO NOPRJMP;                          <<00221>>07998000
         FWRITE(LPF,DBUFFER,66,0);                                      08000000
         IF <> THEN                                                     08002000
         BEGIN                                                          08004000
           PRINT'FILE'INFO(LPF);                                        08006000
           ERROR;                                                       08008000
         END;                                                           08010000
NOPRJMP:   <<NO PRINT JUMP POINT>>                             <<00221>>08012000
         @PBUF:=@BBUF;                                                  08014000
         LINECOUNT:=LINECOUNT+1;                                        08016000
BLANKBUF:                                                               08018000
         DBUFFER:="  ";                                                 08020000
         MOVE DBUFFER(1):=DBUFFER,(65);                                 08022000
         IF LINECOUNT > LNSPERPG THEN NEWPAGE;                 <<00221>>08024000
      END;                                                              08026000
                                                                        08028000
$PAGE "SKIPLINES: Skip N lines, maintain linecount and newpage"         08030000
$CONTROL SEGMENT=UTIL                                                   08032000
COMMENT                                                                 08034000
                                                                        08036000
Purpose:                                                                08038000
<<             SKIP LINES                                         >>    08040000
<<    THIS PROCEDURE SKIPS THE SPECIFIED NUMBER OF LINES.         >>    08042000
<<    FIRST A CHECK IS MADE FOR LINECOUNT+ NUMBER OF LINES TO     >>    08044000
<<    BE SKIPPED =>60.  IF SO NO LINES ARE SKIPPED AND NEWPAGE    >>    08046000
<<    IS CALLED.ELSE LINES ARE SKIPPED AND LINECOUNT IS           >>    08048000
<<    INCREMENTED BY THE NUMBER OF LINES SKIPPED.                 >>    08050000
<<                                                                >>    08052000
                                                                        08054000
Input parameters:                                                       08056000
                                                                        08058000
Output parameters:                                                      08060000
                                                                        08062000
Globals Referenced:                                                     08064000
                                                                        08066000
Globals Altered:                                                        08068000
                                                                        08070000
Data Structures:                                                        08072000
                                                                        08074000
Algorithm:                                                              08076000
                                                                        08078000
;                                                                       08080000
PROCEDURE SKIPLINES(NLINES);                                            08082000
      VALUE NLINES;                                                     08084000
      INTEGER NLINES;                                                   08086000
      BEGIN                                                             08088000
         LINECOUNT:=LINECOUNT+NLINES;                                   08090000
         IF LINECOUNT > LNSPERPG THEN                          <<00221>>08092000
         BEGIN                                                          08094000
            NEWPAGE;                                                    08096000
            GO TO ENDSKIP;                                              08098000
         END;                                                           08100000
         IF NOPRFLAG THEN RETURN;       <<SUPPRESS FLAG>>      <<00221>>08102000
         FWRITE(LPF,DBUFFER,0,(NLINES+%200));                           08104000
         IF <> THEN                                                     08106000
         BEGIN                                                          08108000
           PRINT'FILE'INFO(LPF);                                        08110000
           ERROR;                                                       08112000
         END;                                                           08114000
ENDSKIP:                                                                08116000
         END;                                                           08118000
                                                                        08120000
$PAGE "NEWPAGE: Skip page, update pagecount, linecount"                 08122000
$CONTROL SEGMENT=UTIL                                                   08124000
COMMENT                                                                 08126000
                                                                        08128000
Purpose:                                                                08130000
<<             NEW PAGE                                           >>    08132000
<<    THIS PROCEDURE CHECKS FOR LINECOUNT<60 AND PAGE EJECTS      >>    08134000
<<    IF SO.  LINECOUNT IS RESET TO 0 AND A HEADER LINE IS        >>    08136000
<<    PRINTED.                                                    >>    08138000
<<                                                                >>    08140000
                                                                        08142000
Input parameters:                                                       08144000
                                                                        08146000
Output parameters:                                                      08148000
                                                                        08150000
Globals Referenced:                                                     08152000
                                                                        08154000
Globals Altered:                                                        08156000
                                                                        08158000
Data Structures:                                                        08160000
                                                                        08162000
Algorithm:                                                              08164000
                                                                        08166000
;                                                                       08168000
PROCEDURE NEWPAGE;                                                      08170000
      BEGIN                                                             08172000
         IF LINECOUNT = 3 THEN RETURN;  <<ALREADY AT TOF>>     <<00221>>08174000
         PAGENO:=PAGENO+1;                                              08176000
         LINECOUNT:=0;                                                  08178000
         BLANKBUF;                                                      08180000
         IF NOPRFLAG THEN                                      <<00221>>08182000
          BEGIN                                                <<00221>>08184000
           LINECOUNT:=3;              <<CORRECT LINE COUNT>>   <<00221>>08186000
           RETURN;                                             <<00221>>08188000
          END;                                                 <<00221>>08190000
         FWRITE(LPF,DBUFFER,0,%61);                                     08192000
         MOVE DBUFFER:=TBUF,(50);                                       08194000
         MOVE DBUFFER(61):="PAGE";                                      08196000
         IF BNKFLG THEN                                        <<00221>>08198000
         IF ASCII(BANKNO,8,BBUF(108)) = 1 THEN               <<00.01>>  08200000
MOVE BBUF(104):="  BANK   "                                    <<00221>>08202000
         ELSE                                                  <<00.01>>08204000
            MOVE BBUF(104):="  BANK %";                        <<00.01>>08206000
         ASCII(PAGENO,10,PSTRING);                                      08208000
         PRINTLINE;                                                     08210000
          BLANKBUF;                                           <<<01.02>>08212000
          MOVE DBUFFER:=COPYRITE,(66);                         <<00221>>08214000
          PRINTLINE;                                          <<<01.02>>08216000
          SKIPLINES(1);                                       <<<01.02>>08218000
      END;                                                              08220000
                                                                        08222000
$PAGE "ERROR: Call intrinsic terminate"                                 08224000
$CONTROL SEGMENT=UTIL                                                   08226000
COMMENT                                                                 08228000
                                                                        08230000
Purpose:                                                                08232000
<<             ERROR                                              >>    08234000
<<    THIS PROCEDURE PRINTS OPERATIONAL ERRORS ENCOUNTERED WITH   >>    08236000
<<    THE FILE SYSTEM.                                            >>    08238000
<<                                                                >>    08240000
                                                                        08242000
Input parameters:                                                       08244000
                                                                        08246000
Output parameters:                                                      08248000
                                                                        08250000
Globals Referenced:                                                     08252000
                                                                        08254000
Globals Altered:                                                        08256000
                                                                        08258000
Data Structures:                                                        08260000
                                                                        08262000
Algorithm:                                                              08264000
                                                                        08266000
;                                                                       08268000
PROCEDURE ERROR;                                                        08270000
      BEGIN                                                             08272000
         INTRINSIC TERMINATE;                                           08274000
         TERMINATE;                                                     08276000
         END;                                                           08278000
                                                                        08280000
$PAGE "FILCSTBLK: Copy CST block table into array of pointers"          08282000
$CONTROL SEGMENT=UTIL                                                   08284000
COMMENT                                                                 08286000
                                                                        08288000
Purpose:                                                                08290000
           THIS PROCEDURE COPIES THE CST BLOCK TABLE INTO      << WBT >>08292000
           THE ARRAY LCSTBLK=ICSTBLK.  A MAXIMUM OF 100        << WBT >>08294000
           ENTRIES ARE COPIED.  CSTBLK(0) IS THE NUMBER        << WBT >>08296000
           OF ENTRIES.  EACH ENTRY IS A DST RELATIVE INDEX     << WBT >>08298000
           TO A CSTX BLOCK.  %177777 INDICATES AN UNUSED       << WBT >>08300000
           ENTRY                                               << WBT >>08302000
Theoretically, the maximum should be 128, and 512 in MPE V.             08304000
Called by FILLMEMBUF and PRINTXCST. Redundant?                          08306000
                                                                        08308000
Input parameters:                                                       08310000
                                                                        08312000
Output parameters:                                                      08314000
                                                                        08316000
Globals Referenced:                                                     08318000
                                                                        08320000
Globals Altered:                                                        08322000
                                                                        08324000
Data Structures:                                                        08326000
                                                                        08328000
Algorithm:                                                              08330000
                                                                        08332000
;                                                                       08334000
PROCEDURE FILCSTBLK;                                           <<01.02>>08336000
BEGIN                                                          <<01.02>>08338000
                                                               <<01.02>>08340000
DOUBLE SCRATCH;                                                <<01.02>>08342000
LOGICAL ARRAY SCR0(*)=SCRATCH;                                 <<01.02>>08344000
LOGICAL ARRAY SCR1(*)=SCR0(1);                                 <<01.02>>08346000
LOGICAL WORK1,WORK2;                                           <<01.02>>08348000
INTEGER INDX;                                                  <<01.02>>08350000
LOGICAL ARRAY DSTA(0:3);                                       <<01.02>>08352000
                                                               << WBT >>08354000
                                                               <<01.02>>08356000
<<BEGIN BODY OF PROCEDURE>>                                    <<01.02>>08358000
                                                               <<01.02>>08360000
SCRATCH:=0D;                                                   <<01.02>>08362000
SCR1:=DSTFLG;                                                  <<01.02>>08364000
IF INTEGER(SCR1)=0 THEN RETURN;<<DST ADR NO GOOD..CANT GO ON>> <<01.02>>08366000
SCR1:=SCR1+(4*%43);<<OFFSET TO CSTBLK DST IN TABLE>>           <<01.02>>08368000
WORK2:=0;                                                      <<01.02>>08370000
WHILE INTEGER(WORK2) < 4 DO                                    <<01.02>>08372000
BEGIN<<MOVE DST ENTRY TO LOCAL ARRAY>>                         <<01.02>>08374000
   DSTA(WORK2):=CORE(SCRATCH+DOUBLE(WORK2));                   <<01.02>>08376000
   WORK2:=WORK2+1;                                             <<01.02>>08378000
END;                                                           <<01.02>>08380000
IF DSTA.(0:1) =0 THEN GO GETBLK;<<DST IN MAIN MEM.>>           <<01.02>>08382000
IF DSTA(1).(1:15) = 0 THEN RETURN;<<REALLY ABSENT>>            <<01.02>>08384000
IF DSTA(3) <> 0 THEN <<PRESENT& ON OLSQ/LOKQ>>                 <<01.02>>08386000
GETBLK:                                                        <<01.02>>08388000
BEGIN                                                          <<01.02>>08390000
   SCR1:=DSTA(3);<<MEM ADR. OF CSTBLK DST#%43>>                <<01.02>>08392000
   WORK1:=CORE(SCRATCH);<<FIRST LOC. OF DST>>                  <<01.02>>08394000
   IF INTEGER(WORK1) <=0 THEN RETURN;<<#ENTRYS INVALID>>       <<01.02>>08396000
   IF INTEGER(WORK1) > 100 THEN WORK1:=100;<<SET ARBITRARY LIMI<<01.02>>08398000
   LCSTBLK:=WORK1;<<SET ARRAY LIMIT>>                          <<01.02>>08400000
   INDX:=1;                                                    <<01.02>>08402000
   WHILE INDX < INTEGER(WORK1) DO                              <<01.02>>08404000
   BEGIN                                                       <<01.02>>08406000
      LCSTBLK(INDX):=CORE(SCRATCH+DOUBLE(INDX));               <<01.02>>08408000
      INDX:=INDX+1;                                            <<01.02>>08410000
   END;                                                        <<01.02>>08412000
END;                                                           <<01.02>>08414000
END<<FILCSTBLK>>;                                              <<01.02>>08416000
                                                                        08418000
$PAGE "FIXPCBSTACK: initialize PCBSTACK array"                          08420000
$CONTROL SEGMENT=INIT                                                   08422000
COMMENT                                                                 08424000
                                                                        08426000
Purpose:                                                                08428000
     Called once by PROCESS'DUMP to initialize PCBSTACK array           08430000
                                                                        08432000
Input parameters:                                                       08434000
                                                                        08436000
Output parameters:                                                      08438000
                                                                        08440000
Globals Referenced:                                                     08442000
                                                                        08444000
Globals Altered:                                                        08446000
                                                                        08448000
Data Structures:                                                        08450000
                                                                        08452000
Algorithm:                                                              08454000
                                                                        08456000
;                                                                       08458000
PROCEDURE FIXPCBSTACK;                                         << WBT >>08460000
BEGIN                                                          << WBT >>08462000
   INTEGER INDX;                                               << WBT >>08464000
   LOGICAL STKDST;                                             << WBT >>08466000
   DOUBLE LOCPCB;                                              <<01791>>08468000
   EQUATE PCBSIZE=%25;                                         <<01791>>08470000
   OWN BYTE ARRAY PCBNAME(0:9):=9,"PCB TABLE";                 <<01875>>08472000
   PCBSTACK:=0;                                                << WBT >>08474000
   MOVE PCBSTACK(1):=PCBSTACK,(1023);                          << MCW >>08476000
   IF PCBDEFIN=0D OR DSTDEFIN=0D THEN RETURN;                  << WBT >>08478000
   PCB'ADDR:=LOCPCB:=VERIFYP(%3, %1003D);                      <<01791>>08480000
                                                                        08482000
  FOR INDX:=0 UNTIL 1023 DO                                             08484000
   IF INTEGER(PCB20)<0 THEN                                             08486000
      ISFREEPCB(INDX):=TRUE;                                            08488000
   INDX:=1;                                                    << WBT >>08490000
   DO                                                          << WBT >>08492000
   BEGIN                                                       << WBT >>08494000
      IF NOT ISFREEPCB(INDX) THEN                              << WBT >>08496000
      BEGIN                                                    << WBT >>08498000
         STKDST:=PCB03.(2:14);                                 << WBT >>08500000
         IF CORE(DSTDEFIN+DOUBLE(4*STKDST)).(0:1)=0 OR         << WBT >>08502000
            CORE(DSTDEFIN+DOUBLE(4*STKDST+1)).(1:1)=1          << WBT >>08504000
         THEN PCBSTACK(INDX):=STKDST;                          << WBT >>08506000
      END;                                                     << WBT >>08508000
      INDX:=INDX+1;                                            << WBT >>08510000
   END                                                         << WBT >>08512000
   UNTIL INDX >= INTEGER(CORE(LOCPCB))+1 OR  INDX >= 1025;     <<*8815>>08514000
   IF INDX >= 1025 THEN                                        <<*8815>>08516000
    BEGIN                                                      <<*8815>>08518000
     DBUFFER:="  "; MOVE DBUFFER(1):=DBUFFER,(99);             <<*8815>>08520000
     PRINTLINE;                                                <<*8815>>08522000
     MOVE BBUF := "** EITHER PCB OR PCB POINTER BAD **";       <<*8815>>08524000
     PRINTLINE;                                                <<*8815>>08526000
    END;                                                       <<*8815>>08528000
END; <<FIXPCBSTACK>>                                           << WBT >>08530000
                                                                        08532000
$PAGE "PUTSEGID : Classify a segment "                                  08534000
$CONTROL SEGMENT=UTIl                                                   08536000
                                                               <<01791>>08538000
PROCEDURE PUTSEGID(SEGID,SEGID1, COL);                         << MCW >>08540000
                                                               << MCW >>08542000
VALUE SEGID,SEGID1,COL;                                        << MCW >>08544000
LOGICAL SEGID, SEGID1, COL;                                    << MCW >>08546000
                                                               << MCW >>08548000
BEGIN                                                          << MCW >>08550000
LOGICAL SEGTYPE;                                               << MCW >>08552000
COMMENT                                                                 08554000
                                                                        08556000
Purpose:                                                                08558000
   This utility routine simply classifies a segment as to its           08560000
   type ( DST, CST, CSTX ).                                             08562000
                                                                        08564000
Input parameters:                                                       08566000
   SEGID - the segment identifier                                       08568000
                                                                        08570000
Output parameters:                                                      08572000
   COL - the column in the output buffer where the classification       08574000
         string belongs.                                                08576000
                                                                        08578000
Globals Referenced:                                                     08580000
                                                                        08582000
Globals Altered:                                                        08584000
                                                                        08586000
Data Structures:                                                        08588000
                                                                        08590000
Algorithm:                                                              08592000
                                                                        08594000
;                                                                       08596000
                                                               << MCW >>08598000
   SEGTYPE:=SEGID.(0:4);                                       << MCW >>08600000
   IF SEGID=0 AND SEGID1=0 THEN RETURN;                        << MCW >>08602000
   IF SEGTYPE=0 THEN        << DATA SEGMENT >>                 << MCW >>08604000
   BEGIN                                                       << MCW >>08606000
      MOVE BBUF(COL-1):="DST       0";                         << MCW >>08608000
      PUTOCTALP(SEGID1, COL+10);                               << MCW >>08610000
   END                                                         << MCW >>08612000
   ELSE IF SEGTYPE=1 THEN     << SL SEGMENT >>                 << MCW >>08614000
   BEGIN                                                       << MCW >>08616000
      MOVE BBUF(COL-1):="CST       0";                         << MCW >>08618000
      PUTOCTALP(SEGID1, COL+10);                               << MCW >>08620000
   END                                                         << MCW >>08622000
   ELSE IF SEGTYPE=2 THEN     <<PROGRAM SEGMENT>>              << MCW >>08624000
   BEGIN                                                       << MCW >>08626000
      MOVE BBUF(COL-1):="CTX   0.000";                         << MCW >>08628000
      PUTOCTALP(SEGID.(4:12), COL+6);                          << MCW >>08630000
      PUTOCTALP(SEGID1, COL+10);                               << MCW >>08632000
      BBUF(COL+6):=".";                                        << MCW >>08634000
   END                                                         << MCW >>08636000
   ELSE IF SEGTYPE=3 THEN       << CACHE DOMAIN >>             << MCW >>08638000
   BEGIN                                                       << MCW >>08640000
      MOVE BBUF(COL-1):="CDT       0";                         << MCW >>08642000
      PUTOCTALP(SEGID1,COL+10);                                << MCW >>08644000
   END;                                                        << MCW >>08646000
                                                               << MCW >>08648000
END; << PUTSEGID >>                                            << MCW >>08650000
                                                                        08652000
$PAGE "YESANSWER : Process a user reply"                                08654000
$CONTROL SEGMENT=INIT                                          <<01114>>08656000
 LOGICAL PROCEDURE YESANSWER(LENGTH);                          <<01114>>08658000
 VALUE LENGTH;                                                 <<01114>>08660000
 INTEGER LENGTH;                                               <<01114>>08662000
COMMENT                                                                 08664000
                                                                        08666000
Purpose:                                                                08668000
          This  procedure prints the message supplied in the            08670000
          buffer DBUFFER, and processes the yes/ no reply.              08672000
          The possible replys follow:                                   08674000
                                                                        08676000
               True(-1)   - Reply from user was YES or Y.               08678000
               False(0)   - User replyed with carriage return.          08680000
               False(2)   - User explicitly stated NO or N.             08682000
                            This return is used when                    08684000
                            determining whether to print a              08686000
                            code segment                                08688000
                                                                        08690000
Input parameters:                                                       08692000
                                                                        08694000
Output parameters:                                                      08696000
                                                                        08698000
Globals Referenced:                                                     08700000
                                                                        08702000
Globals Altered:                                                        08704000
                                                                        08706000
Data Structures:                                                        08708000
                                                                        08710000
Algorithm:                                                              08712000
                                                                        08714000
;                                                                       08716000
 BEGIN                                                         <<01114>>08718000
 INTEGER INDX, INX, LNGTH;                                     <<01114>>08720000
  BYTE POINTER BPS0=S-0;                                       <<01114>>08722000
  INDX := (LENGTH + 1) / 2;                                    <<01114>>08724000
  YESANSWER := 0;                                              <<01114>>08726000
  WHILE TRUE DO                                                <<01114>>08728000
   BEGIN                                                       <<01114>>08730000
    IF DUPLICATIVE THEN                                        <<01114>>08732000
     PRINT(DBUFFER,-LENGTH,%320);                              <<01114>>08734000
    LNGTH := READX(DBUFFER(INDX),-72);                         <<03079>>08736000
    INX := INDX&LSL(1);                                        <<01114>>08738000
    FWRITE(LPF,DBUFFER,-(INX+LNGTH),0);                        <<01114>>08740000
    IF <> THEN                                                 <<01114>>08742000
     BEGIN                                                     <<01114>>08744000
      PRINT'FILE'INFO(LPF);                                    <<01114>>08746000
      ERROR;                                                   <<01114>>08748000
     END;                                                      <<01114>>08750000
    BBUF(INX+LNGTH) := %15;                                    <<01114>>08752000
    SCAN BBUF(INX) WHILE " ",1;                                <<01114>>08754000
    ASSEMBLE(DUP,DDUP);                                        <<01114>>08756000
    MOVE * := * WHILE AS,1;                                    <<01114>>08758000
    LNGTH := -(TOS - TOS);                                     <<01114>>08760000
    CASE LNGTH OF                                              <<01114>>08762000
     BEGIN                                                     <<01114>>08764000
      RETURN;                     << REPLY WAS cr >>           <<01114>>08766000
      IF BPS0 = "Y" THEN                                       <<01114>>08768000
       BEGIN                                                   <<01114>>08770000
        YESANSWER := TRUE;                                     <<01114>>08772000
        RETURN;                                                <<01114>>08774000
       END                                                     <<01114>>08776000
       ELSE                                                    <<01114>>08778000
        IF BPS0 = "N" THEN                                     <<01114>>08780000
         BEGIN                                                 <<01114>>08782000
          YESANSWER := 2;                                      <<01114>>08784000
          RETURN;                                              <<01114>>08786000
         END;                                                  <<01114>>08788000
      IF BPS0 = "NO" THEN                                      <<01114>>08790000
       BEGIN                                                   <<01114>>08792000
        YESANSWER := 2;                                        <<01114>>08794000
        RETURN;                                                <<01114>>08796000
       END;                                                    <<01114>>08798000
      IF BPS0 = "YES" THEN                                     <<01114>>08800000
       BEGIN                                                   <<01114>>08802000
        YESANSWER := TRUE;                                     <<01114>>08804000
        RETURN;                                                <<01114>>08806000
       END;                                                    <<01114>>08808000
     END;                                                      <<01114>>08810000
     MOVE DBUFFER(INDX) :=                                     <<01114>>08812000
          " EXPECTED YES, NO, Y, N.  ";                        <<01114>>08814000
     FWRITE(LPF,DBUFFER(INDX),12,0);                           <<01114>>08816000
     IF <> THEN                                                <<01114>>08818000
      BEGIN                                                    <<01114>>08820000
       PRINT'FILE'INFO(LPF);                                   <<01114>>08822000
       ERROR;                                                  <<01114>>08824000
      END;                                                     <<01114>>08826000
     IF DUPLICATIVE THEN                                       <<01114>>08828000
      BEGIN                                                    <<01114>>08830000
       MOVE DBUFFER(INDX+13) := "TRY AGAIN.";                  <<01114>>08832000
       PRINT(DBUFFER(INDX),-36,0);                             <<01114>>08834000
      END                                                      <<01114>>08836000
      ELSE                                                     <<01114>>08838000
       ERROR;                                                  <<01114>>08840000
     DEL;                                                      <<01114>>08842000
    END;                                                       <<01114>>08844000
  END;                                                         <<01114>>08846000
                                                                        08848000
$PAGE "ANSWER : Log a user transaction to the spool file"               08850000
$CONTROL SEGMENT=INIT                                          <<01114>>08852000
 INTEGER PROCEDURE ANSWER(LENGTH);                             <<01114>>08854000
 VALUE LENGTH;                                                 <<01114>>08856000
 INTEGER LENGTH;                                               <<01114>>08858000
 BEGIN                                                         <<01114>>08860000
COMMENT                                                                 08862000
                                                                        08864000
Purpose:                                                                08866000
          This procedure prints the message supplied in the             08868000
          buffer DBUFFER, and processes the user supplied               08870000
          reply.  The allowable replys follow:                          08872000
                                                                        08874000
               Reply       Return value                                 08876000
                                                                        08878000
                YES              1                                      08880000
                ALL              2                                      08882000
                NO               0                                      08884000
                cr               0                                      08886000
                                                                        08888000
Input parameters:                                                       08890000
                                                                        08892000
Output parameters:                                                      08894000
                                                                        08896000
Globals Referenced:                                                     08898000
                                                                        08900000
Globals Altered:                                                        08902000
                                                                        08904000
Data Structures:                                                        08906000
                                                                        08908000
Algorithm:                                                              08910000
                                                                        08912000
;                                                                       08914000
 INTEGER INDX, INX, LNGTH;                                     <<01114>>08916000
  BYTE POINTER BPS0=S-0;                                       <<01114>>08918000
  INDX := (LENGTH + 1) / 2;                                    <<01114>>08920000
  ANSWER := 0;                                                 <<01114>>08922000
  WHILE TRUE DO                                                <<01114>>08924000
   BEGIN                                                       <<01114>>08926000
    IF DUPLICATIVE THEN                                        <<01114>>08928000
     PRINT(DBUFFER,-LENGTH,%320);                              <<01114>>08930000
    LNGTH := READX(DBUFFER(INDX),-72);                         <<03079>>08932000
    INX := INDX&LSL(1);                                        <<01114>>08934000
    FWRITE(LPF,DBUFFER,-(INX+LNGTH),0);                        <<01114>>08936000
    IF <> THEN                                                 <<01114>>08938000
     BEGIN                                                     <<01114>>08940000
      PRINT'FILE'INFO(LPF);                                    <<01114>>08942000
      ERROR;                                                   <<01114>>08944000
     END;                                                      <<01114>>08946000
    BBUF(INX+LNGTH) := %15;                                    <<01114>>08948000
    SCAN BBUF(INX) WHILE " ",1;                                <<01114>>08950000
    ASSEMBLE(DUP,DDUP);                                        <<01114>>08952000
    MOVE * := * WHILE AS,1;                                    <<01114>>08954000
    LNGTH := -(TOS - TOS);                                     <<01114>>08956000
    CASE LNGTH OF                                              <<01114>>08958000
     BEGIN                                                     <<01114>>08960000
      RETURN;                     << REPLY WAS cr >>           <<01114>>08962000
      IF BPS0 = "Y" THEN                                       <<01114>>08964000
       BEGIN                                                   <<01114>>08966000
        ANSWER := 1;                                           <<01114>>08968000
        RETURN;                                                <<01114>>08970000
       END                                                     <<01114>>08972000
       ELSE                                                    <<01114>>08974000
        IF BPS0 = "N" THEN RETURN;                             <<01114>>08976000
      IF BPS0 = "NO" THEN RETURN;                              <<01114>>08978000
      IF BPS0 = "YES" THEN                                     <<01114>>08980000
       BEGIN                                                   <<01114>>08982000
        ANSWER := 1;                                           <<01114>>08984000
        RETURN;                                                <<01114>>08986000
       END                                                     <<01114>>08988000
       ELSE                                                    <<01114>>08990000
        IF BPS0 = "ALL" THEN                                   <<01114>>08992000
         BEGIN                                                 <<01114>>08994000
          ANSWER := 2;                                         <<01114>>08996000
          RETURN;                                              <<01114>>08998000
         END;                                                  <<01114>>09000000
     END;                                                      <<01114>>09002000
     MOVE DBUFFER(INDX) :=                                     <<01114>>09004000
          " EXPECTED YES, ALL, NO, Y, N.  ";                   <<01114>>09006000
     FWRITE(LPF,DBUFFER(INDX),15,0);                           <<01114>>09008000
     IF <> THEN                                                <<01114>>09010000
      BEGIN                                                    <<01114>>09012000
       PRINT'FILE'INFO(LPF);                                   <<01114>>09014000
       ERROR;                                                  <<01114>>09016000
      END;                                                     <<01114>>09018000
     IF DUPLICATIVE THEN                                       <<01114>>09020000
      BEGIN                                                    <<01114>>09022000
       MOVE DBUFFER(INDX+15) := " TRY AGAIN. ";                <<01114>>09024000
       PRINT(DBUFFER(INDX),-41,0);                             <<01114>>09026000
      END                                                      <<01114>>09028000
      ELSE                                                     <<01114>>09030000
       ERROR;                                                  <<01114>>09032000
     DEL;                                                      <<01114>>09034000
    END;                                                       <<01114>>09036000
  END;                                                         <<01114>>09038000
                                                                        09040000
$page "INTERACTIVE'DIALOG : Query the user "                   <<R8332>>09042000
$control segment=init                                          <<R8332>>09044000
procedure interactive'dialog;                                  <<R8332>>09046000
                                                               <<R8332>>09048000
comment *******************************************************<<R8332>>09050000
                                                               <<R8332>>09052000
Purpose:                                                       <<R8332>>09054000
                                                               <<R8332>>09056000
                ***  INTERACTIVE'DIALOG ***                    <<R8332>>09058000
                                                               <<R8332>>09060000
  This procedure processes the interactive dialog that occurs  <<R8332>>09062000
  if the program is run with PARM=10.  It asks all questions   <<R8332>>09064000
  and sets all flags necessary to produce the available        <<R8332>>09066000
  reports.                                                     <<R8332>>09068000
                                                               <<R8332>>09070000
Input parameters:                                              <<R8332>>09072000
  none.                                                        <<R8332>>09074000
                                                               <<R8332>>09076000
Output parameters:                                             <<R8332>>09078000
  none.                                                        <<R8332>>09080000
                                                               <<R8332>>09082000
Globals Referenced:                                            <<R8332>>09084000
  DSTB       Abs loc %2.                                       <<R8332>>09086000
  LPF        File number of DPANLIST line printer file.        <<R8332>>09088000
  CSTABP     address of code segment table.                    <<R8332>>09090000
  DST'TYPE   array of DST entries to be printed.               <<R8332>>09092000
  MAXBANK    highest memory bank# on dumped system, zero-rel.  <<R8332>>09094000
                                                               <<R8332>>09096000
Globals Altered:                                               <<R8332>>09098000
  DBUFFER    logical print buffer.                             <<R8332>>09100000
  BBUF       byte print buffer.                                <<R8332>>09102000
  DST'TYPE   array of DST entries to be printed.               <<R8332>>09104000
  RESPONSES  array of print flags (PRINT'CST, DST, etc.)       <<R8332>>09106000
  PRINT'BANK array of print flags for memory banks.            <<R8332>>09108000
  LINECOUNT  number of lines on current DPANLIST page.         <<R8332>>09110000
                                                               <<R8332>>09112000
Procedures called:                                             <<R8332>>09114000
  CORE                                                         <<R8332>>09116000
  ERROR                                                        <<R8332>>09118000
  BLANKBUF                                                     <<R8332>>09120000
  ONFREELIST                                                   <<R8332>>09122000
  YESANSWER                                                    <<R8332>>09124000
  ANSWER                                                       <<R8332>>09126000
  NEWPAGE                                                      <<R8332>>09128000
  FWRITE           (intrinsic)                                 <<R8332>>09130000
  PRINT'FILE'INFO  (intrinsic)                                 <<R8332>>09132000
  READX            (intrinsic)                                 <<R8332>>09134000
  PRINT            (intrinsic)                                 <<R8332>>09136000
  ASCII            (intrinsic)                                 <<R8332>>09138000
  MYCOMMAND        (intrinsic)                                 <<R8332>>09140000
  BINARY           (intrinsic)                                 <<R8332>>09142000
                                                               <<R8332>>09144000
Data Structures:                                               <<R8332>>09146000
  DELIMITER  This is a byte array used for MYCOMMAND. It is a  <<R8332>>09148000
             3-byte array, containing the delimiters used      <<R8332>>09150000
             for specifying lists and ranges of memory bank    <<R8332>>09152000
             numbers. The code fixes byte 0 as the "list"      <<R8332>>09154000
             delimiter (comma), and byte 1 as the "range"      <<R8332>>09156000
             delimiter (dash). MYCOMMAND requires a CR         <<R8332>>09158000
             terminator.                                       <<R8332>>09160000
                                                               <<R8332>>09162000
  PARM'INFO  This is an integer array, filled by MYCOMMAND.    <<R8332>>09164000
             In the normal implementation, this would be a     <<R8332>>09166000
             type double array, but for simpler indexing,      <<R8332>>09168000
             integers are used. A 2-word pair is set up for    <<R8332>>09170000
             every number found in the list of memory bank     <<R8332>>09172000
             numbers the user entered in the BBUF array.       <<R8332>>09174000
             Each word pair n looks like this:                 <<R8332>>09176000
                                                               <<R8332>>09178000
             Word n+0       :byte address of first character   <<R8332>>09180000
                             of nth number entered by user.    <<R8332>>09182000
             Word n+1.(0:8) :number of digits in number.       <<R8332>>09184000
             Word n+1.(11:5):index of trailing delimiter (0,1).<<R8332>>09186000
                                                               <<R8332>>09188000
Algorithm:                                                     <<R8332>>09190000
  Start a new page and zero the line counter. Initialize the   <<R8332>>09192000
  "responses" and "print'bank" arrays to all false (i.e. do    <<R8332>>09194000
  nothing).                                                    <<R8332>>09196000
                                                               <<R8332>>09198000
  Ask the "Minidump?" question. The answer can be Y or N. If   <<R8332>>09200000
  Y, then go through dialog to select which DST's to print.    <<R8332>>09202000
                                                               <<R8332>>09204000
  Ask the "Format tables?" question. The answer can be Y, N,   <<R8332>>09206000
  or ALL. If Y, then go through dialog to select what tables   <<R8332>>09208000
  to print.                                                    <<R8332>>09210000
                                                               <<R8332>>09212000
  Ask the "Print Primary Memory?" question. The answer can be  <<R8332>>09214000
  Y or N. If Y, then go through dialog to select how and how   <<R8332>>09216000
  much memory is to be printed.                                <<R8332>>09218000
                                                               <<R8332>>09220000
  All of the questions and their responses get echoed to the   <<R8332>>09222000
  line printer file, along with any error messages. Special    <<R8332>>09224000
  messages/errors are echoed directly, while most are echoed   <<R8332>>09226000
  by the YESANSWER and ANSWER procedures.                      <<R8332>>09228000
                                                               <<R8332>>09230000
                                                               <<R8332>>09232000
Modification History:                                          <<R8332>>09234000
  16JAN84 - Randy Pawell, IND                                  <<R8332>>09236000
                                                               <<R8332>>09238000
  1) Rewrite all, for increased readability. Adds all docum.   <<R8332>>09240000
  2) Add LPECHO subroutine to reduce code & simplify.          <<R8332>>09242000
  3) Echo memory-bank specification errors correctly to LP.    <<R8332>>09244000
  4) Allow exit from Minidump dialog in a job (via blank line).<<R8332>>09246000
  5) Print a help msg if memory-banks entered incorrectly.     <<R8332>>09248000
  6) Some cleanup around the MYCOMMAND call.                   <<R8332>>09250000
  7) Include actual maxbank in "which banks?" prompt.          <<R8332>>09252000
  8) Restore missing code in print'bank array initialization.  <<R8332>>09254000
                                                               <<R8332>>09256000
                                                               <<R8332>>09258000
***************************************************************<<R8332>>09260000
;                                                              <<R8332>>09262000
$page                                                          <<R8332>>09264000
                                                               <<R8332>>09266000
begin                                                          <<R8332>>09268000
                                                               <<R8332>>09270000
integer                                                        <<R8332>>09272000
  indx := -1,    <<counter for scanning arrays>>               <<R8332>>09274000
  numparms,      <<# of numbers in user input, from MYCOMMAND>><<R8332>>09276000
  length,        <<length of user input or ASCII conversion>>  <<R8332>>09278000
  work1,         <<scratch for numeric conversions>>           <<R8332>>09280000
  work2;         <<scratch for numeric conversions>>           <<R8332>>09282000
                                                               <<R8332>>09284000
logical                                                        <<R8332>>09286000
  good;          <<true until error found in mem bank spec>>   <<R8332>>09288000
                                                               <<R8332>>09290000
integer pointer                                                <<R8332>>09292000
  parm;          <<ptr for scanning MYCOMMAND's bbuf brkdown>> <<R8332>>09294000
                                                               <<R8332>>09296000
byte array                                                     <<R8332>>09298000
  delimiter ( 0:2 );     <<holds list & range delimiters>>     <<R8332>>09300000
                                                               <<R8332>>09302000
integer array                                                  <<R8332>>09304000
  parm'info ( 0:71 );    <<info from MYCOMMAND>>               <<R8332>>09306000
                                                               <<R8332>>09308000
$page                                                          <<R8332>>09310000
logical subroutine valid ( dstno );                            <<R8332>>09312000
value          dstno;                                          <<R8332>>09314000
integer        dstno;                                          <<R8332>>09316000
                                                               <<R8332>>09318000
comment *******************************************************<<R8332>>09320000
*                                                              <<R8332>>09322000
* VALID --                                                     <<R8332>>09324000
*                                                              <<R8332>>09326000
* Checks the passed DST entry number against the actual length <<R8332>>09328000
* of the DST table, to verify it is within range.              <<R8332>>09330000
*                                                              <<R8332>>09332000
* RETURNS:    True if 0 < dstno < max                          <<R8332>>09334000
*             False if not                                     <<R8332>>09336000
*                                                              <<R8332>>09338000
***************************************************************<<R8332>>09340000
;                                                              <<R8332>>09342000
                                                               <<R8332>>09344000
begin                                                          <<R8332>>09346000
                                                               <<R8332>>09348000
if dstno < integer (                                           <<R8332>>09350000
     CORE ( double ( CORE ( double ( dstb )))) )               <<R8332>>09352000
        and dstno > 0 then     <<true if in DST range>>        <<R8332>>09354000
  valid := true                                                <<R8332>>09356000
else                                                           <<R8332>>09358000
  valid := false;                                              <<R8332>>09360000
                                                               <<R8332>>09362000
end;   <<subroutine valid>>                                    <<R8332>>09364000
$page                                                          <<R8332>>09366000
subroutine lpecho ( len );                                     <<R8332>>09368000
value          len;                                            <<R8332>>09370000
integer        len;                                            <<R8332>>09372000
                                                               <<R8332>>09374000
comment *******************************************************<<R8332>>09376000
*                                                              <<R8332>>09378000
* LPECHO                                                       <<R8332>>09380000
* Echoes the contents of DBUFFER(*) to the LPF file, and       <<R8332>>09382000
* aborts the program if the write fails.                       <<R8332>>09384000
*                                                              <<R8332>>09386000
***************************************************************<<R8332>>09388000
;                                                              <<R8332>>09390000
                                                               <<R8332>>09392000
begin                                                          <<R8332>>09394000
                                                               <<R8332>>09396000
FWRITE ( lpf, dbuffer, len, %40 );                             <<R8332>>09398000
if <> then                                                     <<R8332>>09400000
  begin                                                        <<R8332>>09402000
  PRINT'FILE'INFO ( lpf );   <<print tombstone>>               <<R8332>>09404000
  ERROR;                     <<abort DPAN>>                    <<R8332>>09406000
  end;                                                         <<R8332>>09408000
                                                               <<R8332>>09410000
end;   <<subroutine lpecho>>                                   <<R8332>>09412000
$page                                                          <<R8332>>09414000
subroutine pickdsts;                                           <<R8332>>09416000
                                                               <<R8332>>09418000
comment *******************************************************<<R8332>>09420000
*                                                              <<R8332>>09422000
* PICKDSTS --                                                  <<R8332>>09424000
*                                                              <<R8332>>09426000
* Prompts the user for decimal DST numbers and sets the        <<R8332>>09428000
* corresponding element in array DST'TYPE. Prompting           <<R8332>>09430000
* continues until the input is null or blanks.                 <<R8332>>09432000
*                                                              <<R8332>>09434000
***************************************************************<<R8332>>09436000
;                                                              <<R8332>>09438000
                                                               <<R8332>>09440000
begin                                                          <<R8332>>09442000
                                                               <<R8332>>09444000
do                                                             <<R8332>>09446000
  begin  <<loop>>                                              <<R8332>>09448000
                                                               <<R8332>>09450000
<< Blank the print buffer and prompt the user. We'll use the >><<R8332>>09452000
<< same print buffer to receive input, so the whole thing can>><<R8332>>09454000
<< be echoed to the printer.                                 >><<R8332>>09456000
                                                               <<R8332>>09458000
  BLANKBUF;                                                    <<R8332>>09460000
  move dbuffer := "WHICH DST (DECIMAL)?";                      <<R8332>>09462000
  PRINT ( dbuffer, -20 ,%320 );               <<prompt user>>  <<R8332>>09464000
                                                               <<R8332>>09466000
  length := READX ( dbuffer ( 10 ), -5 );     <<get input>>    <<R8332>>09468000
                                                               <<R8332>>09470000
  if = and length <> 0 then                                    <<R8332>>09472000
    begin  <<read ok>>                                         <<R8332>>09474000
                                                               <<R8332>>09476000
    LPECHO ( -length - 20 );                                   <<R8332>>09478000
                                                               <<R8332>>09480000
    work1 := BINARY ( dbuffer ( 10 ), length );                <<R8332>>09482000
                                                               <<R8332>>09484000
    if = and VALID ( work1 ) and                               <<R8332>>09486000
      not ONFREELIST ( double ( CORE ( cstabp )),              <<R8332>>09488000
          ( work1 * 4 )) then                                  <<R8332>>09490000
      begin  <<valid>>                                         <<R8332>>09492000
      if dst'type ( work1 ) = 0 then  <<unassigned>>           <<R8332>>09494000
        dst'type ( work1 ) := 14;     <<set code to print DST>><<R8332>>09496000
      end    <<valid>>                                         <<R8332>>09498000
    else                                                       <<R8332>>09500000
      begin  <<invalid>>                                       <<R8332>>09502000
      move dbuffer := "INVALID DST #";                         <<R8332>>09504000
      PRINT ( dbuffer, -13, %40 );                             <<R8332>>09506000
      LPECHO ( -13 );                                          <<R8332>>09508000
      end;   <<invalid>>                                       <<R8332>>09510000
                                                               <<R8332>>09512000
    end;  <<read ok>>                                          <<R8332>>09514000
                                                               <<R8332>>09516000
  end   <<loop>>                                               <<R8332>>09518000
                                                               <<R8332>>09520000
until length = 0                   <<CR in session >>          <<R8332>>09522000
  or dbuffer ( 10 ) = %020040;     <<blanks in job>>           <<R8332>>09524000
                                                               <<R8332>>09526000
end;   <<subroutine pickdsts>>                                 <<R8332>>09528000
$page                                                          <<R8332>>09530000
comment *******************************************************<<R8332>>09532000
*                                                              <<R8332>>09534000
* PRNT'PROCESS     --   Sets all Process-Control print flags.  <<R8332>>09536000
* PRNT'MEMORY'MGMT --   Sets all Memory-Management print flags.<<R8332>>09538000
* PRNT'IO'MGMT     --   Sets all I/O Management print flags.   <<R8332>>09540000
*                                                              <<R8332>>09542000
***************************************************************<<R8332>>09544000
;                                                              <<R8332>>09546000
                                                               <<R8332>>09548000
subroutine prnt'process;  << Set process control print flags>> <<R8332>>09550000
                                                               <<R8332>>09552000
begin                                                          <<R8332>>09554000
                                                               <<R8332>>09556000
print'cst     := true;   <<Code Segment Table>>                <<R8332>>09558000
print'dst     := true;   <<Data Segment Table>>                <<R8332>>09560000
print'pcb     := true;   <<Process Control Block>>             <<R8332>>09562000
print'stacks  := true;   <<Stack Markers>>                     <<R8332>>09564000
print'ics     := true;   <<Interrupt Control Stack>>           <<R8332>>09566000
                                                               <<R8332>>09568000
end;   <<subroutine prnt'process>>                             <<R8332>>09570000
                                                               <<R8332>>09572000
                                                               <<R8332>>09574000
                                                               <<R8332>>09576000
subroutine prnt'memory'mgt;  <<Set all memory mgt rept flags>> <<R8332>>09578000
                                                               <<R8332>>09580000
begin                                                          <<R8332>>09582000
                                                               <<R8332>>09584000
print'cache   := true;   <<Cache Directory Table>>             <<R8332>>09586000
print'sll     := true;   <<Segment Locality List>>             <<R8332>>09588000
print'vdsl    := true;   <<Virtual Disc Space List>>           <<R8332>>09590000
print'vdsm    := true;   <<Virtual Disc Space Bit Map>>        <<R8332>>09592000
                                                               <<R8332>>09594000
end;                                                           <<R8332>>09596000
                                                               <<R8332>>09598000
                                                               <<R8332>>09600000
                                                               <<R8332>>09602000
subroutine prnt'io'mgt;     << Set all I/O report flags >>     <<R8332>>09604000
                                                               <<R8332>>09606000
begin                                                          <<R8332>>09608000
print'drt     := true;   <<Device Reference Table>>            <<R8332>>09610000
print'ilt     := true;   <<Interrupt Linkage Table>>           <<R8332>>09612000
print'lpdt    := true;   <<Logical-to-Physical Device Table>>  <<R8332>>09614000
print'dit     := true;   <<Device Information Tables>>         <<R8332>>09616000
print'ioq     := true;   <<I/O Requests>>                      <<R8332>>09618000
print'sbuf    := true;   <<System Buffers>>                    <<R8332>>09620000
print'tbuf    := true;   <<Terminal Buffers>>                  <<R8332>>09622000
print'drqt    := true;   <<Disc Request Table>>                <<R8332>>09624000
                                                               <<R8332>>09626000
end;                                                           <<R8332>>09628000
$page                                                          <<R8332>>09630000
subroutine primary'memory;                                     <<R8332>>09632000
                                                               <<R8332>>09634000
comment *******************************************************<<R8332>>09636000
*                                                              <<R8332>>09638000
* PRIMARY'MEMORY --                                            <<R8332>>09640000
*                                                              <<R8332>>09642000
* Prompts user for how memory should be formatted, and what    <<R8332>>09644000
* banks.                                                       <<R8332>>09646000
*                                                              <<R8332>>09648000
*                                                              <<R8332>>09650000
***************************************************************<<R8332>>09652000
;                                                              <<R8332>>09654000
                                                               <<R8332>>09656000
begin                                                          <<R8332>>09658000
                                                               <<R8332>>09660000
move dbuffer := " PRINT PRIMARY MEMORY?";                      <<R8332>>09662000
if YESANSWER ( 22 ) then                                       <<R8332>>09664000
  begin  <<print memory>>                                      <<R8332>>09666000
                                                               <<R8332>>09668000
  print'memory := true;                                        <<R8332>>09670000
                                                               <<R8332>>09672000
  move dbuffer := "  FORMATTED?";                              <<R8332>>09674000
  if YESANSWER ( 12 ) then                                     <<R8332>>09676000
    begin  <<format memory>>                                   <<R8332>>09678000
                                                               <<R8332>>09680000
    print'index := true;      <<force printing of page index>> <<R8332>>09682000
    format'memory := true;                                     <<R8332>>09684000
                                                               <<R8332>>09686000
    move dbuffer := "   CODE SEGMENTS? ";                      <<R8332>>09688000
    code'segments := YESANSWER ( 17 );                         <<R8332>>09690000
                                                               <<R8332>>09692000
    move dbuffer := "   CACHED REGIONS?";                      <<R8332>>09694000
    cached'regions := YESANSWER ( 18 );                        <<R8332>>09696000
                                                               <<R8332>>09698000
    move dbuffer := "   FREE AREAS?";                          <<R8332>>09700000
    free'areas := YESANSWER ( 14 );                            <<R8332>>09702000
                                                               <<R8332>>09704000
    end;   <<format memory>>                                   <<R8332>>09706000
                                                               <<R8332>>09708000
                                                               <<R8332>>09710000
<<----------------------------------------------------------->><<R8332>>09712000
<< Print what input's expected, and then prompt the user for >><<R8332>>09714000
<< the numbers of the banks to be printed. Include the true  >><<R8332>>09716000
<< upper limit for the dump being formatted.                 >><<R8332>>09718000
<<----------------------------------------------------------->><<R8332>>09720000
                                                               <<R8332>>09722000
  while true do                                                <<R8332>>09724000
    begin  <<loop till return>>                                <<R8332>>09726000
                                                               <<R8332>>09728000
    move bbuf := "  WHICH BANKS (0-             ";             <<R8332>>09730000
    length := ASCII ( maxbank, 10, bbuf ( 17 ));               <<R8332>>09732000
    move bbuf ( 17 + length ) := ")?";                         <<R8332>>09734000
                                                               <<R8332>>09736000
                                                               <<R8332>>09738000
<<----------------------------------------------------------->><<R8332>>09740000
<< Read bank#'s from user. Can be "ALL", a range, a list, or >><<R8332>>09742000
<< mixture of ranges and lists. If "ALL", then just mark all >><<R8332>>09744000
<< banks for printing and exit.                              >><<R8332>>09746000
<<                                                           >><<R8332>>09748000
<< Ex:   ALL  or  2,4,3,0,1  or  4-7  or  9,3-7,12,0-1   .   >><<R8332>>09750000
<<                                                           >><<R8332>>09752000
<< Note:  "2-" as an input would be taken as "2" only.       >><<R8332>>09754000
<<----------------------------------------------------------->><<R8332>>09756000
                                                               <<R8332>>09758000
    if ANSWER ( 19 + length ) = 2 then    <<"ALL" entered>>    <<R8332>>09760000
      begin  <<all>>                                           <<R8332>>09762000
      indx := -1;                                              <<R8332>>09764000
      while ( indx := indx + 1) <= maxbank  do                 <<R8332>>09766000
         print'bank ( indx ) := true;                          <<R8332>>09768000
      return;                                                  <<R8332>>09770000
      end;   <<all>>                                           <<R8332>>09772000
                                                               <<R8332>>09774000
                                                               <<R8332>>09776000
<<----------------------------------------------------------->><<R8332>>09778000
<< Setup for MYCOMMAND. It needs the delimiters for list     >><<R8332>>09780000
<< (comma) and range (dash), and this needs a CR terminator. >><<R8332>>09782000
<< Then MYCOMMAND can parse the input and set up parminfo(*).>><<R8332>>09784000
<<----------------------------------------------------------->><<R8332>>09786000
                                                               <<R8332>>09788000
    move delimiter  := ( ",-", %15 );     <<load delimiters>>  <<R8332>>09790000
                                                               <<R8332>>09792000
    MYCOMMAND ( bbuf ( 19 + length ),                          <<R8332>>09794000
      delimiter, 36 <<=max parms>>, numparms, parm'info );     <<R8332>>09796000
                                                               <<R8332>>09798000
                                                               <<R8332>>09800000
<<----------------------------------------------------------->><<R8332>>09802000
<< Scan the parm'info array set up by MYCOMMAND.             >><<R8332>>09804000
<<                                                           >><<R8332>>09806000
<< If a valid bank number is followed by "-" and another,    >><<R8332>>09808000
<< greater or equal valid bank number, this pair specifies a >><<R8332>>09810000
<< range.                                                    >><<R8332>>09812000
<<                                                           >><<R8332>>09814000
<< If a valid bank number is followed by ",", it specifies a >><<R8332>>09816000
<< list item--i.e., a range that is only one item long.      >><<R8332>>09818000
<<----------------------------------------------------------->><<R8332>>09820000
<< NOTE: In the normal use of MYCOMMAND, parm'info is a type >><<R8332>>09822000
<< double array. Here we're using an integer array, so we'll >><<R8332>>09824000
<< need to shift its pointer by 2 for each parm.             >><<R8332>>09826000
<<----------------------------------------------------------->><<R8332>>09828000
                                                               <<R8332>>09830000
    @parm := @parm'info - 2;      <<initialize>>               <<R8332>>09832000
    good := true;                 <<initialize>>               <<R8332>>09834000
    indx := -1;                                                <<R8332>>09836000
    while ( indx := indx + 1 ) < numparms  do                  <<R8332>>09838000
      begin   <<chk all nums>>                                 <<R8332>>09840000
                                                               <<R8332>>09842000
      @parm := @parm + 2;     <<shift to next double-wd pair>> <<R8332>>09844000
                                                               <<R8332>>09846000
                                                               <<R8332>>09848000
<< Convert number, using TOS for fancy type-conversions.     >><<R8332>>09850000
                                                               <<R8332>>09852000
      tos := 0;                 <<leave space for work1>>      <<R8332>>09854000
      tos := parm;              <<this is a byte ptr to num>>  <<R8332>>09856000
      tos := parm ( 1 ).(0:8);  <<length (#bytes) of num>>     <<R8332>>09858000
      work1 := BINARY ( *, * );                                <<R8332>>09860000
                                                               <<R8332>>09862000
      if <> or logical ( work1 ) > logical ( maxbank ) then    <<R8332>>09864000
        begin  <<bad num>>                                     <<R8332>>09866000
        good := false;      <<number's bad or out of range>>   <<R8332>>09868000
        indx := numparms;                                      <<R8332>>09870000
        end    <<bad num>>                                     <<R8332>>09872000
                                                               <<R8332>>09874000
      else                                                     <<R8332>>09876000
        begin  <<num ok>>                                      <<R8332>>09878000
        if parm ( 1 ).(11:5) = 1 then    <<found "x-x" >>      <<R8332>>09880000
          begin  <<found range>>                               <<R8332>>09882000
                                                               <<R8332>>09884000
<< Convert next number, using TOS for fancy type-conversions.>><<R8332>>09886000
                                                               <<R8332>>09888000
          indx := indx + 1;                                    <<R8332>>09890000
          @parm := @parm + 2;   <<shift to 2nd half of range>> <<R8332>>09892000
                                                               <<R8332>>09894000
          tos := 0;                 <<leave space for work2>>  <<R8332>>09896000
          tos := parm;              <<byte ptr to num>>        <<R8332>>09898000
          tos := parm ( 1 ).(0:8);  <<length (#bytes) of num>> <<R8332>>09900000
          work2 := BINARY ( *, * );                            <<R8332>>09902000
                                                               <<R8332>>09904000
          if <> or not ( work1 <= work2 <= maxbank ) then      <<R8332>>09906000
            begin  <<bad upper limit>>                         <<R8332>>09908000
            good := false;                                     <<R8332>>09910000
            indx := numparms;                                  <<R8332>>09912000
            end    <<bad upper limit>>                         <<R8332>>09914000
                                                               <<R8332>>09916000
          else                                                 <<R8332>>09918000
            begin  <<chk syntax>>                              <<R8332>>09920000
            if parm ( 1 ).(11:5) = 1 then  <<found "x-x-x">>   <<R8332>>09922000
              begin   <<bad syntax>>                           <<R8332>>09924000
              good := false;                                   <<R8332>>09926000
              indx := numparms;                                <<R8332>>09928000
              parm := parm + length;                           <<R8332>>09930000
              end     <<bad syntax>>                           <<R8332>>09932000
            else                                               <<R8332>>09934000
              begin                                            <<R8332>>09936000
      <<upper limit's ok, range is work1 to work2 >>           <<R8332>>09938000
              end;                                             <<R8332>>09940000
            end;   <<chk syntax>>                              <<R8332>>09942000
          end   <<found range>>                                <<R8332>>09944000
        else                                                   <<R8332>>09946000
          begin   <<found list>>                               <<R8332>>09948000
          work2 := work1;                                      <<R8332>>09950000
          end;    <<found list>>                               <<R8332>>09952000
        end;  <<num ok>>                                       <<R8332>>09954000
                                                               <<R8332>>09956000
                                                               <<R8332>>09958000
<<----------------------------------------------------------->><<R8332>>09960000
<< Mark the single bank number or full range of numbers,     >><<R8332>>09962000
<< whichever was found.                                      >><<R8332>>09964000
<<----------------------------------------------------------->><<R8332>>09966000
                                                               <<R8332>>09968000
      if good then  do                                         <<R8332>>09970000
        print'bank ( work1 ) := true                           <<R8332>>09972000
        until ( work1 := work1 + 1 ) > work2;                  <<R8332>>09974000
                                                               <<R8332>>09976000
      end;   <<chk all nums>>                                  <<R8332>>09978000
                                                               <<R8332>>09980000
    if good then return;   <<exit now, if no errors>>          <<R8332>>09982000
                                                               <<R8332>>09984000
                                                               <<R8332>>09986000
                                                               <<R8332>>09988000
                                                               <<R8332>>09990000
<<----------------------------------------------------------->><<R8332>>09992000
<< Some kind of error was found in the user's bank specs.    >><<R8332>>09994000
<< Print a "^" indicator line under the bad input. If in a   >><<R8332>>09996000
<< job, abort it at this point. If not, give the user another>><<R8332>>09998000
<< chance and say what we want.                              >><<R8332>>10000000
<<----------------------------------------------------------->><<R8332>>10002000
                                                               <<R8332>>10004000
    bbuf := " ";                                               <<R8332>>10006000
    move bbuf ( 1 ) := bbuf, ( length );                       <<R8332>>10008000
    bbuf ( parm - @bbuf ) := "^";                              <<R8332>>10010000
    PRINT ( dbuffer, -length, 0 );                             <<R8332>>10012000
    LPECHO ( -length );                                        <<R8332>>10014000
                                                               <<R8332>>10016000
    move bbuf := " INVALID PARAMETER. ";                       <<R8332>>10018000
                                                               <<R8332>>10020000
    if duplicative then                                        <<R8332>>10022000
      begin   <<session>>                                      <<R8332>>10024000
                                                               <<R8332>>10026000
      move bbuf ( 20 ) := " TRY AGAIN.   ";                    <<R8332>>10028000
      PRINT ( dbuffer, -31, 0 );                               <<R8332>>10030000
      LPECHO ( -31 );                                          <<R8332>>10032000
                                                               <<R8332>>10034000
      move dbuffer :=                                          <<R8332>>10036000
        "  MEMORY BANKS CAN BE ENTERED AS A LIST '0,1,2,3',";  <<R8332>>10038000
      PRINT ( dbuffer, -50, 0 );                               <<R8332>>10040000
      LPECHO ( -50 );                                          <<R8332>>10042000
      move dbuffer :=                                          <<R8332>>10044000
        "  A RANGE '0-3', AS A MIXTURE '0,4-7', OR AS 'ALL'."; <<R8332>>10046000
      PRINT ( dbuffer, -51, 0 );                               <<R8332>>10048000
      LPECHO ( -51 );                                          <<R8332>>10050000
                                                               <<R8332>>10052000
      end    <<session>>                                       <<R8332>>10054000
                                                               <<R8332>>10056000
    else                                                       <<R8332>>10058000
      begin  <<job>>                                           <<R8332>>10060000
      PRINT ( dbuffer, -19, 0 );                               <<R8332>>10062000
      LPECHO ( -19 );                                          <<R8332>>10064000
      ERROR;                  <<abort DPAN now>>               <<R8332>>10066000
      end;   <<job>>                                           <<R8332>>10068000
                                                               <<R8332>>10070000
                                                               <<R8332>>10072000
<<----------------------------------------------------------->><<R8332>>10074000
<< Erase whatever banks we've selected up to now.            >><<R8332>>10076000
<<----------------------------------------------------------->><<R8332>>10078000
                                                               <<R8332>>10080000
    indx := -1;                                                <<R8332>>10082000
    while ( indx := indx + 1 ) <= maxbank  do                  <<R8332>>10084000
      print'bank ( indx ) := false;                            <<R8332>>10086000
                                                               <<R8332>>10088000
    end;   <<loop until return>>                               <<R8332>>10090000
                                                               <<R8332>>10092000
  end;  <<print memory>>                                       <<R8332>>10094000
                                                               <<R8332>>10096000
                                                               <<R8332>>10098000
end;   <<subroutine primary'memory>>                           <<R8332>>10100000
$page                                                          <<R8332>>10102000
subroutine process'control;                                    <<R8332>>10104000
                                                               <<R8332>>10106000
comment *******************************************************<<R8332>>10108000
*                                                              <<R8332>>10110000
* PROCESS'CONTROL --                                           <<R8332>>10112000
* Prompts user with questions about what portions of process   <<R8332>>10114000
* management tables should be formatted, if any. If the        <<R8332>>10116000
* response to the first question is "all", then all PM tables  <<R8332>>10118000
* will be formatted, and no other PM questions will be asked.  <<R8332>>10120000
*                                                              <<R8332>>10122000
***************************************************************<<R8332>>10124000
;                                                              <<R8332>>10126000
                                                               <<R8332>>10128000
begin                                                          <<R8332>>10130000
                                                               <<R8332>>10132000
move dbuffer := "  PROCESS CONTROL?";                          <<R8332>>10134000
                                                               <<R8332>>10136000
case *ANSWER ( 18 ) of           <<* = no bounds checks>>      <<R8332>>10138000
  begin                                                        <<R8332>>10140000
                                                               <<R8332>>10142000
<<0>>  <<nop>> ;                 <<reply was "no" or CR>>      <<R8332>>10144000
                                                               <<R8332>>10146000
<<1>>  begin  <<yes>>            <<reply was "yes">>           <<R8332>>10148000
                                                               <<R8332>>10150000
       move dbuffer := "   CST? ";                             <<R8332>>10152000
       print'cst := YESANSWER ( 7 );                           <<R8332>>10154000
                                                               <<R8332>>10156000
       move dbuffer := "   DST? ";                             <<R8332>>10158000
       print'dst := YESANSWER ( 7 );                           <<R8332>>10160000
                                                               <<R8332>>10162000
       move dbuffer := "   PCB? ";                             <<R8332>>10164000
       print'pcb := YESANSWER ( 7 );                           <<R8332>>10166000
                                                               <<R8332>>10168000
       move dbuffer := "   STACK MARKERS? ";                   <<R8332>>10170000
       print'stacks := YESANSWER ( 17 );                       <<R8332>>10172000
                                                               <<R8332>>10174000
       move dbuffer:="   INTERRUPT CONTROL STACK? ";           <<R8332>>10176000
       print'ics := YESANSWER ( 27 );                          <<R8332>>10178000
                                                               <<R8332>>10180000
       end;   <<yes>>                                          <<R8332>>10182000
                                                               <<R8332>>10184000
                                                               <<R8332>>10186000
<<2>>  PRNT'PROCESS;             <<reply was "all">>           <<R8332>>10188000
                                                               <<R8332>>10190000
  end;  <<case>>                                               <<R8332>>10192000
                                                               <<R8332>>10194000
end;   <<subroutine process'control>>                          <<R8332>>10196000
$page                                                          <<R8332>>10198000
subroutine memory'mgt;                                         <<R8332>>10200000
                                                               <<R8332>>10202000
comment *******************************************************<<R8332>>10204000
*                                                              <<R8332>>10206000
* MEMORY'MGT --                                                <<R8332>>10208000
*                                                              <<R8332>>10210000
* Prompts user with questions about what Memory Management     <<R8332>>10212000
* tables should be formatted, if any. If the answer to the     <<R8332>>10214000
* first question is "all", then all MMT tables will be         <<R8332>>10216000
* formatted, and other MMT questions will not be asked.        <<R8332>>10218000
*                                                              <<R8332>>10220000
***************************************************************<<R8332>>10222000
;                                                              <<R8332>>10224000
                                                               <<R8332>>10226000
begin                                                          <<R8332>>10228000
                                                               <<R8332>>10230000
move dbuffer := "  MEMORY MANAGEMENT?";                        <<R8332>>10232000
                                                               <<R8332>>10234000
case *ANSWER ( 20 ) of           <<* = no bounds checks>>      <<R8332>>10236000
                                                               <<R8332>>10238000
  begin                                                        <<R8332>>10240000
                                                               <<R8332>>10242000
<<0>>  <<nop>>;                  <<reply was "no" or CR>>      <<R8332>>10244000
                                                               <<R8332>>10246000
<<1>>  begin  <<yes>>            <<reply was "yes">>           <<R8332>>10248000
                                                               <<R8332>>10250000
       move dbuffer := "   CACHE DESCRIPTOR TABLE?";           <<R8332>>10252000
       print'cache := YESANSWER ( 26 );                        <<R8332>>10254000
                                                               <<R8332>>10256000
       move dbuffer := "   SEGMENT LOCALITY LISTS?";           <<R8332>>10258000
       print'sll := YESANSWER ( 26 );                          <<R8332>>10260000
                                                               <<R8332>>10262000
       move dbuffer := "   VDS PAGE ALLOCATION? ";             <<R8332>>10264000
       print'vdsl := YESANSWER ( 23 );                         <<R8332>>10266000
                                                               <<R8332>>10268000
       move dbuffer := "   VIRTUAL DISK SPACE BIT MAP?";       <<R8332>>10270000
       print'vdsm := YESANSWER ( 30 );                         <<R8332>>10272000
                                                               <<R8332>>10274000
       end;   <<yes>>                                          <<R8332>>10276000
                                                               <<R8332>>10278000
<<2>>  PRNT'MEMORY'MGT;          <<reply was "all">>           <<R8332>>10280000
                                                               <<R8332>>10282000
  end;   <<case>>                                              <<R8332>>10284000
                                                               <<R8332>>10286000
end;   <<subroutine memory'mgt>>                               <<R8332>>10288000
$page                                                          <<R8332>>10290000
subroutine io'mgt;                                             <<R8332>>10292000
                                                               <<R8332>>10294000
comment *******************************************************<<R8332>>10296000
*                                                              <<R8332>>10298000
* IO'MGT --                                                    <<R8332>>10300000
*                                                              <<R8332>>10302000
* Prompts user with questions about what I/O Management tables,<<R8332>>10304000
* if any, should be printed. If the answer to the first        <<R8332>>10306000
* question is "all", then all tables are printed, and further  <<R8332>>10308000
* I/O mgmt. questions are not asked.                           <<R8332>>10310000
*                                                              <<R8332>>10312000
***************************************************************<<R8332>>10314000
;                                                              <<R8332>>10316000
                                                               <<R8332>>10318000
begin                                                          <<R8332>>10320000
                                                               <<R8332>>10322000
move dbuffer := "  I/O MANAGEMENT? ";                          <<R8332>>10324000
                                                               <<R8332>>10326000
case *ANSWER ( 17 ) of           <<* = no bounds checks>>      <<R8332>>10328000
                                                               <<R8332>>10330000
  begin                                                        <<R8332>>10332000
                                                               <<R8332>>10334000
<<0>>  <<nop>>;                  <<reply was "no" or CR>>      <<R8332>>10336000
                                                               <<R8332>>10338000
<<1>>  begin  <<yes>>            <<reply was "yes">>           <<R8332>>10340000
                                                               <<R8332>>10342000
       move dbuffer := "   DRT? ";                             <<R8332>>10344000
       print'drt := YESANSWER ( 7 );                           <<R8332>>10346000
                                                               <<R8332>>10348000
       move dbuffer := "   INTERRUPT LINKAGE? ";               <<R8332>>10350000
       print'ilt := YESANSWER ( 21 );                          <<R8332>>10352000
                                                               <<R8332>>10354000
       move dbuffer := "   LOGICAL-PHYSICAL DEVICE? ";         <<R8332>>10356000
       print'lpdt := YESANSWER ( 27 );                         <<R8332>>10358000
                                                               <<R8332>>10360000
       move dbuffer := "   DIT? ";                             <<R8332>>10362000
       print'dit := YESANSWER ( 7 );                           <<R8332>>10364000
                                                               <<R8332>>10366000
       move dbuffer := "   DISC REQUEST TABLE ?";              <<R8332>>10368000
       print'drqt := YESANSWER ( 23 );                         <<R8332>>10370000
                                                               <<R8332>>10372000
       move dbuffer := "   IOQ? ";                             <<R8332>>10374000
       print'ioq := YESANSWER ( 7 );                           <<R8332>>10376000
                                                               <<R8332>>10378000
       move dbuffer := "   SYSTEM BUFFERS?";                   <<R8332>>10380000
       print'sbuf := YESANSWER ( 18 );                         <<R8332>>10382000
                                                               <<R8332>>10384000
       move dbuffer := "   TERMINAL BUFFERS?";                 <<R8332>>10386000
       print'tbuf := YESANSWER ( 20 );                         <<R8332>>10388000
                                                               <<R8332>>10390000
       end;  <<yes>>                                           <<R8332>>10392000
                                                               <<R8332>>10394000
       PRNT'IO'MGT;              <<reply was "all">>           <<R8332>>10396000
                                                               <<R8332>>10398000
  end;   <<case>>                                              <<R8332>>10400000
                                                               <<R8332>>10402000
end;   <<subroutine io'mgt>>                                   <<R8332>>10404000
$page                                                          <<R8332>>10406000
<<------------------>>                                         <<R8332>>10408000
<<     Mainline     >>                                         <<R8332>>10410000
<<------------------>>                                         <<R8332>>10412000
                                                               <<R8332>>10414000
NEWPAGE;                                                       <<R8332>>10416000
                                                               <<R8332>>10418000
linecount := 0;                                                <<R8332>>10420000
                                                               <<R8332>>10422000
indx := -1;                                                    <<R8332>>10424000
while ( indx := indx + 1 ) < num'responses  do                 <<R8332>>10426000
  responses ( indx ) := false;                                 <<R8332>>10428000
                                                               <<R8332>>10430000
indx := -1;                                                    <<R8332>>10432000
while ( indx := indx + 1 ) <= maxbank  do                      <<R8332>>10434000
  print'bank ( indx ) := false;                                <<R8332>>10436000
                                                               <<R8332>>10438000
                                                               <<R8332>>10440000
move dbuffer := "MINIDUMP? ";                                  <<R8332>>10442000
mini'dump := YESANSWER ( 9 );                                  <<R8332>>10444000
                                                               <<R8332>>10446000
if mini'dump then PICKDSTS;                                    <<R8332>>10448000
                                                               <<R8332>>10450000
move dbuffer := " FORMAT TABLES? ";                            <<R8332>>10452000
                                                               <<R8332>>10454000
case *ANSWER ( 15 ) of           <<* = no bounds checks>>      <<R8332>>10456000
                                                               <<R8332>>10458000
  begin                                                        <<R8332>>10460000
                                                               <<R8332>>10462000
<<0>>  <<nop>> ;               <<answer was "no" or CR ...>>   <<R8332>>10464000
                               <<do not format tables>>        <<R8332>>10466000
                                                               <<R8332>>10468000
<<1>>  begin  <<yes>>          <<answer was "yes" ...>>        <<R8332>>10470000
                               <<continue interactive dialog>> <<R8332>>10472000
                                                               <<R8332>>10474000
       print'index := true;    <<now we'll need an index>>     <<R8332>>10476000
                                                               <<R8332>>10478000
       move dbuffer := "  REGISTERS?";                         <<R8332>>10480000
       print'registers := YESANSWER ( 12 );                    <<R8332>>10482000
                                                               <<R8332>>10484000
       PROCESS'CONTROL;                                        <<R8332>>10486000
       MEMORY'MGT;                                             <<R8332>>10488000
       IO'MGT;                                                 <<R8332>>10490000
                                                               <<R8332>>10492000
       move dbuffer := "  TIMER REQUEST LIST? ";               <<R8332>>10494000
       print'trl := YESANSWER ( 21 );                          <<R8332>>10496000
                                                               <<R8332>>10498000
       move dbuffer := "  SIR?";                               <<R8332>>10500000
       print'sir := YESANSWER ( 6 );                           <<R8332>>10502000
                                                               <<R8332>>10504000
       move dbuffer := "  MONITOR?";                           <<R8332>>10506000
       print'mon := YESANSWER ( 10 );                          <<R8332>>10508000
                                                               <<R8332>>10510000
       end;  <<yes>>                                           <<R8332>>10512000
                                                               <<R8332>>10514000
                                                               <<R8332>>10516000
<<2>>  begin  <<all>>          <<answer was "all" ...>>        <<R8332>>10518000
                               <<format all tables>>           <<R8332>>10520000
       print'index := true;                                    <<R8332>>10522000
                                                               <<R8332>>10524000
       print'registers := true;                                <<R8332>>10526000
       PRNT'PROCESS;             <<set all PM flags>>          <<R8332>>10528000
       PRNT'MEMORY'MGT;          <<set all MMT flags>>         <<R8332>>10530000
       PRNT'IO'MGT;              <<set all I/O flags>>         <<R8332>>10532000
       print'trl := true;                                      <<R8332>>10534000
       print'sir := true;                                      <<R8332>>10536000
       print'mon := true;                                      <<R8332>>10538000
       end;  <<all>>                                           <<R8332>>10540000
                                                               <<R8332>>10542000
  end;  <<case>>                                               <<R8332>>10544000
                                                               <<R8332>>10546000
PRIMARY'MEMORY;                                                <<R8332>>10548000
                                                               <<R8332>>10550000
                                                               <<R8332>>10552000
end;   <<procedure interactive'dialog>>                        <<R8332>>10554000
                                                                        10556000
$include INCLDNKN                                                       10558000
$include INCLDNIO                                                       10560000
$include INCLDNDA                                                       10562000
$include INCLDNDS                                                       10564000
$include INCLDNMR                                                       10566000
$include INCLDNTG                                                       10568000
$include INCLDNOB                                                       10570000
