$CONTROL USLINIT,MAP,CODE                                      <<03006>>00010000
<<SYSDUMP - MODULE 01>>                                                 00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$CONTROL MAIN=SYSDUMP,PRIVILEGED                                        00030000
$CONTROL PRIVILEGED,UNCALLABLE                                          00032000
<<----------------------------------------------------------------------00034000
         M P E   S Y S T E M   D U M P   P R O G R A M                  00036000
---------------------------------------------------------------------->>00038000
$CONTROL SEGMENT=MAINSEG1                                               00040000
BEGIN                                                                   00042000
$PAGE "CONSTANT DEFINITION"                                             00044000
  ENTRY DEFAULTS;                                              <<01210>>00046000
  LOGICAL DEFAULT := TRUE;  <<RESET IF SYSDUMP-SEE OUTER BLK>> <<01210>>00048000
         <<-------------->>                                    <<02509>>00050000
         <<  MISC. MAPS  >>                                    <<02509>>00052000
         <<-------------->>                                    <<02509>>00054000
  EQUATE BITMAP0  = %12,     << SERIES II,III >>               <<02509>>00056000
         BITMAP1  = %64,     << SERIES 33,44,55 >>             <<02509>>00058000
         BITMAP2  = %12,     << SIO MACHINES >>                <<02509>>00060000
         BITMAP3  = %64,     << HPIB MACHINES >>               <<02509>>00062000
         BITMAP4  = %12,     << TAPES USING SIO >>             <<02509>>00064000
         BITMAP5  = %76,     << TAPES USING AMIGO >>           <<02509>>00066000
         BITMAP6  = %76;     << TAPES USING CS80 >>            <<02509>>00068000
                                                               <<02509>>00070000
          <<-------------                                               00072000
            TABLE SIZES                                                 00074000
          ------------->>                                               00076000
EQUATE CORE256X = 7; <<INDEX OF 256K>>                         <<.2MB.>>00078000
  EQUATE  LDTSIZE   =    5,          <<LOGICAL DEVICE TABLE ENTRY SIZE>>00080000
          LDTXSIZE  =    5,          <<LDT EXTENSION>>         <<00.06>>00082000
          LPDTSIZE  =    2,          <<LOG-PHYS DEV TABLE ENTRY SIZE>>  00084000
          DVRSIZE   =    6,          <<DRIVER TABLE ENTRY SIZE>>        00086000
          VTABSIZE  =    14,         <<VOLUME TABLE ENTRY SIZE>>        00088000
          PERPORTMAX=    99,         <<MAX. NO. TBUFS/PORT>>   <<03007>>00090000
          CTAB0SIZE =    128,        <<CONFIGURATION INFO TABLE SIZE>>  00092000
          NCORESIZES=    36,         <<# MEM SIZES>>           <<01757>>00094000
          CTABSIZE  =    128,        <<CORESIZE-RELATED INFO SIZE>>     00096000
        CTABTSIZE=CTABSIZE*(CORE256X+1),                       <<.2MB.>>00098000
          INFOSIZE  =    256,        <<DISC COLD LOAD INFO TABLE>>      00100000
          NCST      =    32,         <<# OF TEMPORARY CST ENTRIES>>     00102000
          TCSTSIZE  =    NCST*4,     <<SIZE OF TEMPORARY CST>>          00104000
          CSDVRSIZE =    4,           <<CS ADDITIONAL DVRS>>            00106000
          CSDRIVERS =    32,       <<MAX CS ADDITIONAL DVRS>>           00108000
          DVRTSIZE  =    128*DVRSIZE,                                   00110000
          CSDEFSIZE =    256,                                           00112000
          CSDVRTSIZE=    CSDRIVERS*CSDVRSIZE,                           00114000
          EXPTABLES =    8; <<# OF TABLES WHICH EXPAND>>       <<00778>>00116000
                                                                        00118000
          <<----------------------                                      00120000
            LOGICAL DEVICE TABLE                                        00122000
          ---------------------->>                                      00124000
  EQUATE  DCFIRST   =    1,          <<POINTER TO FIRST CLASS>>         00126000
          DCNUM     =    2,          <<NUMBER OF DEVICE CLASSES>>       00128000
          DCSIZE    =    3,          <<SIZE OF DEVICE CLASS TABLE>>     00130000
          LDT2      =    2,          <<3RD WORD OF ENTRY>>              00132000
          LDT3       =    3,          <<4TH WORD OF ENTRY>>             00134000
          LDT4       =    4;          <<5TH WORD OF ENTRY>>             00136000
  DEFINE  RECW      =    (0:8)#,     <<PHYSICAL RECORD WIDTH>>          00138000
          RANGE     =    (10:3)#,    <<TYPE RANGE>>                     00140000
          TYP       =    (10:6)#,    <<TYPE>>                           00142000
          NSDV      =    ( 4:1)#,    <<NON-SYSTEM DOMAIN>>     <<RH.PV>>00144000
          TERMTYP    =    (0:7)#,        <<TERMINAL TYPE>>              00146000
          CSBIT     =    (8:1)#,   <<CS DEVICE >>                       00148000
          SPOOLST   =    (0:2)#,     <<SPOOLING STATE>>                 00150000
          SPOOLQUE  =    (7:1)#,                                        00152000
          FILEBIT   =    (2:1)#,     <<DEVICE BELONGS TO FILE SYSTEM>>  00154000
          OUTCL     =    (7:1)#,     <<OUTPUT DEVICE IS CLASS INDEX>>   00156000
          OUTDEV    =    (8:8)#;     <<OUTPUT DEVICE>>                  00158000
          <<--------------------->>                            <<03544>>00160000
          <<    DISC TYPES       >>                            <<03544>>00162000
          <<--------------------->>                            <<03544>>00164000
  EQUATE  DISC0=0,  << MOVING HEAD DISCS >>                    <<03544>>00166000
          DISC1=1,  << FIXED HEAD DISCS >>                     <<03544>>00168000
          DISC2=2,  << FLOPPY DISCS >>                         <<03544>>00170000
          DISC3=3;  << MOVING HEAD DISCS--CS'80 >>             <<03544>>00172000
          << ***** TYPE 0 REMOVABLE SUBTYPES ***** >>          <<03544>>00174000
  EQUATE  UH7905 =  4,  << SUBTYPE UPPER PART 7905 >>          <<03544>>00176000
          S7920  =  8,  << SUBTYPE 7920 >>                     <<03544>>00178000
          S7925  =  9,  << SUBTYPE 7925 >>                     <<03544>>00180000
          UH7906 = 10,  << SUBTYPE UPPER PART 7906 >>          <<03544>>00182000
          << ***** TYPE 3 REMOVABLE SUBTYPES ***** >>          <<03544>>00184000
          LINUS  =  0,  << SUBTYPE LINUS >>                    <<03544>>00186000
          S7935  =  8;  << SUBTYPE 7935 >>                     <<03544>>00188000
                                                               <<00072>>00190000
                                                               <<00.06>>00192000
          <<------------------------------>>                   <<00.06>>00194000
          <<LOGICAL DEVICE TABLE EXTENSION>>                   <<00.06>>00196000
          <<------------------------------>>                   <<00.06>>00198000
  EQUATE  LDTX1     =1,          <<2ND WORD OF ENTRY>>         <<00.06>>00200000
          LDTX2     =2;          <<3RD WORD OF ENTRY>>         <<03007>>00202000
  DEFINE<<TERMPROTOCOL = (8:8)#, >> << TERMINAL PROTOCOL,  >>  <<03702>>00204000
                                    << RESERVED FOR FUTURE >>  <<03702>>00206000
          TERMBOARD    = (0:1)#; << 0=ADCC, 1=LYNX      >>     <<03007>>00208000
  EQUATE  LDTX3     =3,          <<4TH WORD OF ENTRY>>         <<03007>>00210000
          LDTX4     =4;          <<5TH WORD OF ENTRY>>         <<00.06>>00212000
  DEFINE  TERMSPEED =(10:6)#,                                  <<01852>>00214000
          LDTX'SA   =(0:1)#;     <<SEEKAHEAD FLAG>>            <<01852>>00216000
                                                                        00218000
          <<-------------------------------                             00220000
            LOGICAL-PHYSICAL DEVICE TABLE                               00222000
          ------------------------------->>                             00224000
  EQUATE  LPDT1     =    1;          <<2ND WORD OF ENTRY>>              00226000
  DEFINE  AJOBS     =    (2:1)#,     <<ACCEPT JOBS>>                    00228000
          ADATA     =    (3:1)#,     <<ACCEPT DATA>>                    00230000
          DUPLIC    =    (5:1)#,     <<DUPLICATIVE>>                    00232000
          INTRACT   =    (6:1)#,     <<INTERACTIVE>>                    00234000
          SUBTYPE   =    (12:4)#;    <<DEVICE SUBTYPE>>                 00236000
                                                                        00238000
          <<--------------                                              00240000
            DRIVER TABLE                                                00242000
          -------------->>                                              00244000
  EQUATE  DVR1      =    1,          <<2ND WORD OF ENTRY>>              00246000
          DVR2      =    2;          <<3RD WORD OF ENTRY>>              00248000
  DEFINE  CRBIT     =    (0:1)#,     <<DRIVER IS CORE RESIDENT>>        00250000
          DVRCHAN   =    (1:3)#,     <<CHANNEL #>>                      00252000
          UNITFIELD =    (9:7)#,                               <<03006>>00254000
          DRTFIELD  =    (0:9)#,                               <<03006>>00256000
          DSBIT     =    (7:1)#,                               <<03006>>00258000
          DSDRTN    =    (8:8)#;     <<LDEV DS DEVICE LINKED TO>>       00260000
  INTEGER MAXDRT;                    <<MAX DRT FOR THIS CPU>>  <<03006>>00262000
  EQUATE  MAXUNIT   =    127;        <<MAX ALLOWABLE UNIT>>    <<03006>>00264000
                                                                        00266000
          <<--------------                                              00268000
            VOLUME TABLE                                                00270000
          -------------->>                                              00272000
  EQUATE  VTAB8     =     8,         << WORD 8 OF VTAB >>      <<01549>>00274000
          VTAB10    =    10,         << WORD 10 OF VTAB >>     <<01549>>00276000
          VTAB12    =    12;         << WORD 12 OF VTAB >>     <<01549>>00278000
  DEFINE  VMS       =    (12:1)#,    << V.M. SUPPORTING >>     <<01549>>00280000
          VTABLDEV  =    (0:8)#;     << LOGICAL DEVICE # >>    <<01549>>00282000
                                                                        00284000
          <<------------                                                00286000
            TABLE DSTS                                                  00288000
          ------------>>                                                00290000
  EQUATE  LPDTDSTN  =    13,         <<LOGICAL-PHYSICAL DEVICE TABLE>>  00292000
          LDTDSTN   =    14,         <<LOGICAL DEVICE TABLE>>           00294000
          DRSPDST   =    21,         <<DIRECTORY SPACE>>                00296000
          RINDSTN   =    22,         <<RIN TABLE>>                      00298000
      LIDDST   =   33,                                         <<00506>>00300000
          VTABDSTN  =    29;         <<VOLUME TABLE>>                   00302000
                                                                        00304000
         <<--------->>                                         <<TP.00>>00306000
         <<CPU TYPES>>                                         <<TP.00>>00308000
         <<--------->>                                         <<TP.00>>00310000
  EQUATE SERIES'I  =      0,         <<RETURN VALUES FROM>>    <<TP.00>>00312000
         SERIES'II =      1,         <<THISCPU PROCEDURE>>     <<TP.00>>00314000
         LC3000    =      2,                                   <<TP.00>>00316000
         SERIES'35 =      3,                                   <<01402>>00318000
         ICF44     =      4,                                   <<01402>>00320000
         ICF55     =      5;                                   <<01402>>00322000
  DEFINE POSTSERIES3    = BITMAP1&CSR(CPUTYPE)#,               <<02509>>00324000
         SERIESII'III   = BITMAP0&CSR(CPUTYPE)#;               <<02509>>00326000
         <<----------------------->>                           <<02509>>00328000
         <<  I/O SYSTEM FORMATS   >>                           <<02509>>00330000
         <<----------------------->>                           <<02509>>00332000
                                                               <<02509>>00334000
  DEFINE IO'SIO          = BITMAP2&CSR(CPUTYPE)#,              <<02509>>00336000
         IO'HPIB         = BITMAP3&CSR(CPUTYPE)#,              <<02509>>00338000
         CLTAPE'SIO      = BITMAP4&CSR(CPUTYPE)#,              <<02509>>00340000
         CLTAPE'AMIGO    = BITMAP5&CSR(CPUTYPE)#,              <<02509>>00342000
         CLTAPE'CS80     = BITMAP6&CSR(CPUTYPE)#;              <<02509>>00344000
                                                               <<02509>>00346000
                                                               <<TP.00>>00348000
          <<--------------------------->>                      <<00134>>00350000
          <<MESSAGE CATALOG SET NUMBERS>>                      <<00134>>00352000
          <<--------------------------->>                      <<00134>>00354000
   EQUATE CIMSGSET=2;                                          <<00134>>00356000
                                                               <<00134>>00358000
          <<------                                                      00360000
            SIRS                                                        00362000
          ------>>                                                      00364000
  EQUATE  DIRSIR    =    8,          <<DIRECTORY>>                      00366000
          FMAVTSIR =    16,          <<FMAVT>>                 <<00197>>00368000
          RINSIR    =    38,         <<RIN SIR>>                        00370000
          FLABSIR   =    37;         <<FILE LABEL>>                     00372000
                                                                        00374000
          <<---------------------                                       00376000
            CONFIGURATION TABLE                                         00378000
          --------------------->>                                       00380000
  EQUATE  CORESIZE  =    0,          <<CORE SIZE IN K WORDS>>           00382000
          COREX'    =    1,          <<CORE SIZE INDEX>>                00384000
          SSS       =    2,          <<STD STACK SIZE>>                 00386000
          DRTNUM    =    3,          <<HIGHEST DRT #>>                  00388000
          TERMPRI   =    4,          <<TERMINAL BOUND JOB PRIORITY>>    00390000
          NORMPRI   =    5,          <<NORMAL JOB PRIORITY>>            00392000
          CPUPRI    =    6,          <<CPU BOUND JOB PRIORITY>>         00394000
          LOGON     =    7,          <<NUMBER OF SECONDS TO LOGON>>     00396000
          LOGRECSIZE=    8,          <<LOG FILE RECORD SIZE>>           00398000
          LOGFILESIZE=   9,          <<LOG FILE SIZE IN RECORDS>>       00400000
          LOGFILENUM'=   10,         <<LOG FILE NUMBER>>                00402000
          LOGBITS   =    11,         <<WHAT IS BEING LOGGED>>           00404000
          CPULIM    =    16,         <<DEFAULT CPU TIME LIMIT>>         00406000
          FILESDUMPED=   17,         <<USER FILES ON TAPE>>             00408000
          HLDEV'    =    18,         <<HIGHEST LOGICAL DEVICE #>>       00410000
          HVOL'     =    19,         <<HIGHEST VOLUME NUMBER>>          00412000
          DVCLSIZE' =    20,         <<DEVICE CLASS TABLE SIZE>>        00414000
          FIXLEVEL' =    21,         <<MPE FIX LEVEL>>                  00416000
          COLDLOADID'=   22,         <<COLD LOAD COUNT>>                00418000
          MAXINITSEG'=   23,         <<MAX INITIAL SEGMENT SIZE>>       00420000
          DISCENTRY'=    24,         <<DISC COLD LOAD ENTRY POINT>>     00422000
          OLDVTABSIZE=   25,         <<SIZE OF OLD VOLUME TABLE>>       00424000
          OLDINFOSIZE=   26,         <<SIZE OF OLD INFO TABLE>>         00426000
          TSLICE    =    27,         <<TIME QUANTUM>>                   00428000
          MAXSPOOLF =    28,         <<MAX OPEN SPOOLFILES>>            00430000
          KILOSECTS =    15,         <<SPOOLFILE KILOSECTORS>>          00432000
          EXTSSECT' =    33,         <<SECTOR/SPOOLFILE EXT>>           00434000
          UPDATEL'  =    34,         <<UPDATE LEVEL>>                   00436000
          VERSION'  =    35,                                   <<00.SD>>00438000
          SERIALDISCLOAD'=36,                                  <<00932>>00440000
          MITVERSION =    37,                                  <<00932>>00442000
          MITUPDATE  =    38,                                  <<00932>>00444000
          MITFIX     =    39,                                  <<03006>>00446000
          ID0        =    40,        << 4 CONVERSION     >>    <<03006>>00448000
          ID1        =    41,        << IDENTIFICATION   >>    <<03006>>00450000
          ID2        =    42,        << WORDS            >>    <<03006>>00452000
          ID3        =    43,                                  <<03604>>00454000
          TAPERECSIZE' =  44;                                  <<03604>>00456000
                                                               <<03006>>00458000
          << CONVERSION BITS FOR CTAB0 WORDS 40-43 >>          <<03006>>00460000
  DEFINE  DRTCNVRT   = (0:1)#, <<ID0; 0=7 BIT DRT, 1=9 BIT >>  <<03006>>00462000
          LYNXCNVRT  = (1:1)#; <<ID0; 1=NO. OF TBUFS       >>  <<03006>>00464000
                               << (CTAB(TBUFNUM)) CONVERTED>>  <<03006>>00466000
                                                               <<03006>>00468000
  DEFINE  LOADTYPE=(15:1)#, <<SET IF>>                         <<00150>>00470000
                            <<SYSDUMP IS TO A SERIAL DISC>>    <<00150>>00472000
          LOADDATE=(14:1)#; <<SET IF>>                         <<00150>>00474000
                            <<SYSDUMP IS FUTUREDATE>>          <<00150>>00476000
  EQUATE  CSTNUM    =    0,      <<# OF CST ENTRIES>>                   00478000
          DSTNUM    =    1,      <<# OF DST ENTRIES>>                   00480000
          PCBNUM    =    2,      <<# OF PCB ENTRIES>>                   00482000
          IOQNUM    =    3,      <<# OF IOQ ENTRIES>>                   00484000
          TBUFNUM   =    4,      <<# OF TERMINAL BUFFERS>>              00486000
          CSTXNUM   =    5,          <<# OF PROGRAM AREA CSTS>>         00488000
          ICSSIZE   =    6,      <<# OF WORDS ON ICS>>                  00490000
          UCRQNUM   =    7,      <<# OF UCOP REQ QUEUE ENTRIES>>        00492000
          STOPNUM   =    8,          <<# OF BREAKPOINT TABLE ENTRIES>>  00494000
          TRLNUM    =    9,      <<# OF TIMER REQUEST LIST ENTRIES>>    00496000
          RINS'     =    10,         <<# OF RINS>>                      00498000
          GRINS'    =    11,         <<MAX # OF GLOBAL RINS>>           00500000
          SBUFNUM   =    12,         <<# OF SYSTEM BUFFERS>>            00502000
          CONPROGNUM=    13,         <<# OF CONCURRENT PROGRAMS>>       00504000
          << TYPEBUF (WORD 15) IS RESERVED FOR FUTURE USE >>   <<03702>>00508000
     <<   TYPEBUF   =    15,     <<TYPE AHEAD BUFFER SIZE>>    <<03702>>00510000
          VIRMEMSECT'=   20,     <<SIZE OF VIRTUAL MEMORY>>             00512000
          DIRSECT'  =    21,         <<SIZE OF DIRECTORY IN SECTORS>>   00514000
          MCSS      =    30,     <<MAY CODE SEG SIZE>>                  00516000
          MCSP      =    31,         <<MAX CODE SEGS/PROCESS>>          00518000
          MSTACK    =    32,         <<MAX STACK SIZE>>                 00520000
          MXDSS     =    33,     <<MAX EXTRA DATA SEG SIZE>>            00522000
          MXDSP     =    34,         <<MAX XTRA DATA SEGS/PROCESS>>     00524000
          MAXRSES   =    40,     <<MAX RUNNING SESSIONS>>               00526000
          CSTABSIZE =    29,         <<CS DATA SEGMENT SIZE>>           00528000
          NUMADVRS  =    32,         <<# OF ADDITIONAL CS DRIVERS>>     00530000
   MAXRJOB   =   41,                                           <<00506>>00532000
   NLOGPROCS   =   42,                                         <<00506>>00534000
          LOGIDS=43,                                           <<01626>>00536000
          DISCREQTABLE=44,         <<DISC REQUEST TABLE LENGTH>>        00538000
          SPECIALREQTABLE=45,      <<SPECIAL REQUEST TABLE LENGTH>>     00540000
          PRIMARYMSGTABLE=46,      <<PRIMARY MESSAGE TABLE LENGTH>>     00542000
          SECNDRYMSGTABLE=48, <<2NDARY MSG TABLE LENGTH>>      <<03701>>00544000
          SWAPTABLE=47;            <<SWAP TABLE LENGTH>>       <<01626>>00546000
                                                                        00548000
          <<-------------                                               00550000
            SYSTEM DISK                                                 00552000
          ------------->>                                               00554000
  EQUATE  SYSDISC   =    1,       << SYSTEM DISC LDEV >>       <<03544>>00556000
          INFOSECT  =    28;     <<COLD LOAD INFO SECTOR ADDR>><<00.DL>>00558000
                                                                        00560000
          <<--------------------                                        00562000
            CONFIGURATION FILE                                          00564000
          -------------------->>                                        00566000
  EQUATE  CTABREC   =    1;          <<NON-CORESIZE CONFIDURATION REC>> 00568000
  DEFINE  DVRREC    =    9D#,      <<DRIVER TABLE RECORD>>              00570000
          CSDVRREC  =    21D#,     <<CS DRIVER TABLE RECORD>>           00572000
          CSDEFREC  =    22D#;     <<CS DEVICE INDEX TO CSTAB>>         00574000
                                                                        00576000
          <<---------------------                                       00580000
            SEGMENTER COMMANDS                                          00582000
          -------------------->>                                        00584000
  EQUATE  ADDSL     =    1,      <<ADD SL SEGMENT>>                     00586000
          EXITSEG   =    8,      <<EXIT SEGMENTER>>                     00588000
          LISTSL    =    11,     <<LIST SL>>                            00590000
          PURGESL   =    17,     <<REMOVE SL SEGMENT>>                  00592000
          USESL     =    20,     <<SL>>                                 00594000
          USEUSL    =    22;     <<USL>>                                00596000
                                                                        00598000
          <<-----------------                                           00600000
            CONDITION CODES                                             00602000
          ----------------->>                                           00604000
  EQUATE  CCG       =    0,          <<GREATER>>                        00606000
          CCL       =    1,          <<LESS>>                           00608000
          CCE       =    2;          <<EQUAL>>                          00610000
  DEFINE  CC        =    STAT.(6:2)#;<<STATUS BITS>>           <<01549>>00612000
                                                               <<04659>>00614000
          <<-------------------->>                             <<04659>>00616000
          <<  ASCII characters  >>                             <<04659>>00618000
          <<-------------------->>                             <<04659>>00620000
                                                               <<04659>>00622000
  EQUATE                                                       <<04659>>00624000
          CR        =    %15,                                  <<04659>>00626000
          CR'SEMI   =    %6473;      << CR & ";" >>            <<04659>>00628000
                                                                        00630000
          <<---------------------------                                 00632000
            COLD LOAD TAPE PARAMETERS                                   00634000
          --------------------------->>                                 00636000
  EQUATE  STACKSIZE =    896,        <<INITIAL STACK SIZE>>    <<02509>>00638000
          MARKERSIZE=    12,         <<INITIAL STACK MARKER>>           00640000
          NSTARTSEG =    11,         <<# OF INITIAL'S SEGMENTS <<03604>>00642000
          NNONSWAPSEG=   4,          <<# OF SEGMENTS NOT SWAPPE<<03604>>00644000
          A0SIZE    =    12,         <<LOW CORE AREA SIZE>>             00646000
          ICSBASE   =    %174000,    <<START OF ICS>>          <<03604>>00648000
          ICSLEN    =    40,         <<ICS LENGTH>>            <<03604>>00650000
          ICSQI     =    18,         <<ICS Q VALUE>>           <<03604>>00652000
          ICSZI     =  2044,         <<ICS Z VALUE>>           <<03604>>00654000
          CSTBASE   = ICSBASE-TCSTSIZE;<<START ADR OF CST>>    <<03604>>00656000
  DEFINE  COREEND   =    %377750D#;  <<BANK 1, ADDRESS 177750>><<03604>>00658000
  DEFINE  INITZ     =    %160000D#;<<INITIAL'S Z @ COLD LOAD>> <<03604>>00660000
                                                                        00662000
          <<--------------------------                                  00664000
            SYSTEM GLOBAL AREA CELLS                                    00666000
          -------------------------->>                                  00668000
  EQUATE  DIRDISC1  =    %130,        <<HIGH-ORDER BITS>>      <<00215>>00670000
          DIRDISC2  =    %131,        <<LOW-ORDER BITS>>       <<00215>>00672000
          SYSID     =    %115,        <<SYSTEM ID>>                     00674000
          SYSDISKLDEV=   62,          <<SYSTEM DISK LOGICAL DEVICE>>    00676000
          LOGFILENUM=    %205,        <<LOG FILE NUMBER>>               00678000
          COLDLOADCNT=   %75;         <<COLD LOAD COUNT>>               00680000
                                                                        00682000
  <<----------------                                                    00684000
    C S DATA SEGMENT                                                    00686000
  ---------------->>                                                    00688000
   DEFINE CSLDTXENTRYSIZE = CSLDTX #,                                   00690000
          CSLDTXHSI'CHAN  = CSLDTX(1).(1:4)#,                           00692000
          CSLDTXPROTOCOL  = CSLDTX(1).(8:8)#,                           00694000
          CSLDTXMODE     = CSLDTX(2).(6:4)#,                            00696000
          CSLDTXCODE      = CSLDTX(2).(10:6)#,                          00698000
          CSLDTXDUAL'SPEED= CSLDTX(3).(0:1)#,                           00700000
          CSLDTXHALF'SPEED= CSLDTX(3).(1:1)#,                           00702000
          CSLDTXXMSNMODE   = CSLDTX(3).(2:2)#,                          00704000
          CSLDTXSPEEDCHNGBLE=CSLDTX(3).(4:1)#,                          00706000
          CSLDTXANSWER    = CSLDTX(3).(5:2)#,                           00708000
          CSLDTXDIAL      = CSLDTX(3).(7:1)#,                           00710000
          CSLDTXAUTO'DIAL'LDN=CSLDTX(3).(8:8)#,                         00712000
          CSLDTXDOPTIONS  = CSLDTX(4)#,                                 00714000
          CSLDTXRECV'TIMEOUT=CSLDTX(5)#,                                00716000
          CSLDTXLOCAL'TIMEOUT=CSLDTX(6)#,                               00718000
          CSLDTXCONCT'TIMEOUT=CSLDTX(7)#,                               00720000
          CSLDTXINSPEED   = DCSLDTX(4)#,                                00722000
          CSLDTXOUTSPEED  = DCSLDTX(5)#,                                00724000
          CSLDTXPBUFFSIZE  = CSLDTX(12)#,                               00726000
          CSLDTXLDEV      = CSLDTX(13).(0:8)#,                 <<01165>>00728000
          CSLDTXDRINDEX   = CSLDTX(13).(8:8)#,                 <<01165>>00730000
          CSLDTXCONTPTR   = CSLDTX(14)#,                                00732000
          CSLDTXIDLISTPTR = CSLDTX(15)#,                                00734000
          CSLDTXPHLISTPTR = CSLDTX(16)#,                                00736000
          CSLDTXDVRCHANGABLE = CSLDTX(1).(0:1)#;                        00738000
  EQUATE  CSDSTN    =    49,                                            00740000
          CSXENTRIES=    1,                                             00742000
          CSXPTR    =    2,                                             00744000
          CSXSIZE   =    6,                                             00746000
          CSXSTART  =    7,                                             00748000
          INTCOMDELAY=   1, <<INTERCOMPONENT DELAY>>                    00750000
          CIRPDELAY =    2, <<CIRCULAR POLL DELAY >>                    00752000
          CONTRSTART=    18,<<CONTROL/TRIBUTARY SECT STARTS>>  <<00.06>>00754000
          MANLANSWER=    1,      <<MANUAL ANSWER>>                      00756000
          AUTOANSWER=    2,      <<AUTOMATIC ANSWER>>                   00758000
          NUMSEQ    =    2,      <<NUMBER OF SEQUENCES>>                00760000
          CONSEQSTART=   5,      <<COMPOENCE SEQUENCE                   00762000
                                START FOR CONTROL SECTION>>             00764000
          NUMSTATION=    8;      <<# OF STATIONS>>                      00766000
   EQUATE CSDEV17   =    17,  <<SCCP>>                         <<01165>>00768000
          CSDEV18   =    18,  <<SSLC>>                         <<01165>>00770000
          CSDEV19   =    19;  <<HSI>>                          <<01165>>00772000
  DEFINE  REMOSTAT      = 4).(0:8#,    <<REMOTE STATIONS>>              00774000
          NUMCOMP       = 4).(8:8#,  <<# OF COMPONENTS>>               00776000
          COMPTYP       = (6:2)#,                                       00778000
          FIRSTCOMP     = 3).(0:8#,                                     00780000
          LASTCOMP      = 3).(8:8#,                                     00782000
          NEXTCOMP      = (0:6)#,                                       00784000
          INTYPE      =   (0:2)#,                                       00786000
          SWITCHED  =    (LPDTENT(LPDT1).SUBTYPE MOD 4)=0#,             00788000
          NONSWITCHED=   1<=(LPDTENT(LPDT1).SUBTYPE MOD 4)<=3#,         00790000
          MODEM      =   0<=(LPDTENT(LPDT1).SUBTYPE MOD 4)<=2#,         00792000
          HARDWIRED =    (LPDTENT(LPDT1).SUBTYPE MOD 4)=3#,             00794000
          CSDEV     =    CSDEV17<=TYPE<=CSDEV19#,              <<03544>>00796000
          CSDEVICE  =    CSDEV17<=LDTENT(LDT2).TYP<=CSDEV19#,  <<01165>>00798000
          CONTENTION=    1<=CSLDTXMODE<=2#,<<AKA PNT-TO-PNT>>  <<+0.06>>00800000
          SUPERVISED=    3<=CSLDTXMODE<=4#, <<AKA MULTI-POINT>><<+0.06>>00802000
          <<AKA MEANS "ALSO KNOWN AS">>                        <<+0.06>>00804000
          CONTROLST =    CSLDTXMODE=3#,                                 00806000
          TRIBUTARY =    CSLDTXMODE=4#,                                 00808000
          CSPRESENT =    CSTAB(CSXENTRIES)>0#;                          00810000
EQUATE NSYSPROG  = 34, <<#SYSTEM PROGS COMMON TO BOTH>>        <<04536>>00812000
       NSYSPROG'2 =14, <<#SYSTEM PROGS UNIQUE TO SERIES'II>>   <<01300>>00814000
       NSYSPROG'33= 9, <<#SYSTEM PROGS UNIQUE TO SERIES'33>>   <<03061>>00816000
       NSYSPROG'ALL=NSYSPROG+NSYSPROG'2+NSYSPROG'33;           <<00461>>00818000
                                                               <<DL.01>>00820000
EQUATE LOGRMAX = 18;  << MAX NUMBER OF LOG TYPES >>            <<04251>>00822000
EQUATE INBUFLEN=40, <<LENGTH IN TERM INPUT BUFFER>>            <<DL.01>>00824000
       BINBUFLEN=INBUFLEN*2; <<BYTE LENGTH>>                   <<DL.01>>00826000
                                                                        00828000
  DEFINE QUIT0=                                                         00830000
                BEGIN                                                   00832000
                MESSAGE(85);                                            00834000
                QUIT(0);                                                00836000
                END#;                                                   00838000
  DEFINE  LBITE     =    (0:8)#,     <<LEFT BYTE>>                      00840000
          RBITE     =    (8:8)#;     <<RIGHT BYTE>>                     00842000
  DEFINE  SYSOP     =    (5:1)#;     <<SYSTEM OPERATOR CAPABILITY>>     00844000
  EQUATE  BLANK     =    %6440;                                         00846000
  DEFINE  DUPLICATE =    TOS:=S0#;                                      00848000
  DEFINE  D'L       =    DOUBLE(LOGICAL#;                               00850000
  EQUATE  DIRACCESS =    0,  <<DIRECT ACCESS>>                          00852000
          SERINPUT  =    1,  <<SERIAL INPUT>>                           00854000
          CONINOUT  =    2,  <<CONCURRENT I/O>>                         00856000
          NCONINOUT =    3,  <<NON CONCURRENT I/O>>                     00858000
          SEROUTPUT =    4,  <<SERIAL OUTPUT>>                          00860000
          TERMDEVTYPE=   16, <<TERMINAL DEVICE TYPE>>          <<03544>>00862000
          TAPETYPE  =    24; <<TAPE DEVICE TYPE>>              <<03544>>00864000
  DEFINE  DIRACC    =    (15:1)#,                                       00866000
          SERINP    =    (14:1)#,                                       00868000
          CONIO     =    (13:1)#,                                       00870000
          NCONIO    =    (12:1)#,                                       00872000
          SEROUT    =    (11:1)#;                                       00874000
$PAGE "DIRECTORY DATA STRUCTURE AND VARIABLES"                 <<DE>>   00876000
                                                               <<DE>>   00878000
EQUATE                                                         <<DE>>   00880000
   SYS'DDS         = 20;  << System Data Seg - Dirc buffer >>  <<DE>>   00882000
                                                               <<DE>>   00884000
EQUATE                                                         <<DE>>   00886000
   XX              = 22,                                       <<DE>>   00888000
   ZZ              = 139,                                      <<DE>>   00890000
   NAMESIZE        = 4,                                        <<DE>>   00892000
   DIRLEN          = 1024;  << Length of DDS buffer >>         <<DE>>   00894000
ARRAY                                                          <<DE>>   00896000
   DDS(*)          = DB+0;                                     <<DE>>   00898000
EQUATE             << Displacements into PREPRE >>             <<DE>>   00900000
   DDSBASE         = 0,                                        <<DE>>   00902000
   DDSBASE1        = DDSBASE,          << Logical device and>> <<DE>>   00904000
   DDSBASE2        = DDSBASE1+1,       << Directory address >> <<DE>>   00906000
   CONTENTS        = DDSBASE2+1,       << Directory Pointer >> <<DE>>   00908000
   LPNTR           = CONTENTS+1,       << DB addr of 1st ele >><<DE>>   00910000
   IOPNTR          = LPNTR+1,          << Block start address>><<DE>>   00912000
   NUMVALID        = IOPNTR+1,           <<# valid dir pp >>   <<DE>>   00914000
   DIRTY           = NUMVALID+1,                               <<DE>>   00916000
   FLAGS           = DIRTY,                                    <<DE>>   00918000
   XSIZE           = DIRTY+1,                                  <<DE>>   00920000
   USED            = XSIZE+1,            <<=XSIZE * XCOUNT>>   <<DE>>   00922000
   BSIZE           = USED+1,             <<BLOCK SIZE (PP.)>>  <<DE>>   00924000
   BWSIZE          = BSIZE+1,            <<= BSIZE & LSR(7)>>  <<DE>>   00926000
   BFACTOR         = BWSIZE+1,           <<= BWSIZE/XSIZE>>    <<DE>>   00928000
   MISCWD          = BFACTOR+1,                                <<DE>>   00930000
   XCOUNT          = MISCWD+1,                                 <<DE>>   00932000
   PCOUNT          = XCOUNT+1,                                 <<DE>>   00934000
   ETOTAL          = PCOUNT+1,                                 <<DE>>   00936000
   EMISCWD         = ETOTAL+1,                                 <<DE>>   00938000
   PINDEXP         = EMISCWD+1,                                <<DE>>   00940000
   PNAME           = PINDEXP+1;                                <<DE>>   00942000
                                                               <<DE>>   00944000
                                                               <<DE>>   00946000
ARRAY                                                          <<DE>>   00948000
   DAPREPRE(*)     = DDS(ZZ);                                  <<DE>>   00950000
ARRAY                                                          <<DE>>   00952000
   DBPREPRE (*)    = DAPREPRE(XX);                             <<DE>>   00954000
                                                               <<DE>>   00956000
INTEGER                                                        <<DE>>   00958000
   SYSACCTINDEX    = DBPREPRE+XX;                              <<DE>>   00960000
DOUBLE                                                         <<DE>>   00962000
   DIRBASE         = SYSACCTINDEX+1;                           <<DE>>   00964000
INTEGER                                                        <<DE>>   00966000
   DIRBASE1        = DIRBASE,                                  <<DE>>   00968000
   DIRBASE2        = DIRBASE1+1;                               <<DE>>   00970000
DEFINE                                                         <<DE>>   00972000
   DIRLDEV         = DIRBASE1.(0:8) #;                         <<DE>>   00974000
INTEGER                                                        <<DE>>   00976000
   SYSACCTINX'SAV  = DIRBASE+2,                                <<DE>>   00978000
   DDS'CNT         = SYSACCTINX'SAV+1;                         <<DE>>   00980000
DOUBLE                                                         <<DE>>   00982000
   DDS'CNT1        = DDS'CNT+1,                                <<DE>>   00984000
   DDS'CNT2        = DDS'CNT1+2,                               <<DE>>   00986000
   DDS'CNT3        = DDS'CNT2+2,                               <<DE>>   00988000
   DDS'CNT4        = DDS'CNT3+2,                               <<DE>>   00990000
   DDS'CNT5        = DDS'CNT4+2;                               <<DE>>   00992000
REAL                                                           <<DE>>   00994000
   GOODPERCENT     = DDS'CNT5+2;                               <<DE>>   00996000
LOGICAL POINTER                                                <<DE>>   00998000
   BASE            = GOODPERCENT+2;                            <<DE>>   01000000
INTEGER POINTER                                                <<DE>>   01002000
   IBASE           = BASE;                                     <<DE>>   01004000
DOUBLE POINTER                                                 <<DE>>   01006000
   DBASE           = BASE;                                     <<DE>>   01008000
DEFINE                                                         <<DE>>   01010000
   WHICHDIRTY = BASE(DIRTY) #;                                 <<DE>>   01012000
                                                               <<DE>>   01014000
             << DIRECTORY BLOCK SIZES >>                       <<DE>>   01016000
                                                               <<DE>>   01018000
EQUATE  SYSSAIBSIZE  =  3,    <<    Account Index Block Size>> <<DE>>   01020000
        SYSAUIBSIZE  =  1,    <<  Acct/User Index Block Size>> <<DE>>   01022000
        SYSAGIBSIZE  =  1,    << Acct/Group Index Block Size>> <<DE>>   01024000
        SYSGFIBSIZE  =  2,    << Group/File Index Block Size>> <<DE>>   01026000
        SYSGVSIBSIZE =  1,    <<  Group/VSD Index Block Size>> <<DE>>   01028000
        SYSAEBSIZE   =  3,    <<    Account Entry Block Size>> <<DE>>   01030000
        SYSUEBSIZE   =  2,    <<       User Entry Block Size>> <<DE>>   01032000
        SYSGEBSIZE   =  2,    <<      Group Entry Block Size>> <<DE>>   01034000
        SYSFEBSIZE   =  2,    <<       File Entry Block Size>> <<DE>>   01036000
        SYSVSEBSIZE  =  1,    <<        VSD Entry Block Size>> <<DE>>   01038000
        DDSBSIZE     =  3,    << Maximum Block Size (3 sect)>> <<DE>>   01040000
        DDSBWSIZE    =  %600; << Maximum Block Size (#words)>> <<DE>>   01042000
                                                               <<DE>>   01044000
             << DIRECTORY SPACE DATA SEGMENT >>                <<DE>>   01046000
                                                               <<DE>>   01048000
EQUATE                                                         <<DE>>   01050000
   DIRSPHDR        = 10,   << 10 word Data Seg. header info >> <<DE>>   01052000
   DIRSPSIZE       = 384,  << Data Seg Buffer Size (+ hdr)  >> <<DE>>   01054000
   DSVMBASE        = 2,    << Start bitmap [after 2 wd hdr] >> <<DE>>   01056000
   DIRSPACEDST     = 21,             << Directory Space DST >> <<DE>>   01058000
   DSBUFF1         = 1,           << First sector in buffer >> <<DE>>   01060000
   DSBUFF2         = 2;            << 2 sectors in 2nd part >> <<DE>>   01062000
   << BITMAP:  1=Available,  0=Allocated >>                    <<DE>>   01064000
                                                               <<DE>>   01066000
DOUBLE                                                         <<DE>>   01068000
   DSBASE          = DB+0;                                     <<DE>>   01070000
INTEGER                                                        <<DE>>   01072000
   DSBASE1         = DSBASE,                                   <<DE>>   01074000
   DSBASE2         = DSBASE1+1;                                <<DE>>   01076000
DEFINE                                                         <<DE>>   01078000
   DSLDEV          = DSBASE1.(0:8) #,                          <<DE>>   01080000
   DSBASEA1        = DSBASE1.(8:8) #;                          <<DE>>   01082000
LOGICAL                                                        <<DE>>   01084000
   DSFLAGS         = DSBASE2+1;           <<bitmap dst flags>> <<DE>>   01086000
   DEFINE     << Bits used in DSFLAGS >>                       <<DE>>   01088000
      DIRSP'DIRTY  = DSFLAGS.(0:1) #,   << DSDS was modified>> <<DE>>   01090000
      DIRSP'CYCLE  = DSFLAGS.(1:1) #,   << Search for holes >> <<DE>>   01092000
      DIRSP'NEXT2  = DSFLAGS.(2:1) #,   << Read next 2 sect >> <<DE>>   01094000
      DIRSP'LASTIN = DSFLAGS.(3:1) #,   << Last sectors in  >> <<DE>>   01096000
      DIRSP'PREV2  = DSFLAGS.(4:1) #,   << Read prev 2 sect >> <<DE>>   01098000
      DIRSP'FIRSTIN= DSFLAGS.(5:1) #,   << First sectors in >> <<DE>>   01100000
      DIRSP'UNUSED = DSFLAGS.(6:10)#;   << NOT USED >>         <<DE>>   01102000
                                                               <<DE>>   01104000
LOGICAL                                                        <<DE>>   01106000
   DSUNUSED        = DSFLAGS+1,                                <<DE>>   01108000
   DSADDR1         = DSUNUSED+1,  << Disc address of sector >> <<DE>>   01110000
   DSADDR2         = DSADDR1+1,   << in bitmap buffer no. 2 >> <<DE>>   01112000
   DSBUFFLEN       = DSADDR2+1;   << Length of buff 2nd part>> <<DE>>   01114000
DOUBLE                                                         <<DE>>   01116000
   DSADDR          = DSFLAGS+1;   << Redefines DSADDR1 and 2>> <<DE>>   01118000
INTEGER                                                        <<DE>>   01120000
   CUR'SEGMENT     = DSBUFFLEN+1;  << Sector # of bitmap seg>> <<DE>>   01122000
LOGICAL                                                        <<DE>>   01124000
   BUF'LASTWORD    = CUR'SEGMENT+1;   << Ptr to last in buff>> <<DE>>   01126000
POINTER                                                        <<DE>>   01128000
   BUF'FIRSTAVAIL  = BUF'LASTWORD+1;  << Ptr to 1st in buff >> <<DE>>   01130000
                                                               <<DE>>   01132000
ARRAY                                                          <<DE>>   01134000
   DIRSPIOBASE (*) = DB+DIRSPHDR,                              <<DE>>   01136000
   DIRSPIOBASE2(*) = DIRSPIOBASE+128;                          <<DE>>   01138000
                                                               <<DE>>   01140000
LOGICAL                                                        <<DE>>   01142000
   DIR'LASTWORD    = DIRSPIOBASE;    << Last word of BITMAP >> <<DE>>   01144000
POINTER                                                        <<DE>>   01146000
   DIR'FIRSTAVAIL  = DIR'LASTWORD+1;  << 1st word of BITMAP >> <<DE>>   01148000
                                                               <<DE>>   01150000
LOGICAL                                                        <<DE>>   01152000
   START'BITMAP    = DIR'FIRSTAVAIL+1;                         <<DE>>   01154000
                                                               <<DE>>   01156000
ARRAY                                                          <<DE>>   01158000
   BITMAP (*)      = START'BITMAP;                             <<DE>>   01160000
                                                               <<DE>>   01162000
INTEGER ARRAY TYPEMASK (0:2) :=                                <<DE>>   01164000
                     %002720,      << Account-User >>          <<DE>>   01166000
                     %002120,      << Account-Group-File >>    <<DE>>   01168000
                     %003120;      << Account-Group-VSD >>     <<DE>>   01170000
$PAGE "VARIABLE DECLARATIONS"                                  <<DE>>   01172000
  BYTE POINTER BPINBUF,              <<INPUT BUFFER POINTER>>           01174000
               SAMEPROG,             <<SAME PROGRAM CHANGE>>            01176000
               BPNOTDUMP,            <<FILES NOT DUMPED>>               01178000
               BPSPC;                                                   01180000
  INTEGER ARRAY TABLEPTRS(0:EXPTABLES)=DB;<<PTRS TO EXPANDING TABLES>>  01182000
  INTEGER POINTER CSTAB  =TABLEPTRS+1,<<CS TABLE>>             <<00778>>01184000
                  DVRTAB =TABLEPTRS+2,<<DRIVER TABLE>>         <<00778>>01186000
                  LPDT   =TABLEPTRS+3,<<LOG-PHY DEVICE TABLE>> <<00778>>01188000
                  LDT    =TABLEPTRS+4,<<LOGICAL DEVICE TABLE>> <<00778>>01190000
                  LDTX   =TABLEPTRS+6,<<LDT EXTENSION>>        <<00778>>01192000
                  VTAB   =TABLEPTRS+7,<<VOLUME TABLE>>         <<00778>>01194000
                  OLDVTAB=TABLEPTRS+8;<<OLD COPY OF VTAB>>     <<00778>>01196000
  BYTE POINTER    BDVRTAB;                                     <<04253>>01198000
  BYTE POINTER    DVCLTAB=TABLEPTRS+5,<<DEVICE CLASS TABLE>>   <<00778>>01200000
                  BLINBUF=TABLEPTRS+0;<<FILENAME INPUT BUFFER>><<00778>>01202000
  INTEGER ARRAY TABLEINCRS(0:EXPTABLES-1)=DB:=EXPTABLES(0);             01204000
                                     <<INCREMENTS FOR EXPANDING TABLES>>01206000
  INTEGER BLINBUFINCR=TABLEINCRS+0,<<BLINBUF INCREMENT>>       <<00778>>01208000
          CSTABINCR  =TABLEINCRS+1,<<CS TABLE INCREMENT>>      <<00778>>01210000
          DVRTABINCR =TABLEINCRS+2,<<DRIVER TABLE INCREMENT>>  <<00778>>01212000
          LPDTINCR   =TABLEINCRS+3,<<LOG-PHYS DEV TABLE INC>>  <<00778>>01214000
          LDTINCR    =TABLEINCRS+4,<<LOGICAL DEV TABLE INC>>   <<00778>>01216000
          DVCLTABINCR=TABLEINCRS+5,<<DEVICE CLASS TAB INC>>    <<00778>>01218000
          LDTXINCR   =TABLEINCRS+6,<<LDT-EXT INCREMENT>>       <<00778>>01220000
          VTABINCR   =TABLEINCRS+7;<<VOLUME TAB INCREMENT>>    <<00778>>01222000
  INTEGER POINTER RIN,               <<RIN TABLE>>                      01224000
                  CTAB,              <<CORESIZE-RELATED CONFIGURATION>> 01226000
                  CTAB0,             <<CONFIGURATION INFO TABLE>>       01228000
                  LOCRIN,            <<LOCAL AND GLOBAL RIN AREA>>      01230000
                  GLORIN,            <<GLOBAL RIN AREA>>                01232000
                  NGLORIN,           <<NEW GLOBAL RIN AREA>>            01234000
                  DVRENT,            <<DRIVER TABLE ENTRY>>             01236000
                  LDTENT,            <<LOGICAL DEVICE TABLE ENTRY>>     01238000
                  LDTXENT,            <<LDT EXTENT ENTRY>>     <<00.06>>01240000
                  CSLDTX,   <<CURREN ENTRY IN CSTAB>>                   01242000
        LPDTENT,                                               <<00506>>01244000
        LIDTABTEMP,                                            <<00506>>01246000
        LIDTAB;                                                <<00506>>01248000
                                                               <<01762>>01250000
integer EVENT'WORD;             <<LOG event mask word #>>      <<01762>>01252000
  EQUATE SPCLENGTH = (NSYSPROG'ALL+7)*17;                      <<04253>>01254000
  EQUATE SYSPROG'CHG'TABLE'LIMIT = SPCLENGTH*2;                <<04253>>01256000
                      <<CALC MAXLENGTH OF SYSTEM PROG TABLE>>  <<04253>>01258000
        DOUBLE DTEMP;                                          <<01073>>01260000
        INTEGER DT0=DTEMP,DT1=DTEMP+1;                         <<01073>>01262000
        LOGICAL LISTFILES := FALSE;                            <<01073>>01264000
  INTEGER ARRAY LBUF(0:4512),        <<UTILITY BUFFER>>        <<02509>>01266000
                TCST(0:TCSTSIZE-1),  <<TEMPORARY CST>>                  01268000
                CSDVR(0:CSDVRTSIZE-1),                                  01270000
                CSDEF(0:CSDEFSIZE-1),<<CSLDTX ENTRY# CROSS>>   <<+0.06>>01272000
                <<REFERENCE TABLE INDEXED BY LDEV>>            <<+0.06>>01274000
                FLAB(0:127),         <<FILE LABEL>>                     01276000
                IVNAME(0:3),         <<VOLUME NAME>>                    01278000
                DNAME(*)=IVNAME,      <<DRIVER NAME>>                   01280000
                DBARRAY(*)=DB+0,                                        01282000
                SEGSIZE(0:31),       <<INIT SEGMENT SIZES>>             01286000
                SEGADR(0:31),        <<INIT SEGMENT RECORD #'S>>        01288000
                REC0(0:127),         <<INIT RECORD 0>>                  01290000
                STT(0:383),          <<INIT SEGMENT'S STT>>             01292000
                INBUF(0:INBUFLEN-1), <<INPUT BUFFER>>          <<DL.01>>01294000
                SPC(0:SPCLENGTH);    <<SYSTEM PROGRAM CHANGES>><<HC.01>>01296000
  DOUBLE POINTER DCSLDTX=CSLDTX;                                        01298000
  BYTE ARRAY FILENAME(*)=LBUF,       <<LIST FILE DESIGNATOR>>           01300000
             B(*)=LBUF(128),         <<:FILE COMMAND FOR SEGLIST>>      01302000
             NOTDUMP(*)=STT,         <<FILES NOT DUMPED>>               01304000
             BLBUF(*)=LBUF,                                             01306000
             BSPC(*)=SPC,                                               01308000
             BINBUF(*)=INBUF,                                           01310000
             VNAME(*)=IVNAME,                                           01312000
          BTYP(*)=VNAME,                                                01314000
             BCSDVR(*)=CSDVR,                                           01316000
             BDNAME(*)=VNAME,                                           01318000
             BREC0(*)=REC0;                                             01320000
  DOUBLE ARRAY FLABDBL(*)=FLAB,                                         01322000
               DLBUF(*)=LBUF,                                           01324000
               DTCST(*)=TCST,                                  <<03604>>01326000
          DCTAB0(*)=CTAB0,                                              01328000
                  DBDBL(*)=DB+0;                                        01330000
 DEFINE  << FILE LABEL DEFINITION >>                                    01332000
 FLLOCNAME   =FLAB( 0)#,       << LOCAL FILE NAME >>                    01334000
 FLGRPNAME   =FLAB( 4)#,       <<  GROUP NAME >>                        01336000
 FLACCTNAME  =FLAB( 8)#,       << ACCOUNT NAME >>                       01338000
 FLUSERID    =FLAB(12)#,       << CREATING USERID >>                    01340000
 FLLOCKWORD  =FLAB(16)#,       << LOCKWORD >>                           01342000
 FLSECMX     =FLAB(20)#,       << SECURITY MATRIX >>                    01344000
 FLCREATE    =FLAB(23)#,       << CREATE DATE >>                        01346000
   FLLASTACC   =FLAB(24)#,       << LAST ACCESS DATE >>                 01348000
 FLLASTMOD   =FLAB(25)#,       << LAST MODIFICATION DATE >>             01350000
 FLFILECODE  =FLAB(26)#,       << FILE CODE >>                          01352000
   FLFCBVECT   =FLAB(27)#,       << FCB VECTOR >>                       01354000
 FLFLIM      =FLABDBL(15)#,    << FILE LIMIT >>                         01356000
 FLPVINF     =FLAB(33)#, <<PRIVATE VOL INFO WORD>>             <<00185>>01358000
 FLMVTABX    =FLAB(33).(4:4)#,                                 <<00185>>01360000
 FLCLID      =FLAB(35)#,       << COLD LOAD ID >>                       01362000
 FLFOPTIONS  =FLAB(36)#,       << FOPTIONS >>                           01364000
 FLRECSIZE   =FLAB(37)#,       << RECORD SIZE >>                        01366000
 FLBLKSIZE   =FLAB(38)#,       << BLOCK SIZE >>                         01368000
 FLSECTOFF   =FLAB(39).(0:8)#, << SECTOR OFFSET TO DATA >>              01370000
 FLDFLAGS    =FLAB(39).(8:4)#, << DISC FLAGS >>                         01372000
FLNUMEXTS   =FLAB(39).(11:5)#,<<NUMBER OF EXTENTS>>                     01374000
 FLNEXTWORD  =FLAB(39)#,                                                01376000
 FLEOFDISP   =FLAB(40)#,       << LOGICAL S9ZE OF LAST BLOCK >>         01378000
 FLEXTSIZE   =FLAB(41)#,       << EXTENT SIZE >>                        01380000
 FLLASTEXTSIZE=FLAB(40)#,      <<SIZE OF LAST EXTENT>>         <<00.CR>>01382000
 FLEOF       =FLABDBL(21)#,    << END-OF-DATA POINTER >>                01384000
 FLEXT0      =22#,             <<1ST EXTENT>>                           01386000
 FLEXTMAP    =FLAB(44)#;       << ORIGIN OF EXTENT MAP >>               01388000
EQUATE                                                         <<03604>>01390000
   FLMISCX      = 28,  <<LOAD, READ, ETC INDEX>>               <<03604>>01392000
   FLCHECKSUMX  = 34,  <<CHECKSUM INDEX>>                      <<03604>>01394000
   FLCLIDX      = 35;  <<COLD LOAD ID INDEX>>                  <<03604>>01396000
  BYTE ARRAY CTABFILE(0:18):="CONFDATA.PUB.SYS  ";                      01398000
    <<------------------------------------------>>             <<DL.01>>01400000
    <<CATALOG FILE CHANGES USING MAKECAT.PUB.SYS>>             <<DL.01>>01402000
    <<------------------------------------------>>             <<DL.01>>01404000
                                                               <<DL.01>>01406000
  BYTE ARRAY MAKECATPROG(0:15):="MAKECAT.PUB.SYS ";            <<DL.01>>01408000
  INTEGER MAKECATPIN,                                          <<DL.01>>01410000
          MAKECATJCW;                                          <<DL.01>>01412000
  EQUATE  MAKECATFLAG=1,                                       <<DL.01>>01414000
          MAKECATSUSP=2;                                       <<DL.01>>01416000
                                                               <<04659>>01418000
<<-------------------->>                                       <<04659>>01420000
<<    STORE Stuff     >>                                       <<04659>>01422000
<<-------------------->>                                       <<04659>>01424000
                                                               <<04659>>01426000
EQUATE                                                         <<04659>>01428000
   DUMP'DATE'LEN         = 8, <<# of chars in: "mm/dd/yy">>    <<04659>>01430000
   S'ERR'SYNTAX          = 1, <<STORE found syntax error>>     <<04659>>01432000
   S'ERR'UNKNOWN'PROGRAM = 2, <<STORE.PUB.SYS not found>>      <<04659>>01434000
   S'ERR'CREATEPROCESS   = 3, <<CREATEPROCESS found error>>    <<04659>>01436000
   S'ERR'STORE'FAILED    = 4, <<STORE failed>>                 <<04659>>01438000
   S'ERR'ACTIVATE        = 5, <<ACTIVATE failed>>              <<04659>>01440000
   S'ERR'MAIL            = 6, <<MAIL stuff failed>>            <<04659>>01442000
   STORE'FILES'LEN       = 240; <<length of STORE'FILES'>>     <<04659>>01444000
                                                               <<04659>>01446000
BYTE ARRAY                                                     <<04659>>01448000
   DUMP'DATE'     (0:DUMP'DATE'LEN-1),                         <<04659>>01450000
   STORE'FILES'   (0:STORE'FILES'LEN-1),                       <<04659>>01452000
   STOREJCW'      (0:8):="STOREJCW ";                          <<04659>>01454000
                                                               <<04659>>01456000
                                                               <<04659>>01458000
<<--------------------------------------->>                    <<00150>>01460000
<<SOFTDUMP CHANGES USING SDFCHECK.PUB.SYS>>                    <<00150>>01462000
<<--------------------------------------->>                    <<00150>>01464000
                                                               <<00150>>01466000
BYTE ARRAY SDFPROG(0:16):="SDFCHECK.PUB.SYS ";                 <<00150>>01468000
INTEGER SDFPIN,                                                <<00150>>01470000
        SDFJCW;                                                <<00150>>01472000
EQUATE  SDFFLAG=1,                                             <<00150>>01474000
        SDFSUSP=2;                                             <<00150>>01476000
                                                               <<00150>>01478000
  BYTE ARRAY DIRFNAME(0:8):="SYSTDIRC ";  << Temp Directory >> <<DE>>   01480000
  BYTE ARRAY PSLFILE(0:8):="SL       "; <<PERMANENT SL FILE>>  <<04253>>01482000
  BYTE ARRAY TSLFILE (0:25):=                                  <<04253>>01484000
          "TEMPSL                    "; <<TEMPORARY SL FILE>>  <<04253>>01486000
  BYTE ARRAY LISTFILE(0:8):="SYSDLIST ";   <<LIST FILE>>                01488000
  BYTE ARRAY TAPEFILE(0:8):="DUMPTAPE ";   <<MAG TAPE FOR DUMP>>        01490000
  BYTE ARRAY GOODFILE(0:8):="SYSDGOOD ";                                01492000
  BYTE ARRAY ERRORFILE(0:7):="SYSDERR ";                                01494000
  BYTE ARRAY INITFILE(0:8):="INITIAL  ";   <<INITIALIZE PROGRAM>>       01496000
  BYTE ARRAY TAPEENTRYNAME(0:7):="TAPELOAD";                            01498000
  BYTE ARRAY DISCENTRYNAME(0:7) := "DISCBOOT";                          01500000
  BYTE ARRAY DIREC(0:9):="DIRECTORY ";                                  01502000
  BYTE ARRAY SEGERRMESS(0:17):="SEGMENTER ERROR # ";                    01504000
  BYTE ARRAY HEX(0:15) := "0123456789ABCDEF";                           01506000
  BYTE ARRAY CATALOGFILE(0:7):="CATALOG "; <<MUST MATCH>>      <<DL.01>>01508000
       <<SYSTEM PROGRAM FILE NAME FOR CATALOG FILE>>           <<DL.01>>01510000
  BYTE ARRAY CATALOGFILE'REP(0:25):=                           <<04253>>01512000
               "CATALOG                   ";                   <<04253>>01514000
  BYTE ARRAY SDFCOMFILE(0:7):="SDFCOM  "; <<MUST MATCH>>       <<00150>>01516000
  <<SYSTEM PROGRAM FILE NAME FOR THE SOFTDUMP FACILITY>>       <<00150>>01518000
  <<COMMAND FILE>>                                             <<00150>>01520000
  BYTE ARRAY SDFCOMFILE'REP(0:25):=                            <<04253>>01522000
               "SDFCOM                    ";                   <<04253>>01524000
                                                               <<00150>>01526000
BYTE ARRAY SYSPROG(0:NSYSPROG*8-1):=                           <<01300>>01528000
      "HIOTAPE0","HIOLPRT0","HIOLPRT1",                        <<01300>>01530000
      "HIOFLOP0","HIOMDSC1","IOINP0  ",                        <<01300>>01532000
      "LOG     ","ININ    ","DEVREC  ",                        <<01300>>01534000
      "PROGEN  ","UCOP    ","IOCDPN0 ",                        <<01300>>01536000
      "LOAD    ","SEGDVR  ","HIOMDSC2",                        <<03544>>01538000
      "SEGPROC ","SYSDUMP ","INITIAL ",                        <<01300>>01540000
      "CONFDATA","PFAIL   ","MAKECAT ",                        <<01300>>01542000
      "MEMLOGP ","CATALOG ","PVPROC  ",                        <<01300>>01544000
      "PVINIT  ","MPECHECK","IODS0   ",                        <<01300>>01546000
      "CSDUMMY ","HIOLPRT2","HIOPPRT0",                        <<02520>>01548000
      "HIOTAPE1","HIOCTAP0","HIOCIPR0",                        <<04536>>01550000
      "STORE   ";                                              <<04536>>01552000
BYTE ARRAY SYSPROG'2(0:NSYSPROG'2*8-1):=                       <<01300>>01554000
      "IOTAPE0 ","IOLPRT0 ","IOTERM0 ",                        <<01300>>01556000
      "IOMDISC0","IOFDISC0","IOCDRD0 ",                        <<01300>>01558000
      "CSHBSC0 ","IOREM0  ","IOPTRD0 ",                        <<01300>>01560000
      "IOPTPN0 ","IOPLOT0 ","IOPRPN0 ",                        <<01300>>01562000
      "IOMDISC1","CSSBSC0 ";                                   <<01300>>01564000
BYTE ARRAY SYSPROG'33(0:NSYSPROG'33*8-1):=                     <<01300>>01566000
      "SDFLOAD ","SDFCOM  ","SDFCHECK",                        <<01300>>01568000
      "SDFGEN  ","SYSWCS64","HIOTERM0",                        <<03061>>01570000
      "HIOTERM1","HIOASLP0","HIOCDRD0";                        <<03061>>01572000
  INTEGER ARRAY FIRSTDAY(0:11):=0,31,59,90,120,151,181,212,243,273,304, 01574000
                                334; <<FIRST DAY OF EACH MONTH>>        01576000
  INTEGER ARRAY DAYINMONTH(0:11):=31,28,31,30,31,30,31,31,30,31,30,31;  01578000
  INTEGER ARRAY RETVAL(0:1)=DB:=0,0; <<RETURN FROM ISTORE>>             01580000
  INTEGER ARRAY CORESIZES(0:NCORESIZES-1) :=                   <<01757>>01582000
    64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768, 1024,  <<01757>>01584000
    1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,            <<01757>>01586000
    2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,            <<01757>>01588000
    3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;            <<01757>>01590000
  BYTE ARRAY USLFILE(0:26),          <<USL FILE NAME>>                  01592000
             FULLNAME(0:27),         <<FULL FILE NAME>>                 01594000
             SEGMENT(0:15),          <<SEGMENT NAME>>                   01596000
          DEVCLASS(*)=SEGMENT;       <<DEVICE CLASS NAME>>              01598000
  ARRAY VERSID(0:2);                                           <<12.KM>>01600000
  BYTE ARRAY BVERSID(*)= VERSID;                               <<12.KM>>01602000
  DEFINE VERSION=     VERSID #,                                <<12.KM>>01604000
         UPDATEL=     VERSID(1) #,                             <<12.KM>>01606000
         FIXLEVEL=    VERSID(2) #;                             <<12.KM>>01608000
  DEFINE BVERSION=    BVERSID(1) #,                            <<12.KM>>01610000
         BUPDATEL=    BVERSID(2) #,                            <<12.KM>>01612000
         BFIXLEVEL=   BVERSID(4) #,                            <<12.KM>>01614000
         BVERSID'END= BVERSID(5) #;                            <<12.KM>>01616000
                                                                        01618000
  DOUBLE FLIMIT,                                                        01620000
         EOF,                        <<END OF FILE>>                    01622000
         CAPABILITY,                 <<USER CAPABILITY FROM WHO>>       01624000
         DIRDISCADR,                 <<DIRECTORY DISC ADDRESS>>         01626000
         SYSTEMFILESPACE := 0D,     <<TOTAL SYSTEM FILE SPACE>><<00928>>01628000
          DS0 = S-1;    <<TOP OF STACK DOUBLE>>                         01630000
  INTEGER CTABFNUM,                  <<CONFIGURATION FILE NUMBER>>      01632000
          PSLFNUM,                   <<PERMANENT SL FILE NUMBER>>       01634000
          TSLFNUM,                   <<TEMPORARY SL FILE NUMBER>>       01636000
          LISTFNUM,                  <<LIST FILE NUMBER>>               01638000
          INITFNUM,                  <<CONFIGURATOR FILE NUMBER>>       01640000
          TAPEFNUM,                  <<TAPE FILE NUMBER>>               01642000
          GOODFNUM,                  <<GOOD FILE NUMBER>>               01644000
          ERRFNUM,                   <<ERROR FILE NUMBER>>              01646000
          RINS,                      <<# OF RINS>>                      01648000
          GRINS,                     <<# OF GLOBAL RINS>>               01650000
          MINGRIN,                   <<MINIMUM NUMBER OF GLOBAL RINS>>  01652000
          MINDRT, <<SMALLEST ALLOWABLE DRT FOT THIS CPUTYPE>>  <<00072>>01654000
          MINRIN,                    <<MINIMUM NUMBER OF RINS>>         01656000
          DLLEN,                     <<SIZE OF DL AREA>>                01658000
          RINLEN,                    <<LENGTH OF RIN TABLE>>            01660000
          NRINLEN,                   <<NEW LENGTH OF RIN TABLE>>        01662000
      LIDTABLEN,                                               <<00506>>01664000
      NEWLIDTABLEN,                                            <<00506>>01666000
          RSIR,                      <<RIN SIR RETURN>>                 01668000
          MODE,                      <<MODE (FROM WHO)>>                01670000
          COREX,                     <<CORE SIZE INDEX>>                01672000
          USLLEN,                    <<# OF CHARS IN USL NAME>>         01674000
          DRTN,                      <<DRT #>>                          01676000
          LDEV,                      <<LOGICAL DEVICE #>>               01678000
          OLDDRT,                    <<OLD DRT #>>                      01680000
          HLDEV,                     <<HIGHEST LOGICAL DEVICE NUMBER>>  01682000
          NVOL,                      <<VOLUME TABLE COUNTS>>   <<RH.PV>>01684000
          DVCLSIZE,                  <<DEVICE CLASS TABLE SIZE>>        01686000
          INDEX,                     <<TABLE INDEX>>                    01688000
          MAXINITSEG,                <<MAX INITIAL SEGMENT SIZE>>       01690000
          TABLESIZE,                 <<SIZE OF INITIAL'S TABLE AREA>>   01692000
          INITPB,                    <<CONFIGURATOR PB>>                01696000
          INITDB,                    <<CONFIGURATOR DB>>                01698000
          NSEG,                      <<# OF SEGMENTS FOR INIT>>         01702000
          STTINDEX,                  <<INDEX IN STT TO PL>>             01704000
          STTREC,                    <<STT RECORD #>>                   01706000
          OLDCST,                    <<CST FROM STT ENTRY>>             01708000
          FIRSTCST,                  <<FIRST CST USED BY INIT>>         01710000
          TAPERECSIZE,               <<SIZE OF TAPE REC'S>>    <<03604>>01714000
          COLDLOADID,                <<COLD LOAD COUNT>>                01716000
          DISCENTRY,                 <<DISC COLD LOAD ENTRY POINT>>     01718000
          TAPEENTRY,                 <<TAPE COLD LOAD ENTRY POINT>>     01720000
          DUMPDATE,                  <<DATE OLDEST FILE WAS CHANGED>>   01722000
          DSIR,                      <<DIRECTORY SIR RETURN>>           01726000
          FMSIR,                     <<FMAVTSIR RETURN>>       <<00197>>01728000
          FSIR,                      <<FILE SIR RETURN>>                01730000
          EFRCOUNT=RETVAL,           <<# OF RECORDS IN ERROR FILE>>     01732000
          GFRCOUNT=RETVAL+1,         <<# OF RECORDS ON GOOD FILE>>      01734000
          DENSITY  := 0,             <<DENSITY of tape>>       <<04659>>01736000
          RECSIZE,                   <<FILE RECORD SIZE>>               01738000
          BLKSIZE,                   <<FILE BLOCK SIZE>>                01740000
          DEVTYPE,                   <<DEVICE TYPE>>                    01742000
          FOPTIONS,                                                     01744000
          AOPTIONS,                                                     01746000
          CPUTYPE,                   <<TYPE OF HP3000 CPU>>    <<TP.00>>01748000
          FILECODE,                                                     01750000
          INITALLOC,                                                    01752000
          EXTSIZE,                                                      01754000
          NUMEXTENTS,                                                   01756000
          SEGERROR,                  <<SEGMENTER ERROR #>>              01758000
          TINDEX,      <<TEMPORARY CLASS INDEX>>                        01760000
          PIN;                       <<SEGMENTER PROCESS NUMBER>>       01762000
  INTEGER I,J,K,L,M,N,TEMP;          <<TEMPORARIES>>                    01764000
  LOGICAL MORE,                                                         01766000
          LDUMPDATE=DUMPDATE,                                  <<00072>>01768000
          DIRSECT,                        << Directory size >> <<DE>>   01770000
          ATTRIB=CAPABILITY,         <<USER ATTRIBUTES>>                01772000
          RINCHANGE := FALSE,        <<RIN TABLE CHANGED>>              01774000
          SIRS := FALSE,             <<DIRECTORY AND FILE SIRS HELD>>   01776000
          LOCKED := FALSE,           <<FILES LOCKED BY ISTORE>>         01778000
          TEMPSLOPEN := FALSE,                                          01780000
          ERROR := FALSE,                                               01782000
          LAST = ERROR,                                                 01784000
          MAGTAPE,       << DUMPING TO A MAGTAPE? >>           <<02509>>01786000
          TEMPSLSAVED := FALSE;                                         01788000
  INTEGER X=X;                       <<X REGISTER>>                     01790000
  BYTE BS0=S-0,BS1=S-1;              <<TOP OF STACK BYTE VALUES>>       01792000
  INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S5=S-5,S6=S-6,S7=S-7;      01794000
  LOGICAL LS0=S-0;                                             <<RH.PV>>01796000
  INTEGER POINTER PS0=S-0,PS1=S-1;  <<<TOP OF STACK POINTERS>>          01798000
  BYTE POINTER BPS0=S-0,BPS1=S-1;    <<TOP OF STACK BYTE POINTERS>>     01800000
  LOGICAL STAT=Q-1;                  <<STATUS WORD IN MARKER>>          01802000
  LOGICAL RETURNP=Q-2;               <<RETURN ADDRESS IN MARKER>>       01804000
  INTEGER ARRAY DB2(*)=DB+2;                                            01806000
   ARRAY ERRMESS(0:7) _ "*ERROR, PARM#  *";                             01808000
  INTEGER ARRAY TCLASS(*)=OLDVTAB;  <<TEMPORARY CLASS TABLE>>           01810000
  BYTE POINTER TEMPCLASS; <<TEMPORARY CLASS TABLE>>            <<00887>>01812000
  INTEGER ARRAY IAS0(*)=S-0;                                            01814000
                                                               <<RH.PV>>01816000
  DEFINE                                                       <<RH.PV>>01818000
          MVOL = NVOL.(0:8)#,        <<MAX VOLS IN VTAB>>      <<RH.PV>>01820000
          HVOL = NVOL.(8:8)#;        <<SYS VOLS IN VTAB>>      <<RH.PV>>01822000
                                                               <<DL.01>>01824000
          EQUATE SEMICOLONBLANK=%35440,                        <<DL.01>>01826000
                 SEMICOLONCOMMA=%35454,                        <<DL.01>>01828000
                 RESET=0;                                      <<00777>>01830000
  ARRAY FILEMASK(4:12):=%7502,%7501,%7503,%7503,%7503,%7503,   <<00072>>01834000
  %7502,%7501,%7503;                                           <<00072>>01836000
  INTEGER ARRAY SEC'CYL (4:12):= 96, 48, 144, 144, 240, 576,   <<02509>>01838000
  96,96,192;                                                   <<00072>>01840000
  ARRAY HEADBASE (4:12):= 0, %1000, 0, 0, 0, 0,                <<00072>>01842000
  0,%1000,0;                                                   <<00072>>01844000
  ARRAY HDBASE (0:12):= 0, 2, 0, 0, 0, 2, 0, 0, 0, 0,          <<00072>>01846000
  0,2,0;                                                       <<00072>>01848000
  ARRAY SECTHD (0:12):= 24, 24, 24, 23, 48, 48, 48, 48, 48, 64,<<00072>>01850000
  48,48,48;                                                    <<00072>>01852000
EQUATE                                                         <<00185>>01858000
          MAGTAPETYPE=24;                                      <<02509>>01860000
   EQUATE REQSTAT = 7; <<STATUS REQUEST FUNCTION CODE>>        <<00072>>01864000
   DEFINE DOUBLESIDED=LBUF(1).(4:1)=1#;<<STATUS RETURN FOR FLOPPY>>     01866000
   DOUBLE DISCADDRESS;                                                  01870000
   INTEGER D1=DISCADDRESS,                                              01872000
           D2=DISCADDRESS+1,                                            01874000
           OUTDEVTYPE, <<REAL DEVTYPE FOR OUTPUT DEV>>         <<00072>>01876000
           FLOP'SEC'CYL,<<SINGLE OR DOUBLE SIDED FLOP>>        <<00072>>01878000
           BLOCKN,                                             <<00072>>01882000
           SDISCLDEV;                                                   01886000
   DEFINE FLOPPY=(OUTDEVTYPE=DISC2)#;                          <<03604>>01890000
   DEFINE STYPE=DEVTYPE.(0:8)#;                                         01892000
                                                               <<00072>>01894000
<<-------------------------------------->>                     <<00072>>01896000
<<HEADER/TRAILER LABELS FOR FLOPPY DISCS>>                     <<00072>>01898000
<<-------------------------------------->>                     <<00072>>01900000
DOUBLE TIME;                                                   <<00072>>01902000
INTEGER TIME1=TIME,                                            <<00072>>01904000
        TIME2=TIME1+1;                                         <<00072>>01906000
INTEGER REELNUM:=1;                                            <<00072>>01908000
LOGICAL DATE;                                                  <<00072>>01910000
                                                               <<00072>>01912000
DEFINE NULL'DATE= DUMPDATE=-1#,                                <<00072>>01914000
       FUTURE'DATE= DATE<LDUMPDATE AND DUMPDATE<>-1#;          <<00150>>01916000
   EQUATE NOERR=1; <<LOW WORD VALUE MEANING ATTACHIO>>                  01918000
                   <<EXECUTED PROPERLY>>                                01920000
INTEGER ERRORCODE; <<FCHECK RETURN VALUE>>                     <<00072>>01922000
EQUATE EOTCODE=23; <<END OF TAPE RETURN FROM FCHECK>>          <<00072>>01924000
ARRAY TPFILEMASK(4:12):=%7406,%7405,%7407,%7407,%7407,%7407,   <<00072>>01928000
                        %7406,%7505,%7407;                     <<00072>>01930000
EQUATE SEED=%123456;<<STARTING VALUE FOR THE CHECKSUM>>        <<00150>>01934000
                    <<FOR COLDLOAD ON THE SERIES'25>>          <<00150>>01936000
$PAGE "INTRINSICS"                                             <<04659>>01938000
INTRINSIC          <<in alphabetic order, one per line!!!!!>>  <<04659>>01940000
   ACTIVATE,                                                   <<04659>>01942000
   CREATEPROCESS,                                              <<04659>>01944000
   FFILEINFO,                                                  <<04659>>01946000
   RECEIVEMAIL;                                                <<04659>>01948000
  DOUBLE PROCEDURE LOGICALCST(CSTN);                                    01950000
    VALUE CSTN;                                                         01952000
    INTEGER CSTN;                                                       01954000
    OPTION EXTERNAL;                                                    01956000
$PAGE "EXTERNAL PROCEDURE DECLARATIONS"                                 01958000
                                                                        01960000
  PROCEDURE DEBUG;                                                      01962000
    OPTION EXTERNAL;                                                    01964000
                                                                        01966000
  PROCEDURE SYSTEMDEBUG;                                                01968000
    OPTION EXTERNAL;                                                    01970000
                                                                        01972000
  LOGICAL PROCEDURE BINARY(STRING,LENGTH);                              01974000
    VALUE LENGTH;                                                       01976000
    BYTE ARRAY STRING;                                                  01978000
    INTEGER LENGTH;                                                     01980000
    OPTION EXTERNAL;                                                    01982000
                                                                        01984000
   DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                             01986000
         VALUE LENGTH;                                                  01988000
         BYTE ARRAY STRING;                                             01990000
         INTEGER LENGTH;                                                01992000
         OPTION EXTERNAL;                                               01994000
                                                                        01996000
  INTEGER PROCEDURE ASCII(WORD,BASE,STRING);                            01998000
    VALUE WORD,BASE;                                                    02000000
    LOGICAL WORD;                                                       02002000
    INTEGER BASE;                                                       02004000
    BYTE ARRAY STRING;                                                  02006000
    OPTION EXTERNAL;                                                    02008000
                                                                        02010000
   INTEGER PROCEDURE DASCII(DWORD,BASE,STRING);                         02012000
         VALUE DWORD,BASE;                                              02014000
         DOUBLE DWORD;                                                  02016000
         INTEGER BASE;                                                  02018000
         BYTE ARRAY STRING;                                             02020000
         OPTION EXTERNAL;                                               02022000
                                                                        02024000
  DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,BUF,FUNC,COUNT,P1,P2,FLAGS);02026000
    VALUE LDEV,QMISC,DSTX,BUF,FUNC,COUNT,P1,P2,FLAGS;                   02028000
    INTEGER LDEV,QMISC,DSTX,BUF,FUNC,COUNT,P1,P2,FLAGS;                 02030000
    OPTION EXTERNAL;                                                    02032000
                                                                        02034000
  INTEGER PROCEDURE READ(MESSAGE,LENGTH);                               02036000
    VALUE LENGTH;                                                       02038000
    ARRAY MESSAGE;                                                      02040000
    INTEGER LENGTH;                                                     02042000
    OPTION EXTERNAL;                                                    02044000
                                                                        02046000
  PROCEDURE PRINT(MESSAGE,LENGTH,CONTROL);                              02048000
    VALUE LENGTH,CONTROL;                                               02050000
    ARRAY MESSAGE;                                                      02052000
    INTEGER LENGTH;                                                     02054000
    LOGICAL CONTROL;                                                    02056000
    OPTION EXTERNAL;                                                    02058000
                                                                        02060000
  INTEGER PROCEDURE FOPEN(FILEDESIGNATOR,FOPTIONS,AOPTIONS,RECSIZE,     02062000
          DEVICE,FORMMSG,USERLABELS,BLOCKFACTOR,NUMBUFFERS,FILESIZE,    02064000
          NUMEXTENTS,INITALLOC,FILECODE);                               02066000
    VALUE FOPTIONS,AOPTIONS,RECSIZE,USERLABELS,BLOCKFACTOR,NUMBUFFERS,  02068000
          FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                       02070000
    BYTE ARRAY FILEDESIGNATOR,DEVICE,FORMMSG;                           02072000
    LOGICAL FOPTIONS,AOPTIONS;                                          02074000
    INTEGER RECSIZE,USERLABELS,BLOCKFACTOR,NUMBUFFERS,INITALLOC,        02076000
          NUMEXTENTS,FILECODE;                                          02078000
    DOUBLE FILESIZE;                                                    02080000
    OPTION VARIABLE,EXTERNAL;                                           02082000
                                                                        02084000
  INTEGER PROCEDURE FREAD(FILENUM,TARGET,TCOUNT);                       02086000
    VALUE FILENUM,TCOUNT;                                               02088000
    INTEGER FILENUM,TCOUNT;                                             02090000
    ARRAY TARGET;                                                       02092000
    OPTION EXTERNAL;                                                    02094000
                                                                        02096000
  PROCEDURE FWRITE(FILENUM,TARGET,TCOUNT,CONTROL);                      02098000
    VALUE FILENUM,TCOUNT,CONTROL;                                       02100000
    INTEGER FILENUM,TCOUNT;                                             02102000
    ARRAY TARGET;                                                       02104000
    LOGICAL CONTROL;                                                    02106000
    OPTION EXTERNAL;                                                    02108000
                                                                        02110000
  PROCEDURE FPOINT(FILENUM,RECNUM);                                     02112000
    VALUE FILENUM,RECNUM;                                               02114000
    INTEGER FILENUM;                                                    02116000
    DOUBLE RECNUM;                                                      02118000
    OPTION EXTERNAL;                                                    02120000
                                                                        02122000
  PROCEDURE FREADDIR(FILENUM,TARGET,TCOUNT,RECNUM);                     02124000
    VALUE FILENUM,TCOUNT,RECNUM;                                        02126000
    INTEGER FILENUM,TCOUNT;                                             02128000
    ARRAY TARGET;                                                       02130000
    DOUBLE RECNUM;                                                      02132000
    OPTION EXTERNAL;                                                    02134000
                                                                        02136000
  PROCEDURE FWRITEDIR(FILENUM,TARGET,TCOUNT,RECNUM);                    02138000
    VALUE FILENUM,TCOUNT,RECNUM;                                        02140000
    INTEGER FILENUM,TCOUNT;                                             02142000
    ARRAY TARGET;                                                       02144000
    DOUBLE RECNUM;                                                      02146000
    OPTION EXTERNAL;                                                    02148000
                                                                        02150000
  PROCEDURE FCLOSE(FILENUM,DISPOSITION,SECCODE);                        02152000
    VALUE FILENUM,DISPOSITION,SECCODE;                                  02154000
    INTEGER FILENUM,DISPOSITION,SECCODE;                                02156000
    OPTION EXTERNAL;                                                    02158000
                                                                        02160000
  PROCEDURE FLOCK(FILENUM,T);                                           02162000
    VALUE FILENUM,T;                                                    02164000
    INTEGER FILENUM;                                                    02166000
    LOGICAL T;                                                          02168000
    OPTION EXTERNAL;                                                    02170000
                                                                        02172000
PROCEDURE FUNLOCK(FN);                                         <<00598>>02174000
  VALUE FN;                                                    <<00598>>02176000
  INTEGER FN;                                                  <<00598>>02178000
  OPTION EXTERNAL;                                             <<00598>>02180000
                                                               <<00598>>02182000
  PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);              02184000
    VALUE FILENUM;                                                      02186000
    INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                             02188000
    DOUBLE BLKNUM;                                                      02190000
    OPTION VARIABLE,EXTERNAL;                                           02192000
                                                                        02194000
    PROCEDURE FGETINFO(FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,      02196000
          DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,     02198000
          PHYSCOUNT,BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABELS,              02200000
          CREATORID,DISKADR);                                           02202000
    VALUE FILENUM;                                                      02204000
    INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,        02206000
          USERLABELS;                                                   02208000
    BYTE ARRAY FILENAME,CREATORID;                                      02210000
    LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                     02212000
    DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;                02214000
    OPTION VARIABLE,EXTERNAL;                                           02216000
                                                                        02218000
  PROCEDURE FCONTROL(FILENUM,CONTROLCODE,PARAM);                        02220000
    VALUE FILENUM,CONTROLCODE;                                          02222000
    INTEGER FILENUM,CONTROLCODE;                                        02224000
    LOGICAL PARAM;                                                      02226000
    OPTION EXTERNAL;                                                    02228000
                                                                        02230000
  INTRINSIC FERRMSG;                                           <<01109>>02232000
                                                               <<01109>>02234000
  PROCEDURE DISABLEBREAK(LDEV);                                         02236000
    VALUE LDEV;                                                         02238000
    INTEGER LDEV;                                                       02240000
    OPTION EXTERNAL;                                                    02242000
                                                                        02244000
  PROCEDURE ENABLEBREAK(LDEV);                                          02246000
    VALUE LDEV;                                                         02248000
    INTEGER LDEV;                                                       02250000
    OPTION EXTERNAL;                                                    02252000
                                                                        02254000
  PROCEDURE WHO(MODE,CAPABILITY,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMNUM);02256000
    LOGICAL MODE;                                                       02258000
    DOUBLE CAPABILITY,LATTR;                                            02260000
    BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                02262000
    LOGICAL TERMNUM;                                                    02264000
    OPTION VARIABLE,EXTERNAL;                                           02266000
                                                                        02268000
  PROCEDURE COMMAND(COMIMAGE,ERROR,PARM);                               02270000
    BYTE ARRAY COMIMAGE;                                                02272000
    INTEGER ERROR,PARM;                                                 02274000
    OPTION EXTERNAL;                                                    02276000
                                                                        02278000
  LOGICAL PROCEDURE EXCHANGEDB(DSTN);                                   02280000
    VALUE DSTN;                                                         02282000
    LOGICAL DSTN;                                                       02284000
    OPTION EXTERNAL;                                                    02286000
                                                                        02288000
  INTEGER PROCEDURE SETSYSDB;                                           02290000
    OPTION EXTERNAL;                                                    02292000
                                                                        02294000
  PROCEDURE RESETDB(OLDDB);                                             02296000
    VALUE OLDDB;                                                        02298000
    INTEGER OLDDB;                                                      02300000
    OPTION EXTERNAL;                                                    02302000
                                                                        02304000
  INTEGER PROCEDURE ZSIZE(SIZE);                                        02306000
    VALUE SIZE;                                                         02308000
    INTEGER SIZE;                                                       02310000
    OPTION EXTERNAL;                                                    02312000
                                                                        02314000
  INTEGER PROCEDURE DLSIZE(SIZE);                                       02316000
    VALUE SIZE;                                                         02318000
    INTEGER SIZE;                                                       02320000
    OPTION EXTERNAL;                                                    02322000
                                                                        02324000
  LOGICAL PROCEDURE DMOVE(DSTN,DISP,NUMBER,LOC,INTOSTACK,NUM);          02326000
    VALUE DSTN,DISP,NUMBER,LOC,INTOSTACK,NUM;                           02328000
    LOGICAL DSTN,INTOSTACK;                                             02330000
    INTEGER DISP,NUMBER,LOC,NUM;                                        02332000
    OPTION EXTERNAL;                                                    02334000
                                                                        02336000
  INTEGER PROCEDURE GETSIR(SIRNUM);                                     02338000
    VALUE SIRNUM;                                                       02340000
    INTEGER SIRNUM;                                                     02342000
    OPTION EXTERNAL;                                                    02344000
                                                                        02346000
  PROCEDURE RELSIR(SIRNUM,GETSIR);                                      02348000
    VALUE SIRNUM,GETSIR;                                                02350000
    INTEGER SIRNUM,GETSIR;                                              02352000
    OPTION EXTERNAL;                                                    02354000
                                                                        02356000
  PROCEDURE SEGMENTER(PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,       02358000
          NUM6,STRING1,STRING2,FNAME1,FNAME2);                 <<00629>>02360000
    VALUE COMMAND,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;               <<00629>>02362000
    INTEGER PIN,COMMAND,ERROR,NUM1,NUM2,NUM3,NUM4,NUM5,NUM6;   <<00629>>02364000
    BYTE ARRAY STRING1,STRING2,FNAME1,FNAME2;                           02366000
    OPTION VARIABLE,EXTERNAL;                                           02368000
                                                                        02370000
  PROCEDURE QUIT(NUM);                                                  02372000
    VALUE NUM;                                                          02374000
    INTEGER NUM;                                                        02376000
    OPTION EXTERNAL;                                                    02378000
                                                                        02380000
  DOUBLE PROCEDURE ISTORE(PTR,ENUM,GNUM,PDATE,RETVAL,FCLLIM,FCULIM,     02382000
          FLAG);                                                        02384000
    VALUE ENUM,GNUM,PDATE,FCLLIM,FCULIM,FLAG;                           02386000
    INTEGER ENUM,GNUM,FCLLIM,FCULIM;                                    02388000
    INTEGER ARRAY RETVAL;                                               02390000
    BYTE ARRAY PTR;                                                     02392000
    LOGICAL PDATE,FLAG;                                                 02394000
    OPTION EXTERNAL;                                                    02396000
                                                                        02398000
  DOUBLE PROCEDURE FSTORE(TNUM,GNUM);                                   02400000
    VALUE TNUM,GNUM;                                                    02402000
    INTEGER TNUM,GNUM;                                                  02404000
    OPTION EXTERNAL;                                                    02406000
                                                                        02408000
  PROCEDURE UNLOCKSTORE(GNUM,REW,PVINFO,PREVGBUF);             <<02612>>02410000
    VALUE GNUM,REW,PVINFO;                                     <<02612>>02412000
    INTEGER GNUM;                                              <<02612>>02414000
    LOGICAL REW,PVINFO;                                        <<02612>>02416000
    ARRAY PREVGBUF;                                            <<02612>>02418000
    OPTION EXTERNAL, VARIABLE;                                 <<02612>>02420000
                                                                        02422000
   LOGICAL PROCEDURE GET'TAPE'INFO(FILENUM,MAX'BLOCK,DENSITY); <<02567>>02424000
      VALUE FILENUM;                                           <<02567>>02426000
      INTEGER FILENUM,MAX'BLOCK,DENSITY;                       <<02567>>02428000
      OPTION EXTERNAL;                                         <<02567>>02430000
                                                               <<02567>>02432000
   PROCEDURE SETUP'FLAGS(FILENUM,DENSITY,DESIG,FLAGS,ERRNUM);  <<02567>>02434000
      VALUE FILENUM,DENSITY;                                   <<02567>>02436000
      INTEGER FILENUM,DENSITY,ERRNUM;                          <<02567>>02438000
      BYTE ARRAY DESIG;                                        <<02567>>02440000
      LOGICAL FLAGS;                                           <<02567>>02442000
      OPTION EXTERNAL;                                         <<02567>>02444000
                                                               <<02567>>02446000
PROCEDURE STORE'USER'FILES (SYSTAPE, SHOW, SYNTAX'ONLY,        <<04659>>02448000
                            ERROR'CODE, ERROR'SUBCLASS);       <<04659>>02450000
         VALUE   SHOW, SYSTAPE, SYNTAX'ONLY;                   <<04659>>02452000
         LOGICAL SHOW, SYNTAX'ONLY;                            <<04659>>02454000
         INTEGER ERROR'CODE, ERROR'SUBCLASS, SYSTAPE;          <<04659>>02456000
         OPTION FORWARD;                                       <<04659>>02458000
                                                               <<04659>>02460000
   LOGICAL PROCEDURE SETCRITICAL;                                       02462000
     OPTION EXTERNAL;                                                   02464000
                                                                        02466000
   PROCEDURE RESETCRITICAL(C);                                          02468000
     VALUE C;LOGICAL C;                                                 02470000
     OPTION EXTERNAL;                                                   02472000
                                                                        02474000
   PROCEDURE SETSERVICE(A);                                             02476000
     VALUE A;LOGICAL A;                                                 02478000
      OPTION EXTERNAL;                                                  02480000
                                                                        02482000
  DOUBLE PROCEDURE PRINTDFILE(PNUM,DNUM,COUNT,GORE,CHR,SHOW);           02484000
    VALUE PNUM,DNUM,COUNT,GORE,SHOW;                                    02486000
    INTEGER PNUM,DNUM,COUNT;                                            02488000
    LOGICAL GORE,SHOW;                                                  02490000
    BYTE ARRAY CHR;                                                     02492000
    OPTION EXTERNAL;                                                    02494000
                                                               <<00134>>02496000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,         <<00134>>02498000
PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,IOTYPE);               <<00134>>02500000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,          <<00134>>02502000
DEST,REPLY,OFFSET,DST,IOTYPE;                                  <<00134>>02504000
INTEGER SETNO,MSGNO,DEST,DST;                                  <<00134>>02506000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,       <<00134>>02508000
IOTYPE;                                                        <<00134>>02510000
OPTION VARIABLE EXTERNAL;                                      <<00134>>02512000
                                                                        02514000
  PROCEDURE MOVEDLTABLES;                                               02516000
    OPTION FORWARD;                                                     02518000
                                                               <<00072>>02520000
  DOUBLE PROCEDURE L'PADR(DISCADDRESS);                        <<00072>>02522000
  VALUE DISCADDRESS;                                           <<00072>>02524000
  DOUBLE DISCADDRESS;                                          <<00072>>02526000
  OPTION FORWARD;                                              <<00072>>02528000
                                                                        02530000
  PROCEDURE MYCOMMAND(COMMIMAGE,DELIMITERS,MAXPARMS,                    02532000
                 NUMPARMS,PARMS,DICT,DEFN);                             02534000
       VALUE MAXPARMS;                                                  02536000
       BYTE ARRAY COMMIMAGE,DELIMITERS,DICT;                            02538000
       INTEGER MAXPARMS,NUMPARMS;                                       02540000
       DOUBLE ARRAY PARMS;                                              02542000
       BYTE POINTER DEFN;                                               02544000
       OPTION VARIABLE,EXTERNAL;                                        02546000
                                                                        02548000
  PROCEDURE VTABTOLDEV (TARGET,SOURCE,COUNT,MVTABX);           <<RV.PV>>02550000
    VALUE COUNT,MVTABX;                                        <<RV.PV>>02552000
    DOUBLE ARRAY TARGET,SOURCE;                                         02554000
    INTEGER COUNT,MVTABX;                                      <<RV.PV>>02556000
    OPTION EXTERNAL;                                                    02558000
  INTRINSIC SETJCW,GETJCW,CREATE,ACTIVATE;                     <<DL.01>>02560000
  INTEGER PROCEDURE FINDSDISCGAP(LDEV,CONTROLCODE,S1,S2);               02562000
  VALUE LDEV,CONTROLCODE;                                               02564000
  INTEGER LDEV,CONTROLCODE;                                             02566000
  DOUBLE S1,S2;                                                         02568000
  OPTION VARIABLE,EXTERNAL;                                             02570000
                                                                        02572000
  INTEGER PROCEDURE THISCPU;                                   <<TP.00>>02574000
    OPTION EXTERNAL;                                           <<TP.00>>02576000
                                                               <<00072>>02578000
  INTRINSIC CALENDAR,CLOCK;                                    <<00072>>02580000
                                                               <<TP.00>>02582000
  LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                      <<00173>>02584000
      VALUE PPSIZE;  INTEGER PPSIZE;                           <<00173>>02586000
      OPTION EXTERNAL;                                         <<00173>>02588000
                                                               <<00173>>02590000
  PROCEDURE DIRDEALLOCATE (PNTR,PPSIZE);                       <<00173>>02592000
      VALUE PNTR,PPSIZE;                                       <<00173>>02594000
      LOGICAL PNTR;                                            <<00173>>02596000
      INTEGER PPSIZE;                                          <<00173>>02598000
      OPTION EXTERNAL;                                         <<00173>>02600000
                                                               <<00173>>02602000
  PROCEDURE DIRXXXBITMAP (FUNCTION);                           <<00173>>02604000
      VALUE FUNCTION;  INTEGER FUNCTION;                       <<00173>>02606000
      OPTION EXTERNAL;                                         <<00173>>02608000
  DOUBLE PROCEDURE DIRECSCAN (TYPE, LINKAGE'INDEXP, ANAME,     <<DE>>   02610000
      GUNAME, FNAME, RECIP, PARMS, MVTABX);                    <<DE>>   02612000
      VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                    <<DE>>   02614000
      INTEGER TYPE, MVTABX;                                    <<DE>>   02616000
      DOUBLE  LINKAGE'INDEXP;                                  <<DE>>   02618000
      INTEGER PROCEDURE RECIP;                                 <<DE>>   02620000
      ARRAY   ANAME, GUNAME, FNAME, PARMS;                     <<DE>>   02622000
      OPTION  EXTERNAL, VARIABLE;                              <<DE>>   02624000
                                                               <<DE>>   02626000
  INTEGER PROCEDURE GETDATASEG (MSIZE, VMSIZE);                <<DE>>   02628000
      VALUE   MSIZE, VMSIZE;                                   <<DE>>   02630000
      INTEGER MSIZE, VMSIZE;                                   <<DE>>   02632000
      OPTION  EXTERNAL;                                        <<DE>>   02634000
                                                               <<DE>>   02636000
  INTEGER PROCEDURE RELDATASEG (EN);                           <<DE>>   02638000
      VALUE   EN;                                              <<DE>>   02640000
      INTEGER EN;                                              <<DE>>   02642000
      OPTION  EXTERNAL;                                        <<DE>>   02644000
                                                               <<01591>>02646000
PROCEDURE DATE'LINE(STRING);                                   <<01591>>02648000
BYTE ARRAY STRING;                                             <<01591>>02650000
OPTION EXTERNAL;                                               <<01591>>02652000
  PROCEDURE IOERRCHECK(B,A);                                   <<02509>>02654000
     VALUE B,A;                                                <<02509>>02656000
     INTEGER B,A;                                              <<02509>>02658000
     OPTION FORWARD;                                           <<02509>>02660000
  PROCEDURE WRITETAPE(BUF,LEN,CONTIG);                         <<02509>>02662000
     VALUE LEN,CONTIG;                                         <<02509>>02664000
     INTEGER ARRAY BUF;                                        <<02509>>02666000
     INTEGER LEN;                                              <<03604>>02668000
     LOGICAL CONTIG;                                           <<03604>>02670000
     OPTION FORWARD;                                           <<02509>>02672000
  PROCEDURE IO'CONFIG'CH;                                      <<03006>>02674000
      OPTION FORWARD;                                          <<03006>>02676000
$PAGE "MESSAGE ROUTINE"                                                 02678000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>02680000
INTEGER PROCEDURE WORDADDRESS( BYTEADDRESS );                  <<03704>>02682000
   VALUE BYTEADDRESS;                                          <<03704>>02684000
   BYTE POINTER BYTEADDRESS;                                   <<03704>>02686000
BEGIN                                                          <<03704>>02688000
   TOS := WORDADDRESS := @BYTEADDRESS &LSR(1);                 <<03704>>02690000
   PUSH( Z );                                                  <<03704>>02692000
   << IF WORD ADDRESS > Z FORCE TO DL AREA >>                  <<03704>>02694000
   IF TOS > TOS THEN WORDADDRESS.(0:1) := 1;                   <<03704>>02696000
END;                                                           <<03704>>02698000
$CONTROL SEGMENT=SYSDUMP                                       <<03702>>02700000
        <<---------------------------------------->>           <<03702>>02702000
        <<  CONVERT WORD ADDRESS TO BYTE ADDRESS  >>           <<03702>>02704000
        <<---------------------------------------->>           <<03702>>02706000
INTEGER PROCEDURE BYTEADDRESS(WORDADDRESS);                    <<03702>>02708000
VALUE WORDADDRESS;                                             <<03702>>02710000
POINTER                                                        <<03702>>02712000
   WORDADDRESS;    << POINTER TO BE CONVERTED >>               <<03702>>02714000
COMMENT                                                        <<03702>>02716000
THIS PROCEDURE RETURNS THE GIVEN WORD ADDRESS CONVERTED TO     <<03702>>02718000
A BYTE ADDRESS.  IT WORKS NO MATTER WHERE THE ADDRESS IS       <<03702>>02720000
LOCATED -- IN DB+ OR DB- AREA.                                 <<03702>>02722000
;                                                              <<03702>>02724000
BEGIN                                                          <<03702>>02726000
BYTEADDRESS := @WORDADDRESS&LSL(1);                            <<03702>>02728000
END;   << BYTEADDRESS >>                                       <<03702>>02730000
                                                                        02732000
          <<------------------                                          02734000
            OUTPUT A MESSAGE                                            02736000
          ------------------>>                                          02738000
  PROCEDURE MESSAGE(N); VALUE N;                                        02740000
    INTEGER N;    <<MESSAGE NUMBER>>                                    02742000
    OPTION PRIVILEGED,UNCALLABLE;                                       02744000
      BEGIN                                                             02746000
        BYTE  ARRAY VOCAB(*)=PB:=                              <<03704>>02748000
<<00>>    3,"ANY",                                                      02750000
<<01>>    7,"CHANGES",                                                  02752000
<<02>>    5,"INPUT",                                                    02754000
<<03>>    4,"CORE",                                                     02756000
<<04>>    4,"SIZE",                                                     02758000
<<05>>    3,"I/O",                                                      02760000
<<06>>   13,"CONFIGURATION",                                            02762000
<<07>>    4,"LIST",                                                     02764000
<<08>>    7,"DEVICES",                                                  02766000
<<09>>    7,"HIGHEST",                                                  02768000
<<10>>    3,"DRT",                                                      02770000
<<11>>    6,"DEVICE",                                                   02772000
<<12>>    7,"LOGICAL",                                                  02774000
<<13>>    1,"#",                                                        02776000
<<14>>    4,"UNIT",                                                     02778000
<<15>>    8,"EXTENDED",                                                 02780000
<<16>>    4,"AREA",                                                     02782000
<<17>>    1,",",                                               <<+0.06>>02784000
<<18>>    4,"TYPE",                                                     02786000
<<19>>    3,"SUB",                                                      02788000
<<20>>    1,"-",                                               <<+0.06>>02790000
<<21>>    6,"OUTPUT",                                                   02792000
<<22>>    6,"ACCEPT",                                                   02794000
<<23>>   11,"INTERACTIVE",                                              02796000
<<24>>   11,"DUPLICATIVE",                                              02798000
<<25>>    6,"DRIVER",                                                   02800000
<<26>>    7,"CLASSES",                                                  02802000
<<27>>    6,"SYSTEM",                                                   02804000
<<28>>    7,"CONSOLE",                                                  02806000
<<29>>    5,"ADDED",                                           <<+0.06>>02808000
<<30>>    5,"TABLE",                                                    02810000
<<31>>    3,"CST",                                                      02812000
<<32>>    3,"DST",                                                      02814000
<<33>>    3,"PCB",                                                      02816000
<<34>>    5,"QUEUE",                                                    02818000
<<35>>    8,"TERMINAL",                                                 02820000
<<36>>    7,"BUFFERS",                                                  02822000
<<37>>    3,"ICS",                                                      02824000
<<38>>    4,"UCOP",                                                     02826000
<<39>>    7,"REQUEST",                                                  02828000
<<40>>    7,"ALREADY",                                         <<+0.06>>02830000
<<41>>    2,"BE",                                              <<+0.06>>02832000
<<42>>   10,"ALLOCATION",                                               02834000
<<43>>    7,"VIRTUAL",                                                  02836000
<<44>>   12,"CAPABILITIES",                                    <<+0.06>>02838000
<<45>>   10,"SCHEDULING",                                               02840000
<<46>>    7,"SEGMENT",                                                  02842000
<<47>>    3,"MAX",                                                      02844000
<<48>>    4,"CODE",                                                     02846000
<<49>>    3,"SEG",                                                      02848000
<<50>>    6,"MEMORY",                                                   02850000
<<51>>    5,"STACK",                                                    02852000
<<52>>    3,"RIN",                                                      02854000
<<53>>    5,"EXTRA",                                                    02856000
<<54>>    4,"DATA",                                                     02858000
<<55>>    4,"DATE",                                            <<+0.06>>02860000
<<56>>    7,"ALLOWED",                                                  02862000
<<57>>    8,"OVERFLOW",                                                 02864000
<<58>>    3,"STD",                                                      02866000
<<59>>   10,"MANAGEMENT",                                      <<+0.06>>02868000
<<60>>    2,%15,%12,                                                    02870000
<<61>>    2,"SL",                                                       02872000
<<62>>    7,"LIBRARY",                                                  02874000
<<63>>    5,"ENTER",                                                    02876000
<<64>>    5,"LIMIT",                                                    02878000
<<65>>    4,"NAME",                                                     02880000
<<66>>    7,"DEFINED",                                         <<+0.06>>02882000
<<67>>    7,"PROGRAM",                                                  02884000
<<68>>    4,"DUMP",                                            <<+0.06>>02886000
<<69>>    6,"EXTENT",                                          <<+0.06>>02888000
<<70>>    8,"[,S/C/P]",                                                 02890000
<<71>>    6,"DELETE",                                                   02892000
<<72>>    3,"ADD",                                                      02894000
<<73>>    7,"REPLACE",                                                  02896000
<<74>>    5,"CLASS",                                                    02898000
<<75>>   13,"JOBS/SESSIONS",                                            02900000
<<76>>    1,"7",                                                        02902000
<<77>>    1,"1",                                                        02904000
<<78>>    1,"6",                                                        02906000
<<79>>    1,"0",                                                        02908000
<<80>>    4,"TAPE",                                                     02910000
<<81>>    4,"DISC",                                                     02912000
<<82>>    7,"RUNNING",                                                  02914000
<<83>>    8,"PROGRAMS",                                                 02916000
<<84>>    2,"OF",                                                       02918000
<<85>>   16,"SEGMENTS/PROCESS",                                         02920000
<<86>>    6,"IN/OUT",                                          <<+0.06>>02922000
<<87>>    10,"CONCURRENT",                                              02924000
<<88>>    4,"JOBS",                                                     02926000
<<89>>    4,"MISC",                                                     02928000
<<90>>    4,"ININ",                                            <<+0.06>>02930000
<<91>>    4,"RINS",                                            <<+0.06>>02932000
<<92>>    6,"GLOBAL",                                          <<+0.06>>02934000
<<93>>    5,"TIMER",                                                    02936000
<<94>>    6,"VOLUME",                                                   02938000
<<95>>    9,"INITIALLY",                                       <<+0.06>>02940000
<<96>>    3,"NOT",                                                      02942000
<<97>>   11,"**WARNING**",                                              02944000
<<98>>    9,"FOLLOWING",                                                02946000
<<99>>    6,"STATUS",                                                   02948000
<<100>>   3,"JOB",                                             <<+0.06>>02950000
<<101>>   7,"LOGGING",                                                  02952000
<<102>>  11,"KILOSECTORS",                                     <<+0.06>>02954000
<<103>>   6,"RECORD",                                                   02956000
<<104>>   9,"(SECTORS)",                                                02958000
<<105>>   9,"(RECORDS)",                                                02960000
<<106>>   7,"DEFAULT",                                                  02962000
<<107>>   3,"LOG",                                             <<+0.06>>02964000
<<108>>   5,"FILES",                                                    02966000
<<109>>   1,"A",                                                        02968000
<<110>>   6,"DUMPED",                                                   02970000
<<111>>   5,"ERROR",                                                    02972000
<<112>>   9,"DIRECTORY",                                                02974000
<<113>>   5,"LOGON",                                           <<+0.06>>02976000
<<114>>   5,"SPACE",                                                    02978000
<<115>>   2,"NO",                                                       02980000
<<116>>   2,"IN",                                                       02982000
<<117>>   9,"BLOCKSIZE",                                       <<+0.06>>02984000
<<118>>   7,"ILLEGAL",                                                  02986000
<<119>>   4,"MANY",                                            <<+0.06>>02988000
<<120>>   7,"CHANNEL",                                                  02990000
<<121>>   7,"VOLUMES",                                                  02992000
<<122>>   7,"CHANGED",                                                  02994000
<<123>>   8,"PRIORITY",                                                 02996000
<<124>>   5,"BOUND",                                                    02998000
<<125>>   6,"NORMAL",                                                   03000000
<<126>>   3,"CPU",                                                      03002000
<<127>>  10,"BREAKPOINT",                                      <<+0.06>>03004000
<<128>>   7,"MESSAGE",                                                  03006000
<<129>>   7,"CATALOG",                                                  03008000
<<130>>   2,"OR",                                                       03010000
<<131>>   4,"USER",                                                     03012000
<<132>>   7,"WITHOUT",                                                  03014000
<<133>>   4,"MASK",                                            <<+0.06>>03016000
<<134>>   3,"#'S",                                                      03018000
<<135>>   9,"DUPLICATE",                                                03020000
<<136>>  12,"COMBINATIONS",                                             03022000
<<137>>   4,"MUST",                                            <<+0.06>>03024000
<<138>>   7,"CURRENT",                                                  03026000
<<139>>   3,"NEW",                                             <<+0.06>>03028000
<<140>>   4,"FILE",                                                     03030000
<<141>>   3,"NON",                                             <<+0.06>>03032000
<<142>>   8,"SESSIONS",                                                 03034000
<<143>>   6,"OBTAIN",                                          <<+0.06>>03036000
<<144>>   4,"OPEN",                                            <<+0.06>>03038000
<<145>>   4,"TERM",                                                     03040000
<<146>>   6,"ON/OFF",                                          <<+0.06>>03042000
<<147>>   3,"OUT",                                             <<+0.06>>03044000
<<148>>   8,"PROTOCOL",                                                 03046000
<<149>>   5,"LOCAL",                                                    03048000
<<150>>   4,"MODE",                                                     03050000
<<151>>  12,"TRANSMISSION",                                             03052000
<<152>>   7,"RECEIVE",                                                  03054000
<<153>>   7,"TIMEOUT",                                                  03056000
<<154>>   7,"CONNECT",                                                  03058000
<<155>>   6,"ANSWER",                                                   03060000
<<156>>   8,"FACILITY",                                                 03062000
<<157>>   9,"AUTOMATIC",                                                03064000
<<158>>   4,"DUAL",                                                     03066000
<<159>>   5,"SPEED",                                                    03068000
<<160>>   4,"HALF",                                                     03070000
<<161>>  10,"CHANGEABLE",                                               03072000
<<162>>   9,"PREFERRED",                                                03074000
<<163>>   6,"BUFFER",                                                   03076000
<<164>>   7,"OPTIONS",                                                  03078000
<<165>>   7,"CONTROL",                                                  03080000
<<166>>   6,"LENGTH",                                                   03082000
<<167>>   5,"PHONE",                                                    03084000
<<168>>   6,"NUMBER",                                                   03086000
<<169>>   2,"ID",                                                       03088000
<<170>>   8,"SEQUENCE",                                        <<+0.06>>03090000
<<171>>   6,"REMOTE",                                                   03092000
<<172>>  14,"INTERCOMPONENT",                                           03094000
<<173>>   4,"POLL",                                                     03096000
<<174>>   7,"REPEATS",                                                  03098000
<<175>>   8,"CIRCULAR",                                                 03100000
<<176>>   5,"DELAY",                                                    03102000
<<177>>  10,"COMPONENTS",                                               03104000
<<178>>  10,"PARAMETERS",                                      <<+0.06>>03106000
<<179>>   9,"COMPONENT",                                                03108000
<<180>>  10,"ADDITIONAL",                                               03110000
<<181>>   7,"DRIVERS",                                                  03112000
<<182>>   9,"EXCEEDED,",                                       <<01997>>03114000
<<183>>   3,"PER",                                             <<+0.06>>03116000
<<184>>   4,"DIAL",                                                     03118000
<<185>>   8,"STATIONS",                                        <<+0.06>>03120000
<<186>>   2,"CS",                                                       03122000
<<187>>   4,"PORT",                                            <<+0.06>>03124000
<<188>>   6,"MASTER",                                                   03126000
<<189>>   6,"ENABLE",                                          <<01852>>03128000
<<190>>   9,"SEEKAHEAD",                                       <<01852>>03130000
<<191>>  11,"REPLACEMENT",                                     <<+0.06>>03132000
<<192>>   8,"REQUIRED",                                        <<+0.06>>03134000
<<193>>   7,"SECONDS",                                         <<+0.06>>03136000
<<194>>   7,"SECTORS",                                         <<+0.06>>03138000
<<195>>   7,"SPOOLED",                                         <<+0.06>>03140000
<<196>>  10,"SPOOLFILES",                                      <<+0.06>>03142000
<<197>>   9,"SPOOLFILE",                                       <<+0.06>>03144000
<<198>>   7,"STATION",                                         <<+0.06>>03146000
<<199>>   4,"SUCH",                                            <<+0.06>>03148000
<<200>>   4,"TIME",                                            <<+0.06>>03150000
<<201>>   2,"TO",                                              <<+0.06>>03152000
<<202>>   3,"TOO",                                             <<+0.06>>03154000
<<203>>   6,"UNABLE",                                          <<+0.06>>03156000
<<204>>   7,"USLFILE",                                         <<+0.06>>03158000
<<205>>   5,"WIDTH",                                           <<+0.06>>03160000
<<206>>   5,"ENTRY",                                           <<+0.06>>03162000
<<207>>   10,"CHARACTERS",                                     <<00.06>>03164000
<<208>>    6,"SECOND",                                         <<00.06>>03166000
<<209>>    4,"READ",                                           <<01.00>>03168000
<<210>>    7,"PENDING",                                        <<01.00>>03170000
<<211>>   9,"SUBSET(S)",                                       <<DL.01>>03172000
<<212>>   9,"**MAKECAT",                                       <<2B.00>>03174000
<<213>>   7,"ERROR**",                                         <<2B.00>>03176000
<<214>>   6,"SERIAL",                                          <<SD.00>>03178000
<<215>>   3,"BAD",                                             <<SD.00>>03180000
<<216>>   7,"ADDRESS",                                         <<SD.00>>03182000
<<217>>   4,"THAT",                                            <<TP.00>>03184000
<<218>>   8,"FUNCTION",                                        <<TP.00>>03186000
<<219>>   9,"SUPPORTED",                                       <<TP.00>>03188000
<<220>>   2,"ON",                                              <<TP.00>>03190000
<<221>>   4,"THIS",                                            <<TP.00>>03192000
<<222>>   2,"IS",                                              <<RV.00>>03194000
<<223>>   13,"COLD-LOADABLE",                                  <<RV.00>>03196000
<<224>>   7,"SYSDUMP",                                         <<RV.00>>03198000
<<225>>   5,"MEDIA",                                           <<RV.00>>03200000
<<226>>   5,"MOUNT",                                           <<00072>>03202000
<<227>>   8,"SOFTWARE",                                        <<00072>>03204000
<<228>>   5,"AHEAD",                                           <<03007>>03206000
<<229>>   3,"END",                                             <<00072>>03208000
<<230>>   7,"SECTION",                                         <<00072>>03210000
<<231>>   8,"SOFTDUMP",                                        <<00150>>03212000
<<232>>   7,"COMMAND",                                         <<00150>>03214000
<<233>>  4,"WILL",                                             <<00158>>03216000
<<234>>  6,"LOADED",                                           <<00158>>03218000
<<235>>  8,"RESIDENT",                                         <<00158>>03220000
<<236>>  3,"MOD",                                              <<00311>>03222000
<<237>>  1,"4",                                                <<00311>>03224000
<<238>>  7,"PROCESS",                                          <<00506>>03226000
<<239>> 13,"[,PATCH SIZE]",                                    <<01195>>03228000
<<240>> 9,"PROCESSES",                                                  03230000
<<241>> 5,"USERS",                                                      03232000
<<242>>  9,"SECONDARY",                                        <<03701>>03234000
<<243>>  7,"FOREIGN",                                          <<01115>>03236000
<<244>>  4,"(CRC",                                             <<01209>>03238000
<<244>>  7,"FAILURE",                                          <<01209>>03240000
<<246>>  7,"INVALID",                                          <<01209>>03242000
<<247>>  5,"READY",                                            <<01209>>03244000
<<248>>  3,"SIO",                                              <<01209>>03246000
<<249>>  8,"SPECIFIC",                                         <<01209>>03248000
<<250>>  5,"TRACK",                                            <<01209>>03250000
<<251>>  9,"UNDEFINED",                                        <<01209>>03252000
<<252>>  6,"ERROR)",                                           <<01209>>03254000
<<253>>  4,"SWAP",                                             <<01626>>03256000
<<254>>  7,"PRIMARY",                                          <<01626>>03258000
<<255>>  7,"SPECIAL",                                          <<01626>>03260000
          0;                                                            03262000
        BYTE ARRAY DICT(*)=PB:=                                <<03704>>03264000
<<00>>    2,50,4,                <<MEMORY SIZE>>                        03266000
<<01>>    3,118,2,60,            <<ILLEGAL INPUT>>                      03268000
<<02>>    2,0,1,                 <<ANY CHANGES?>>                       03270000
<<03>>    3,5,6,1,               <<I/O CONFIGURATION CHANGES?>>         03272000
<<04>>    3,7,5,8,               <<LIST I/O DEVICES?>>                  03274000
<<05>>    2,9,10,                <<HIGHEST DRT>>                        03276000
<<06>>    1,31,                  <<CST>>                                03278000
<<07>>    3,12,11,13,            <<LOGICAL DEVICE #?>>                  03280000
<<08>>    2,10,13,               <<DRT #?>>                             03282000
<<09>>    2,14,13,               <<UNIT #>>                             03284000
<<10>>    5,96,109,92,52,60,     <<NOT A GLOBAL RIN>>                   03286000
<<11>>    4,115,199,11,60,            <<NO SUCH DEVICE>>       <<+0.06>>03288000
<<12>>    1,18,                  <<TYPE?>>                              03290000
<<13>>    2,19,18,               <<SUB-TYPE?>>                          03292000
<<14>>    2,103,205,                    <<RECORD WIDTH>>       <<+0.06>>03294000
<<15>>    2,21,11,               <<OUTPUT DEVICE?>>                     03296000
<<16>>    2,22,54,               <<ACCEPT DATA?>>                       03298000
<<17>>    1,23,                  <<INTERACTIVE?>>                       03300000
<<18>>    1,24,                  <<DUPLICATIVE?>>                       03302000
<<19>>    2,25,65,               <<DRIVER NAME?>>                       03304000
<<20>>    2,11,26,               <<DEVICE CLASSES?>>                    03306000
<<21>>   10,27,28,137,41,116,10,76,14,79,60,<<SYSTEM CONSOLE>> <<+0.06>>03308000
                                     <<MUST BE DRT 7 UNIT 0>>  <<+0.06>>03310000
<<22>>    8,27,81,137,41,12,11,77,60,<<SYSTEM DISC MUST BE>>   <<+0.06>>03312000
                                      <<LOGICAL DEVICE 1>>     <<+0.06>>03314000
<<23>>   10,27,80,137,41,116,10,78,14,79,60,<<SYSTEM TAPE>>    <<+0.06>>03316000
                                     <<MUST BE DRT 6 UNIT 0>>  <<+0.06>>03318000
<<24>>    3,27,30,1,             <<SYSTEM TABLE CHANGES?>>              03320000
<<25>>    2,15,31,               <<EXTENDED CST>>                       03322000
<<26>>    1,32,                  <<DST>>                                03324000
<<27>>    1,33,                  <<PCB>>                                03326000
<<28>>    2,5,34,                <<I/O QUEUE>>                          03328000
<<29>>    4,35,36,183,187,       <<TERMINAL BUFFERS PER PORT>> <<03007>>03330000
<<30>>    2,27,36,               <<SYSTEM BUFFERS>>                     03332000
<<31>>    1,37,                  <<ICS>>                                03334000
<<32>>    3,38,39,34,            <<UCOP REQUEST QUEUE>>                 03336000
<<33>>    3,81,39,30,   <<DISC REQUEST TABLE?>>                <<01626>>03338000
<<34>>    3,93,39,7,              <<TIMER REQUEST LIST>>       <<+0.06>>03340000
<<35>>    3,81,42,1,            <<DISC ALLOCATION CHANGES>>             03342000
<<36>>    2,43,50,               <<VIRTUAL MEMORY>>                     03344000
<<37>>    1,47,                  <<MAX>>                                03346000
<<38>>    2,45,1,                 <<SCHEDULING CHANGES>>                03348000
<<39>>    3,46,64,1,             <<SEGMENT LIMIT CHANGES?>>             03350000
<<40>>    4,47,48,49,4,          <<MAX CODE SEG SIZE>>                  03352000
<<41>>    5,47,13,84,48,85,   <<MAX # OF SEGMENTS/PROCESS>>             03354000
<<42>>    3,47,51,4,              <<MAX STACK SIZE>>                    03356000
<<43>>    5,47,53,54,49,4,       <<MAX EXTRA DATA SEG SIZE>>            03358000
<<44>>    3,58,51,4,             <<STD STACK SIZE>>                     03360000
<<45>>    6,47,13,84,53,54,85,    <<MAX # OF EXTRA DATA SEGS/PROCESS>>  03362000
<<46>>    3,7,92,91,             <<LIST GLOBAL RIMS>>                   03364000
<<47>>    3,71,92,52,            <<DELETE GLOBAL RIN>>                  03366000
<<48>>    3,27,61,1,             <<SYSTEM SL CHANGES?>>                 03368000
<<49>>    2,7,62,                <<LIST LIBRARY?>>                      03370000
<<50>>    8,63,46,65,17,204,65,70,60,                          <<00695>>03372000
      <<ENTER SEG NAME,USLFILE NAME [,S/C/P] >>                <<00695>>03374000
<<51>>    8,63,67,65,17,191,140,65,60,<<ENTER PROGRAM NAME,>>  <<+0.06>>03376000
                                       <<RPLCMENT FILE NAME>>  <<+0.06>>03378000
<<52>>    6,47,13,84,87,82,88,   <<MAX # OF CONCURRENT RUNNING JOBS>>   03380000
<<53>>    2,71,46,               <<DELETE SEGMENT>>                     03382000
<<54>>    3,63,46,65,            <<ENTER SEGMENT NAME>>                 03384000
<<55>>    2,72,46,               <<ADD SEGMENT>>                        03386000
<<56>>    2,73,46,               <<REPLACE SEGMENT>>                    03388000
<<57>>    3,27,67,1,             <<SYSTEM PROGRAM CHANGES>>             03390000
<<58>>    4,115,199,74,60,             <<NO SUCH CLASS>>       <<+0.06>>03392000
<<59>>    2,22,75,                   <<ACCEPT JOBS/SESSIONS?>>          03394000
<<60>>    3,63,52,13,            <<ENTER RIN #>>                        03396000
<<61>>    3,89,6,1,               <<MISC CONFIGURATION CHANGES>>        03398000
<<62>>    5,13,84,193,201,113,  <<# OF SECONDS TO LOGON>>      <<+0.06>>03400000
<<63>>    3,13,84,91,             <<# OF RINS>>                         03402000
<<64>>    5,47,13,84,92,91,       <<MAX # OF GLOBAL RINS>>              03404000
<<65>>    4,47,13,84,88,          <<MAX # OF JOBS>>                     03406000
<<66>>    2,71,94,               <<DELETE VOLUME>>                      03408000
<<67>>    3,63,94,65,            <<ENTER VOLUME NAME>>                  03410000
<<68>>    2,72,94,               <<ADD VOLUME>>                         03412000
<<69>>    4,115,199,94,60,             <<NO SUCH VOLUME>>      <<+0.06>>03414000
<<70>>    4,94,40,66,60,        <<VOLUME ALREADY DEFINED>>     <<+0.06>>03416000
<<71>>    3,7,94,30,             <<LIST VOLUME TABLE>>                  03418000
<<72>>    5,96,109,27,67,60,     <<NOT A SYSTEM PROGRAM>>               03420000
<<73>>    7,97,98,27,108,96,110,60,<<**WARNING** FOLLOWING SYSTEM FILES 03422000
                                     NOT DUMPED>>                       03424000
<<74>>    3,63,68,55,               <<ENTER DUMP DATE>>        <<+0.06>>03426000
<<75>>    2,101,1,               <<LOGGING CHANGES>>                    03428000
<<76>>    3,7,101,99,            <<LIST LOGGING STATUS>>                03430000
<<77>>    2,99,1,                <<STATUS CHANGES>>                     03432000
<<78>>    4,63,18,17,146,         <<ENTER TYPE , ON/OFF>>      <<+0.06>>03434000
<<79>>    5,107,140,103,4,104,<<LOG FILE REC SIZE (SECTORS)>>  <<+0.06>>03436000
<<80>>    4,107,140,4,105,    <<LOG FILE SIZE (RECORDS)>>      <<+0.06>>03438000
<<81>>    5,106,100,126,200,64,<<DEFAULT JOB CPU TIME LIMIT>>  <<+0.06>>03440000
<<82>>    3,7,108,110,           <<LIST FILES DUMPED>>                  03442000
<<83>>    4,81,5,111,60,         <<DISC I/O ERROR>>                     03444000
<<84>>    3,112,111,60,          <<DIRECTORY ERROR>>                    03446000
<<85>>    6,203,201,143,51,114,60,<<UNABLE TO OBTAIN STK SPC>> <<+0.06>>03448000
<<86>>    6,115,11,116,74,81,60, <<NO DEVICE IN CLASS DISC>>            03450000
<<87>>    6,118,80,140,144,178,60,<<ILLEGAL TAPE FILE OPEN>>   <<+0.06>>03452000
                                   <<PARAMETERS>>              <<+0.06>>03454000
<<88>>    3,227,120,13,              <<SOFTWARE CHANNEL #>>    <<00072>>03456000
<<89>>    4,202,119,121,60,    <<TOO MANY VOLUMES>>            <<+0.06>>03458000
<<90>>    1,122,                 <<BACKUP FOR /20>>                     03460000
<<91>>    7,27,81,137,41,14,79,60,<<SYS DISC MUST BE UNIT 0>>  <<+0.06>>03462000
<<92>>    6,47,13,84,87,82,83,   <<MAX # OF CONCURRENT RUNNING PROGRAM>>03464000
<<93>>    2,200,190,          <<TIME QUANTUM>>                 <<+0.06>>03466000
<<94>>    2,253,30,     <<SWAP TABLE?>>                        <<01626>>03468000
<<95>>    3,254,128,30, <<PRIMARY MESSAGE TABLE?>>             <<01626>>03470000
<<96>>    3,255,39,30,  <<SPECIAL REQUEST TABLE?>>             <<01626>>03472000
<<97>>    2,127,30,              <<BREAKPOINT TABLE>>                   03474000
<<98>>    3,128,129,1,           <<MESSAGE CATALOG CHANGES?>>           03476000
<<99>>    3,7,128,129,           <<LIST MESSAGE CATALOG?>>              03478000
<<100>>   4,129,2,140,65,    <<CATALOG INPUT FILE NAME>>                03480000
<<101>>   4,131,132,192,44,<<USER WITHOUT REQUIRED CAP>>       <<+0.06>>03482000
<<102>>   2,74,1,           <<CLASS CHANGES>>                           03484000
<<103>>   2,7,26,           <<LIST CLASSES>>                            03486000
<<104>>   2,71,26,          <<DELETE CLASSES>>                          03488000
<<105>>   2,72,26,          <<ADD CLASSES>>                             03490000
<<106>>   1,26,             <<CLASSES>>                                 03492000
<<107>>   3,12,11,134,      <<LOGICAL DEVICES #'S>>                     03494000
<<108>>   3,135,11,134,     <<DUPLICATE DEVICES #'S>>                   03496000
<<109>>   2,74,65,          <<CLASS NAME>>                              03498000
<<110>>   5,118,18,136,116,74, <<ILLEGAL TYPE                           03500000
                                  COMBINATION IN CLASS>>                03502000
<<111>>   4,116,147,130,86,<<IN OUT OR IN/OUT>>                <<+0.06>>03504000
<<112>>   5,87,130,141,20,87,<<CONCURRENT OR NON-CONCURRENT>>  <<+0.06>>03506000
<<113>>   5,47,13,84,144,196,<<MAX # OF OPEN SPOOLFILES>>      <<+0.06>>03508000
<<114>>   5,47,13,84,87,142,     <<MAX # OF CONCURRENT                  03510000
                                      RUNNING SESSIONS>>                03512000
<<115>>   5,47,13,84,196,102,<<MAX # OF SPOOLFILE>>            <<+0.06>>03514000
                             <<KILOSECTORS>>                   <<+0.06>>03516000
<<116>>   2,95,195,<<INITIALLY SPOOLED>>                       <<+0.06>>03518000
<<117>>  3,2,130,21,   <<INPUT OR OUTPUT>>                              03520000
<<118>>   2,145,18,                 <<TERM TYPE>>                       03522000
<<119>>   7,139,90,140,96,77,69,60,<<NEW ININ FILE NOT 1 EXT>> <<+0.06>>03524000
<<120>>   3,7,186,8,             <<LIST CS DEVICES?>>                   03526000
<<121>>   5,118,18,130,14,60,    <<ILLEGAL TYPE OR UNIT>>               03528000
<<122>>   6,118,18,130,19,18,60, <<ILLEGAL TYPE OR SUB-TYPE>>           03530000
<<123>>   1,148,                 <<PROTOCOL?>>                          03532000
<<124>>   2,149,150,             <<LOCAL MODE?>>                        03534000
<<125>>   2,151,48,              <<TRANSMISSION CODE>>                  03536000
<<126>>   2,152,153,             <<RECEIVE TIMEOUT?>>                   03538000
<<127>>   2,149,153,             <<LOCAL TIMEOUT?>>                     03540000
<<128>>   2,154,153,             <<CONNECT TIMEOUT?>>                   03542000
<<129>>   2,155,156,             <<ANSWER FACILITY?>>                   03544000
<<130>>   2,157,155,             <<AUTOMATIC ANSWER?>>                  03546000
<<131>>   2,158,159,             <<DUAL SPEED?>>                        03548000
<<132>>   2,160,159,             <<HALF SPEED?>>                        03550000
<<133>>   2,159,161,             <<SPEED CHANGEABLE>>                   03552000
<<134>>   2,151,159,             <<TRANSMISSION SPEED>>                 03554000
<<135>>   2,151,150,             <<TRANSMISSION MODE>>                  03556000
<<136>>   3,162,163,4,           <<PREFERRED BUFFER SIZE>>              03558000
<<137>>   2,25,164,              <<DRIVER OPTIONS>>                     03560000
<<138>>   2,165,166,             <<CONTROL LENGTH>>                     03562000
<<139>>   2,167,7,               <<PHONE LIST?>>                        03564000
<<140>>   2,167,168,             <<PHONE NUMBER?>>                      03566000
<<141>>   3,149,169,170,<<LOCAL ID SEQUENCE>>                  <<+0.06>>03568000
<<142>>   3,171,169,170,<<REMOTE ID SEQUENCE>>                 <<+0.06>>03570000
<<143>>   2,172,176, <<INTERCOMPONENT DELAY>>                  <<+0.06>>03572000
<<144>>   4,168,84,173,174,      <<NUMBER OF POLL REPEATS>>             03574000
<<145>>   3,175,173,176,         <<CIRCULAR POLL DELAY>>                03576000
<<146>>   3,177,183,198,<<COMPONENTS PER STATION>>             <<+0.06>>03578000
<<147>>   3,168,84,177,          <<NUMBER OF COMPONENTS?>>              03580000
<<148>>   2,179,18,              <<COMPONENT TYPE>>                     03582000
<<149>>   4,179,116,173,7,       <<COMPONENT IN POLL LIST>>             03584000
<<150>>   2,25,161,              <<DRIVER CHANGEABLE>>                  03586000
<<151>>   2,179,170,<<COMPONENT SEQUENCE>>                     <<+0.06>>03588000
<<152>>   3,180,25,1,            <<ADDITIONAL DRIVER CHANGES>>          03590000
<<153>>   3,7,180,181,           <<LIST ADDITIONAL DRIVERS>>            03592000
<<154>>   2,71,181,              <<DELETE DRIVERS>>                     03594000
<<155>>   7,25,96,116,180,181,7,60, <<DRIVER NOT IN                     03596000
                           ADDITIONAL DRIVERS LIST>>                    03598000
<<156>>   4,25,40,66,60,        <<DRIVER ALREADY DEFINED>>     <<+0.06>>03600000
<<157>>   10,47,13,84,180,181,182,25,96,29,60,                 <<+0.06>>03602000
    <<MAX # OF ADDITIONAL DRIVERS EXCEEDED DRIVER NOT ADDED>>           03604000
<<158>>   2,72,181,              <<ADD DRIVERS?>>                       03606000
<<159>>   2,184,156,             <<DIAL FACILITY?>>                     03608000
<<160>>   2,187,133,<<PORT MASK>>                              <<+0.06>>03610000
<<161>>   6,13,84,194,183,197,69,<<# OF SECTORS PER>>          <<+0.06>>03612000
                                 <<SPOOLFILE EXTENT>>          <<+0.06>>03614000
<<162>>   4,118,188,11,60,       <<ILLEGAL MASTER DEVICE>>              03616000
<<163>>   9,47,13,84,144,196,137,41,122,60,<<MAX # OF OPEN>>   <<+0.06>>03618000
                          <<SPOOLFILES MUST BE CHANGED>>       <<+0.06>>03620000
<<164>>   5,47,56,116,138,6,     <<MAX ALLOWED IN CURRENT CONFIG>>      03622000
<<165>>    5,159,116,207,183,208, <<SPEED IN CHAR/SEC>>        <<00.06>>03624000
<<166>>   3,209,210,60, <<READ PENDING>>                       <<01.00>>03626000
<<167>>   4,63,68,140,211, <<ENTER DUMP FILE SUBSET(S)>>       <<DL.01>>03628000
<<168>>   3,212,213,60, <<**MAKECAT ERROR**>>                  <<2B.00>>03630000
<<169>>   3,214,81,74, <<SERIAL DISC CLASS>>                   <<SD.00>>03632000
<<170>>   3,215,81,216, <<BAD DISC ADDRESS>>                   <<SD.00>>03634000
<<171>>   9,217,218,96,219,220,221,126,18,60,                  <<TP.00>>03636000
          <<THAT FUNCTION NOT SUPPORTED ON THIS>>              <<TP.00>>03638000
          <<CPU TYPE>>                                         <<TP.00>>03640000
<<172>>   4,226,214,81,13, <<MOUNT SERIAL DISC#>>              <<00160>>03642000
<<173>>  7,35,14,13,137,41,79,60,                              <<00150>>03644000
         <<TERMINAL UNIT# MUST BE 0>>                          <<00072>>03646000
<<174>>  4,18,228,163,4,                                       <<03007>>03648000
         << TYPE AHEAD BUFFER SIZE? >>                         <<03007>>03650000
<<175>>  10,60,60,60,229,84,27,230,60,60,60,                   <<00072>>03652000
         <<END OF SYSTEM SECTION>>                             <<00072>>03654000
<<176>>  3,231,232,1,                                          <<00150>>03656000
         <<SOFTDUMP COMMAND CHANGES>>                          <<00150>>03658000
<<177>>  4,231,232,140,65,                                     <<00150>>03660000
         <<SOFTDUMP COMMAND,FILE NAME>>                        <<00150>>03662000
<<178>>  5,231,232,140,111,60,                                 <<00150>>03664000
         <<SOFTDUMP COMMAND FILE ERROR>>                       <<00150>>03666000
<<179>>  10,97,186,25,233,96,41,234,3,235,60,                  <<00158>>03668000
         <<**WARNING** CS DRIVER WILL NOT BE>>                 <<00158>>03670000
<<180>>  5,137,41,236,237,60,                                  <<00311>>03672000
         <<SIZE MUST BE MOD 4>>                                <<00311>>03674000
<<181>> 6,47,168,84,131,101,240,                                        03676000
<<182>> 7,47,168,84,241,183,101,238,                                    03678000
<<183>>  1,242,                                                <<01195>>03680000
<<184>>  5,202,119,27,61,01,  << TOO MANY SYSTEM SL CHANGES >> <<01195>>03682000
<<185>>  3,243,81,74,     <<FOREIGN DISC CLASS>>               <<01115>>03684000
<<186>>  4,251,111,168,60,  << UNDEFINED ERROR NUMBER >>       <<01209>>03686000
<<187>>  3,246,218,60,  << INVALID FUNCTION >>                 <<01209>>03688000
<<188>>  8,151,111,244,130,250,249,252,60,                     <<01209>>03690000
         << TRANSMISSION ERROR (CRC OR TRACK SPECIFIC ERROR) >><<01209>>03692000
<<189>>  3,151,111,60,  << TRANSMISSION ERROR >>               <<01209>>03694000
<<190>>  4,248,96,247,60,  << SIO NOT READY >>                 <<01209>>03696000
<<191>>  3,14,245,60,  << UNIT FAILURE >>                      <<01209>>03698000
<<192>>  4,246,81,216,60,  << INVALID DISC ADDRESS >>          <<02509>>03700000
<<193>>  3,43,50,01,  << VIRTUAL MEMORY CHANGES >>             <<01549>>03702000
<<194>>  4,07,43,50,42,  << LIST VIRTUAL MEMORY ALLOCATION >>  <<01549>>03704000
<<195>>  6,63,94,17,04,116,102,                                <<01549>>03706000
         << ENTER VOLUME, SIZE IN KILOSECTORS >>               <<01549>>03708000
<<196>>  2,189,190,                     << ENABLE SEEKAHEAD? >><<01852>>03710000
<<197>>  5,47,90,4,182,60, << MAX ININ SIZE EXCEEDED >>        <<01997>>03712000
<<198>>  5,96,109,219,159,60, << NOT A SUPPORTED SPEED >>      <<03007>>03714000
<<199>>  3,242,128,30,       <<SECONDARY MESSAGE TABLE?>>      <<03701>>03716000
          0;                                                            03718000
        INTEGER ARRAY MESSBUF(0:35);                                    03720000
        BYTE ARRAY BMESS(*) = MESSBUF;                                  03722000
        BYTE POINTER BPMESS := @BMESS;                                  03724000
        INTEGER I:=0,COUNT;                                             03726000
        BYTE POINTER                                           <<04659>>03728000
           POUT;              <<Points along BMESS>>           <<04659>>03730000
                                                               <<04659>>03732000
        DEFINE                                                 <<04659>>03734000
           PRINTIT =                                           <<04659>>03736000
              BEGIN                                            <<04659>>03738000
              @POUT:=TOS;     <<pick up byte pointer>>         <<04659>>03740000
              PRINT'SUB;      <<call print subroutine>>        <<04659>>03742000
              END #;                                           <<04659>>03744000
                                                               <<04659>>03746000
        SUBROUTINE PRINT'SUB;                                  <<04659>>03748000
           BEGIN                                               <<04659>>03750000
           PRINT (MESSBUF, @BMESS-@POUT, 0);                   <<04659>>03752000
           END <<PRINT'SUB SUB>>;                              <<04659>>03754000
                                                               <<04659>>03756000
        <<------------------------------------->>              <<04659>>03758000
                                                               <<04659>>03760000
COMMENT:                                                       <<00.05>>03762000
        DO NOT IMPLEMENT MULTIPLE LINE                         <<00.05>>03764000
        MESSAGES.  I.E.-DO NOT USE CR/LF                       <<00.05>>03766000
        (WORD#60) ANYWHERE EXCEPT AT THE END OF                <<00.05>>03768000
        THE MESSAGE.  IT WILL RESULT IN GARBAGE                <<00.05>>03770000
        CHARACTERS BEING PRINTED ON A LINE PRINTER             <<00.05>>03772000
        LIST DEVICE IN BATCH MODE.                             <<00.05>>03774000
        END OF COMMENT;                                        <<00.05>>03776000
                                                               <<04659>>03778000
         <<NOTE: this business of starting the code of >>      <<04659>>03780000
         <<a procedure indented 8 spaces is for the    >>      <<04659>>03782000
         <<birds!                                      >>      <<04659>>03784000
                                                               <<04659>>03786000
         <<The following code handles message numbers  >>      <<04659>>03788000
         <<above 1000.  These messages were added to   >>      <<04659>>03790000
         <<SYSDUMP after its vocabulary array filled up>>      <<04659>>03792000
         <<(i.e: it has 255 words in it).   Multiple   >>      <<04659>>03794000
         <<line messages are permitted, with inline    >>      <<04659>>03796000
         <<code.                                       >>      <<04659>>03798000
                                                               <<04659>>03800000
   IF N > 1000 THEN                                            <<04659>>03802000
      BEGIN                   <<"new" message numbers>>        <<04659>>03804000
            <<each case following will leave text in >>        <<04659>>03806000
            <<BMESS and a trailing byte pointer on   >>        <<04659>>03808000
            <<the stack, pointing to the end of the  >>        <<04659>>03810000
            <<added text.                            >>        <<04659>>03812000
                                                               <<04659>>03814000
      IF N > 1002 THEN                                         <<04659>>03816000
         N:=1000;             <<"UNKNOWN MESSAGE #">>          <<04659>>03818000
                                                               <<04659>>03820000
      CASE N-1000 OF                                           <<04659>>03822000
         BEGIN                                                 <<04659>>03824000
         <<1000>>                                              <<04659>>03826000
            MOVE BMESS:="UNKNOWN MESSAGE NUMBER", 2;           <<04659>>03828000
         <<1001>>                                              <<04659>>03830000
            BEGIN                                              <<04659>>03832000
            MOVE BMESS:=("FILE SUBSET LIST TOO LONG, A",       <<04659>>03834000
               " MAXIMUM OF 240 CHARACTERS"), 2;               <<04659>>03836000
            PRINTIT;                                           <<04659>>03838000
            MOVE BMESS:=("IS ALLOWED.  FOR MORE COMPLEX ",     <<04659>>03840000
               " LISTS, SPECIFY AN 'INDIRECT' FILE."), 2;      <<04659>>03842000
            END;                                               <<04659>>03844000
         <<1002>>                                              <<04659>>03846000
            MOVE BMESS:="SYNTAX ERROR IN SUBSET LIST", 2;      <<04659>>03848000
         END;                                                  <<04659>>03850000
                                                               <<04659>>03852000
      PRINTIT;                                                 <<04659>>03854000
                                                               <<04659>>03856000
      RETURN;                                                  <<04659>>03858000
      END;                                                     <<04659>>03860000
$PAGE                                                          <<04659>>03862000
          X := -1;                                                      03864000
          TOS := 0;<<SPACE FOR LENGTH OF PREVIOUS MESSAGE>>    <<+0.06>>03866000
          TOS := @BS0+1;<<ADDRESS OF RIGHT BYTE OF TOS>>       <<+0.06>>03868000
COMMENT:                                                       <<+0.06>>03870000
        ADDRESS OF RIGHT BYTE OF CURRENT TOS WILL BE BURIED    <<+0.06>>03872000
        BENEATH TWO STORES ONTO TOS (LINE#1219,1220) AND       <<+0.06>>03874000
        THUS BECOME THE BYTE ADDRESS OF THE RIGHT BYTE         <<+0.06>>03876000
        OF S-2 WHEN S-REG IS CHANGED BY THE STORES.            <<+0.06>>03878000
        END OF COMMENT;                                        <<+0.06>>03880000
          TOS := @DICT;                                                 03882000
          WHILE (X:=X+1) <= \N\ DO                                      03884000
            BEGIN <<FIND PROPER MESSAGE>>                      <<+0.06>>03886000
              TOS := TOS+S2;<<ADD LENGTH OF LAST MESSAGE TO>>  <<+0.06>>03888000
              <<BASE ADDRESS OF THIS MESSAGE TO GET BASE>>     <<+0.06>>03890000
              <<ADDRESS OF NEXT MESSAGE, USE THIS AS SOURCE>>  <<+0.06>>03892000
              <<ADDRESS FOR MOVE>>                             <<+0.06>>03894000
              MOVE * := * PB,(1),1;<<MOVE LENGTH OF THIS>>     <<+0.06>>03896000
              <<MESSAGE INTO S-2>>                             <<+0.06>>03898000
              ASSEMBLE(DECB);<<COUNTERACT EFFECT OF AUTO->>    <<+0.06>>03900000
              <<INCREMENT IN MOVE COMMAND AND SET DESTINATION>><<+0.06>>03902000
              <<ADDRESS BACK TO S-2 FOR THE NEXT MESSAGE>>     <<+0.06>>03904000
            END;                                                        03906000
          COUNT := S2;   <<NUMBER OF VOCAB ENTRIES IN MESSAGE>>         03908000
          WHILE (I:=I+1) <= COUNT DO                                    03910000
            BEGIN                                                       03912000
              MOVE * := * PB,(1),1;  <<VOCAB ENTRY NUMBER>>             03914000
              ASSEMBLE(DECB);                                           03916000
              X := -1;                                                  03918000
              TOS := 0;                                                 03920000
              TOS := @BS0+1;                                            03922000
              TOS := @VOCAB;                                            03924000
              WHILE (X:=X+1) <= S5 DO                                   03926000
                BEGIN                                                   03928000
                  TOS := TOS+S2;    <<UPDATE VOCAB PTR>>                03930000
                  MOVE * := * PB,(1),1;   <<VOCAB ENTRY LENGTH>>        03932000
                  ASSEMBLE(DECB);                                       03934000
                END;                                                    03936000
              MOVE BPMESS := * PB,(S2),2;  <<MOVE MESSAGE>>             03938000
              TOS := TOS-1;                                             03940000
              IF INTEGER(BPS0)<>%12 OR N<0 THEN                         03942000
                BEGIN<<SEPERATE WORDS WITH A SPACE>>           <<+0.06>>03944000
                  TOS := TOS+1;                                         03946000
                  BPS0 := " ";                                          03948000
                END;                                                    03950000
              @BPMESS := TOS+1;                                         03952000
              DDEL;                                                     03954000
            END;                                                        03956000
          TOS := @MESSBUF;                                              03958000
          TOS := @BMESS;                                                03960000
          TOS := @BPMESS;                                               03962000
             IF NOT LOGICAL(MODE) THEN                         <<00.05>>03964000
               BEGIN <<BATCH MODE>>                            <<00.05>>03966000
               TOS:=S0-2;  <<FETCH LAST CHARACTER>>            <<00.05>>03968000
               TOS:=BPS0;  <<OF LAST WORD>>                    <<00.05>>03970000
               DELB;  <<DELETE ITS ADDRESS>>                   <<00.05>>03972000
               <<IF WORD IS CR/LF THEN DELETE IT FROM MESSAGE>><<00.05>>03974000
               IF TOS=%12 THEN TOS:=TOS-3;                     <<00.05>>03976000
               END;                                            <<00.05>>03978000
          IF N<0 THEN                                                   03980000
            BEGIN       <<APPEND QUESTION MARK>>                        03982000
              BPS0 := " ";                                              03984000
              TOS := TOS-1;                                             03986000
              BPS0 := "?";                                              03988000
              TOS := TOS+2;                                             03990000
            END;                                                        03992000
          ASSEMBLE(SUB);   <<COMPUTE NUMBER OF BYTES>>                  03994000
          PRINT(*,*,%320);                                              03996000
      END <<MESSAGE>> ;                                                 03998000
$PAGE "ERROR ROUTINES"                                                  04000000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04002000
                                                                        04004000
          <<----------------------------------                          04006000
            PURGE TEMPORARY SL FILE AND QUIT                            04008000
          ---------------------------------->>                          04010000
  PROCEDURE PURGETEMPSL;                                                04012000
    OPTION PRIVILEGED,UNCALLABLE;                                       04014000
      BEGIN                                                             04016000
          IF TEMPSLSAVED THEN                                           04018000
            BEGIN  <<MUST PURGE>>                                       04020000
              IF NOT TEMPSLOPEN THEN                                    04022000
                TSLFNUM := FOPEN(TSLFILE,%(2)10);                       04024000
              FCLOSE(TSLFNUM,4,0);   <<RELEASE>>                        04026000
            END;                                                        04028000
          IF SIRS THEN                                         <<01890>>04030000
            BEGIN   <<RELEASE SIRS>>                           <<01890>>04032000
              RELSIR(DIRSIR,DSIR);                             <<01890>>04034000
              RELSIR(FLABSIR,FSIR);                            <<01890>>04036000
              RELSIR(FMAVTSIR,FMSIR);                          <<01890>>04038000
            END;                                               <<01890>>04040000
          RESETCRITICAL(0);  <<IN CASE IN CRITICAL MODE>>               04042000
          QUIT(0);                                                      04044000
      END <<PURGETEMPSL>> ;                                             04046000
$CONTROL SEGMENT=SYSDUMP                                       <<03544>>04048000
       <<---------------------------------->>                  <<03544>>04050000
       <<      SEE IF LDEV EXISTS          >>                  <<03544>>04052000
       <<---------------------------------->>                  <<03544>>04054000
LOGICAL PROCEDURE LDEV'EXISTS( LDEV);                          <<03544>>04056000
VALUE LDEV;                                                    <<03544>>04058000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03544>>04060000
COMMENT                                                        <<03544>>04062000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS               <<03544>>04064000
ACTUALLY CONFIGURED, FALSE OTHERWISE.                          <<03544>>04066000
;                                                              <<03544>>04068000
BEGIN                                                          <<03544>>04070000
IF 1 <= LDEV <= HLDEV AND                                      <<03544>>04072000
   (DVRTAB(LDEV*DVRSIZE).DRTFIELD <> 0 OR                      <<03544>>04074000
    DVRTAB(LDEV*DVRSIZE+DVR1).DSBIT = 1) THEN                  <<03544>>04076000
   LDEV'EXISTS := TRUE                                         <<03544>>04078000
ELSE                                                           <<03544>>04080000
   LDEV'EXISTS := FALSE;                                       <<03544>>04082000
END;  << LDEV'EXISTS >>                                        <<03544>>04084000
$CONTROL SEGMENT=SYSDUMP                                       <<03544>>04086000
      <<----------------------------------------->>            <<03544>>04088000
      << SEE IF LDEV EXISTS AND IS NOT DS DEVICE >>            <<03544>>04090000
      <<----------------------------------------->>            <<03544>>04092000
LOGICAL PROCEDURE NON'DS'LDEV(LDEV);                           <<03544>>04094000
VALUE LDEV;                                                    <<03544>>04096000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03544>>04098000
COMMENT                                                        <<03544>>04100000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS ACTUALLY      <<03544>>04102000
CONFIGURED AND IS NOT A DS DEVICE.  IT RETURNS FALSE           <<03544>>04104000
OTHERWISE.                                                     <<03544>>04106000
;                                                              <<03544>>04108000
BEGIN                                                          <<03544>>04110000
IF 1 <= LDEV <= HLDEV AND                                      <<03544>>04112000
   DVRTAB(LDEV*DVRSIZE+DVR1).DSBIT = 0 AND                     <<03544>>04114000
   DVRTAB(LDEV*DVRSIZE).DRTFIELD <> 0 THEN                     <<03544>>04116000
   NON'DS'LDEV := TRUE                                         <<03544>>04118000
ELSE                                                           <<03544>>04120000
   NON'DS'LDEV := FALSE;                                       <<03544>>04122000
END;  << NON'DS'LDEV >>                                        <<03544>>04124000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>04126000
          <<-------------------------                                   04128000
            FULLY QUALIFY FILE NAME                                     04130000
          ------------------------->>                                   04132000
  PROCEDURE ADDPUBSYS(NAME);                                            04134000
    BYTE ARRAY NAME;                                                    04136000
    OPTION PRIVILEGED,UNCALLABLE;                                       04138000
      BEGIN                                                             04140000
          MOVE FULLNAME := NAME WHILE AN,1;                             04142000
          MOVE * := ".PUB.SYS ";                                        04144000
      END <<ADDPUBSYS>> ;                                               04146000
PROCEDURE ADD'TO'SYSPROG'CHG'TABLE(PROGNAME,NEWNAME);          <<04253>>04148000
                                                               <<04253>>04150000
VALUE PROGNAME,NEWNAME;                                        <<04253>>04152000
BYTE POINTER PROGNAME,NEWNAME;                                 <<04253>>04154000
                                                               <<04253>>04156000
BEGIN                                                          <<04253>>04158000
                                                               <<04253>>04160000
INTEGER I;                                                     <<04253>>04162000
                                                               <<04253>>04164000
I:= 0;                                                         <<04253>>04166000
                                                               <<04253>>04168000
WHILE I<SYSPROG'CHG'TABLE'LIMIT DO                             <<04253>>04170000
  BEGIN                                                        <<04253>>04172000
  IF BSPC(I)=0 THEN                                            <<04253>>04174000
    BEGIN                                                      <<04253>>04176000
    MOVE BSPC(I):= PROGNAME,(8);                               <<04253>>04178000
    MOVE BSPC(I+8):= NEWNAME,(26);                             <<04253>>04180000
    RETURN;                                                    <<04253>>04182000
    END;                                                       <<04253>>04184000
  I:= I+34;                                                    <<04253>>04186000
  END;                                                         <<04253>>04188000
END;                                                           <<04253>>04190000
LOGICAL PROCEDURE SEARCH'SYSFILE(FILENAME);                    <<04253>>04192000
   BYTE ARRAY FILENAME;                                        <<04253>>04194000
BEGIN                                                          <<04253>>04196000
   <<  SEARCH IF A SYSTEM PROGRAM CHANGE HAS BEEN MADE  >>     <<04253>>04198000
   <<  FOR "FILENAME".  IF A CHANGE HAS BEEN MADE,      >>     <<04253>>04200000
   <<  THE NEW NAME WILL BE RETURNED IN "FULLNAME"      >>     <<04253>>04202000
   <<  OTHERWISE "FILENAME" WILL BE FULLY QUALIFIED     >>     <<04253>>04204000
   <<  AND RETURNED IN "FULLNAME".                      >>     <<04253>>04206000
   X := 0;                                                     <<04253>>04208000
   WHILE X < SYSPROG'CHG'TABLE'LIMIT DO                        <<04253>>04210000
      BEGIN  << SEARCH FOR NEW SYSTEM FILE >>                  <<04253>>04212000
      IF BSPC(X) = FILENAME,(8) THEN                           <<04253>>04214000
         BEGIN << MUST USE DIFFERENT SYSTEM FILE >>            <<04253>>04216000
         MOVE FULLNAME:= BSPC(X+8),(26);                       <<04253>>04218000
         SEARCH'SYSFILE := TRUE;                               <<04253>>04220000
         RETURN;                                               <<04253>>04222000
         END;                                                  <<04253>>04224000
      X:=X+34;                                                 <<04253>>04226000
      END;                                                     <<04253>>04228000
   << A SYSTEM PROGRAM CHANGE DOES NOT EXIST FOR THIS FILE >>  <<04253>>04230000
   ADDPUBSYS( FILENAME);                                       <<04253>>04232000
END;                                                           <<04253>>04234000
$CONTROL SEGMENT=SYSDUMP                                       <<02509>>04238000
          <<-------------------                                         04240000
            HANDLE FILE ERROR                                           04242000
          ------------------->>                                         04244000
  PROCEDURE FERROR(FNUM,FNAME);                                         04246000
    VALUE FNUM;                                                         04248000
    INTEGER FNUM;       <<FILE NUMBER>>                                 04250000
    BYTE ARRAY FNAME;   <<FILE NAME>>                                   04252000
    OPTION PRIVILEGED,UNCALLABLE;                                       04254000
    COMMENT                                                             04256000
      OUTPUTS A MESSAGE FOLLOWING A FILE ERROR;                         04258000
      BEGIN                                                             04260000
        BYTE ARRAY EOFMESS(0:2)=PB := "EOF";                            04262000
        BYTE ARRAY INUSE(0:23)=PB:="FILE IN USE - CAN'T DUMP";          04264000
        INTEGER ERRORCODE, LEN;                                <<01109>>04266000
          IF FNUM=1024 THEN                                             04268000
            BEGIN                                                       04270000
              MOVE BINBUF := INUSE,(24),2;                              04272000
              GOTO MOVENAME;                                            04274000
            END;                                                        04276000
          IF FNUM<0 THEN                                                04278000
            BEGIN   <<I/O ERROR>>                                       04280000
              MOVE BINBUF := "ATTACHIO ERROR - ";              <<01209>>04282000
              PRINT(INBUF, -17, %320);                         <<01209>>04284000
              IF 0<=(-FNUM).(10:3) AND (-FNUM).(10:3)<7 THEN   <<01209>>04286000
                CASE (-FNUM).(10:3) OF                         <<01209>>04288000
                  BEGIN                                        <<01209>>04290000
                    MESSAGE(187);  << INVALID FUNCTION >>      <<01209>>04292000
                    MESSAGE(188);  << TRANSMISSION ERROR >>    <<01209>>04294000
                    MESSAGE(186);  << UNDEFINED ERROR NUMBER >><<01209>>04296000
                    MESSAGE(189);  << TRANSMISSION ERROR >>    <<01209>>04298000
                    MESSAGE(190);  << SIO NOT READY >>         <<01209>>04300000
                    MESSAGE(191);  << UNIT FAILURE >>          <<01209>>04302000
                    MESSAGE(192);  << INVALID DISC ADDRESS >>  <<01209>>04304000
                  END                                          <<01209>>04306000
              ELSE                                             <<01209>>04308000
                MESSAGE(186);  << UNDEFINED ERROR NUMBER >>    <<01209>>04310000
              MOVE BINBUF := " - FILE:",2;                     <<01209>>04312000
              GOTO MOVENAME;                                            04314000
            END;                                                        04316000
          FCHECK(FNUM,ERRORCODE);                                       04318000
          FERRMSG(ERRORCODE, INBUF, LEN);                      <<01109>>04320000
          PRINT(INBUF, -LEN, %40);                             <<01109>>04322000
          MOVE BINBUF := "FILENAME -",2;                       <<01109>>04324000
  MOVENAME:                                                             04326000
          BPS0 := " ";                                                  04328000
          TOS := @INBUF;      <<FOR PRINT>>                             04330000
          ASSEMBLE(INCB,XCH);                                           04332000
          TOS := @FNAME;                                                04334000
  NEXT:   MOVE * := * WHILE AN,0;                                       04336000
          IF BPS0 = "." THEN                                            04338000
            BEGIN                                                       04340000
              MOVE * := *,(1),1;                                        04342000
              GOTO NEXT;                                                04344000
            END;                                                        04346000
          ASSEMBLE(DEL,NEG);                                            04348000
          TOS := TOS+@BINBUF;   <<CHAR COUNT>>                          04350000
          PRINT(*,*,0);                                                 04352000
          PURGETEMPSL;                                                  04354000
      END <<FERROR>> ;                                                  04356000
$PAGE "TERMINAL INPUT PROCEDURES"                                       04358000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04360000
           <<---------------------->>                          <<03544>>04364000
           <<   ZERO A BUFFER      >>                          <<03544>>04366000
           <<---------------------->>                          <<03544>>04368000
PROCEDURE ZEROBUF( BUF, LEN);                                  <<03544>>04370000
VALUE LEN;                                                     <<03544>>04372000
ARRAY BUF;     << BUFFER TO BE ZEROED >>                       <<03544>>04374000
INTEGER LEN;   << LENGTH TO ZERO      >>                       <<03544>>04376000
COMMENT                                                        <<03544>>04378000
ZEROES A LOGICAL ARRAY FOR THE SPECIFIED LENGTH                <<03544>>04380000
(IN WORDS).                                                    <<03544>>04382000
;                                                              <<03544>>04384000
BEGIN                                                          <<03544>>04386000
IF LEN > 0 THEN         << IF LENGTH <= 0 DON'T   >>           <<03544>>04388000
   BEGIN                <<     DO ANYTHING        >>           <<03544>>04390000
   BUF := 0;            << OTHERWISE, ZERO IT OUT >>           <<03544>>04392000
   MOVE BUF(1) := BUF,(LEN-1);                                 <<03544>>04394000
   END;                                                        <<03544>>04396000
END;     << ZEROBUF >>                                         <<03544>>04398000
PROCEDURE FILL' (BUF', LEN, CHAR);                             <<04659>>04400000
         VALUE LEN, CHAR;                                      <<04659>>04402000
         BYTE ARRAY BUF';                                      <<04659>>04404000
         INTEGER LEN;                                          <<04659>>04406000
         BYTE CHAR;                                            <<04659>>04408000
   BEGIN                                                       <<04659>>04410000
                                                               <<04659>>04412000
   BUF':=CHAR;                                                 <<04659>>04414000
   IF LEN > 1 THEN                                             <<04659>>04416000
      MOVE BUF'(1):=BUF'(0),(LEN-1);                           <<04659>>04418000
                                                               <<04659>>04420000
   END <<FILL' PROC>>;                                         <<04659>>04422000
    <<------------------------------------->>                  <<DL.01>>04424000
    <<DELETE COMMENTS FROM TERMINAL BUFFERS>>                  <<DL.01>>04426000
    <<------------------------------------->>                  <<DL.01>>04428000
                                                               <<DL.01>>04430000
  PROCEDURE DELETECOMMENT(BUFFER,MAXLENGTH);                   <<DL.01>>04432000
  VALUE MAXLENGTH;                                             <<DL.01>>04434000
  INTEGER MAXLENGTH;                                           <<DL.01>>04436000
  BYTE ARRAY BUFFER;                                           <<DL.01>>04438000
                                                               <<DL.01>>04440000
  COMMENT:THIS ROUTINE WILL DELETE COMMENTS FROM               <<DL.01>>04442000
  TERMINAL INPUT BUFFERS BY PHYSICALLY COMPRESSING             <<DL.01>>04444000
  THE CHARACTER STRING.  IT ASSUMES THAT THE VALID             <<DL.01>>04446000
  DATA IN THE STRING IS DELIMITED BY A CR (%15).;              <<DL.01>>04448000
                                                               <<DL.01>>04450000
  BEGIN                                                        <<DL.01>>04452000
  LOGICAL ENDFOUND,CLOSED;                                     <<DL.01>>04454000
  INTEGER INDEX;                                               <<DL.01>>04456000
  EQUATE CROPEN=%6474, CRCLOSE=%6476;                          <<DL.01>>04458000
                                                               <<DL.01>>04460000
  TOS:=@BUFFER; <<SET START FOR SCAN>>                         <<DL.01>>04462000
  ENDFOUND:=FALSE;                                             <<DL.01>>04464000
  DO                                                           <<DL.01>>04466000
    BEGIN <<SEARCH FOR COMMENTS>>                              <<DL.01>>04468000
    SCAN * UNTIL CROPEN,1;                                     <<DL.01>>04470000
    IF CARRY THEN ENDFOUND:=TRUE;                              <<DL.01>>04472000
    IF BPS0="<<" THEN                                          <<DL.01>>04474000
      BEGIN <<VALID COMMENT STARTED>>                          <<DL.01>>04476000
      ASSEMBLE(DUP,DUP);                                       <<DL.01>>04478000
      CLOSED:=FALSE;                                           <<DL.01>>04480000
      DO                                                       <<DL.01>>04482000
        BEGIN <<SEARCH FOR END OF COMMENT>>                    <<DL.01>>04484000
        SCAN * UNTIL CRCLOSE,1;                                <<DL.01>>04486000
        IF CARRY THEN                                          <<DL.01>>04488000
          BEGIN <<CLOSED BY END OF DATA>>                      <<DL.01>>04490000
          DDEL;                                                <<DL.01>>04492000
          BPS0:=%15;<<MOVE END OF DATA MARK>>                  <<DL.01>>04494000
          CLOSED:=TRUE;                                        <<DL.01>>04496000
          ENDFOUND:=TRUE;                                      <<DL.01>>04498000
          END;  <<CLOSED BY END OF DATA>>                      <<DL.01>>04500000
        IF BPS0=">>" THEN                                      <<DL.01>>04502000
          BEGIN <<CLOSED BY CAROTS>>                           <<DL.01>>04504000
          TOS:=TOS+2; <<STEP OVER CAROTS>>                     <<DL.01>>04506000
          INDEX:=S0;<<NEXT NON-COMMENT CHAR>>                  <<DL.01>>04508000
          MOVE *:=*,(@BUFFER+MAXLENGTH-INDEX);                 <<DL.01>>04510000
          CLOSED:=TRUE;                                        <<DL.01>>04512000
          END   <<CLOSED BY CAROTS>>                           <<DL.01>>04514000
        ELSE                                                   <<DL.01>>04516000
          <<FALSE CLOSE-ONLY ONE CAROT>>                       <<DL.01>>04518000
          TOS:=TOS+1; <<STEP OVER CAROT>>                      <<DL.01>>04520000
        END   <<SEARCH FOR END OF COMMENT>>                    <<DL.01>>04522000
      UNTIL CLOSED;                                            <<DL.01>>04524000
      END;  <<VALID COMMENT>>                                  <<DL.01>>04526000
    TOS:=TOS+1; <<BUMP SEARCH START ADDRESS>>                  <<DL.01>>04528000
    END   <<SEARCH FOR COMMENTS>>                              <<DL.01>>04530000
  UNTIL ENDFOUND;                                              <<DL.01>>04532000
  DEL; <<GET RID OF SEARCH START POINTER>>                     <<DL.01>>04534000
  END;  <<DELETECOMMENT>>                                      <<DL.01>>04536000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04538000
                                                               <<DL.01>>04540000
          <<----------------------                                      04542000
            READ A LINE OF INPUT                                        04544000
          ---------------------->>                                      04546000
  PROCEDURE READINPUT;                                                  04548000
    OPTION PRIVILEGED,UNCALLABLE;                                       04550000
    COMMENT                                                             04552000
      READS A LINE OF INPUT FROM THE JOB INPUT DEVICE;                  04554000
      BEGIN                                                             04556000
          @BPINBUF := @INBUF&LSL(1);                                    04558000
          TOS:=READ(INBUF,-72);                                <<+0.05>>04560000
          IF <> THEN PURGETEMPSL;  <<QUIT>>                             04562000
          <<DEBUG MAY BE INVOKED BY RESPONDING>>               <<01.00>>04564000
          <<"DEBUG" TO ANY QUESTION IN THE>>                   <<01.00>>04566000
          <<SYSDUMP DIALOG WHILE IN A SESSION>>                <<01.00>>04568000
          IF LOGICAL(MODE) THEN  <<SESSION?>>                  <<01.00>>04570000
            IF BINBUF="DEBUG" AND S0=5 THEN                    <<01.00>>04572000
              BEGIN <<INVOKE DEBUG AND RECALL READ>>           <<01.00>>04574000
              DEBUG;                                           <<01.00>>04576000
              DEL; <<LENGTH OF "READ" RESPONSE>>               <<01.00>>04578000
              MESSAGE(166); <<READ PENDING>>                   <<01.00>>04580000
              READINPUT;                                       <<DL.01>>04582000
              RETURN;                                          <<DL.01>>04584000
              END;                                             <<DL.01>>04586000
          IF NOT LOGICAL(MODE) THEN                                     04588000
            BEGIN  <<BATCH>>                                            04590000
            TOS:=@INBUF;                                       <<DL.01>>04592000
              TOS := -S1;                                               04594000
              PRINT(*,*,0);                                             04596000
            END;                                                        04598000
          X := TOS;                                                     04600000
          BINBUF(X):=%15;  <<CARRIAGE RETURN TERMINATOR>>      <<DL.01>>04602000
          DELETECOMMENT(BINBUF,BINBUFLEN);                     <<DL.01>>04604000
      END <<READINPUT>> ;                                               04606000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04608000
                                                                        04610000
          <<-----------------                                           04612000
            GET INPUT VALUE                                             04614000
          ----------------->>                                           04616000
  INTEGER PROCEDURE INVAL(ERRLABEL,DELIM,DOUBL);                        04618000
    VALUE ERRLABEL,DELIM,DOUBL;                                         04620000
    INTEGER ERRLABEL,     <<LABEL FOR ERROR RETURN>>                    04622000
            DELIM;        <<ALLOWED DELIMITER>>                         04624000
    LOGICAL DOUBL;         <<IF PASSED THEN RETURN DOUBLE>>             04626000
    OPTION PRIVILEGED,UNCALLABLE;                                       04628000
    OPTION VARIABLE;                                                    04630000
    COMMENT                                                             04632000
      CONVERTS A NUMBER POINTED TO BY BPINBUF TO BINARY. IF AN ERROR    04634000
    IS DETECTED RETURNS TO ERRLABEL. OTHERWISE RETURNS VALUE AND SETS   04636000
    CONDITION CODE AS FOLLOWS:                                          04638000
         CCE - NO VALUE INPUT                                           04640000
         CCG - FOLLOWED BY CARRIAGE RETURN                              04642000
         CCL - FOLLOWED BY DELIMITER;                                   04644000
      BEGIN                                                             04646000
      DOUBLE DINVAL=Q-9;                                                04648000
      LOGICAL DBLE=Q-4;                                                 04650000
        EQUATE BLANK=%6440;                                             04652000
        INTEGER CONCODE:=CCL;                                           04654000
        INTEGER BASE:=10;                                      <<00266>>04656000
          TOS := 0D;  <<FOR BINARY OR DBINARY RETURN>>                  04658000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        04660000
          IF CARRY THEN                                                 04662000
            BEGIN       <<CARRIAGE RETURN INPUT>>                       04664000
              @BPINBUF := TOS+1;                                        04666000
              CONCODE := CCE;                                           04668000
              GOTO FIN;                                                 04670000
            END;                                                        04672000
          IF BPS0="%" THEN                                     <<00266>>04674000
            BEGIN                                              <<00266>>04676000
            BASE:=8;                                           <<00266>>04678000
            TOS:=TOS+1;                                        <<00266>>04680000
            END;                                               <<00266>>04682000
          ASSEMBLE(DUP,DDUP);                                           04684000
          MOVE * := * WHILE N,0;   <<FIND FIRST NON-NUMERIC>>           04686000
          SCAN * WHILE BLANK,1;    <<DELETE TRAILING BLANKS>>           04688000
          IF CARRY THEN CONCODE := CCG    <<CR FOLLOWS>>                04690000
          ELSE IF INTEGER(BPS0)<>DELIM THEN GOTO ERROR;                 04692000
          @BPINBUF := TOS+1;     <<UPDATE BUFFER POINTER>>              04694000
          ASSEMBLE(XCH,SUB);     <<COMPUTE LENGTH>>                     04696000
          IF S0>7 AND NOT DBLE THEN GO ERROR;                           04698000
          IF S0>11 THEN GO TO ERROR;<<FOR DOUBLES>>;                    04700000
          IF BASE=8 THEN                                       <<00266>>04702000
            BEGIN                                              <<00266>>04704000
            S1:=S1-1; <<SET BACK TO INCLUDE "%">>              <<00266>>04706000
            S0:=S0+1; <<INCREMENT LENGTH>>                     <<00266>>04708000
            END;                                               <<00266>>04710000
          IF DBLE AND DOUBL THEN                                        04712000
            BEGIN                                                       04714000
         DINVAL := DBINARY(*,*);                                        04716000
            GO FIN;                                                     04718000
            END;                                                        04720000
          INVAL := BINARY(*,*);  <<COMPUTE VALUE>>                      04722000
          IF <> THEN                                                    04724000
            BEGIN    <<ERROR IN CONVERSION>>                            04726000
  ERROR:      RETURNP := ERRLABEL;     <<ERROR RETURN LABEL>>           04728000
              ASSEMBLE(EXIT 5);        <<DELETE INVAL'S VALUE>><<01165>>04730000
            END;                                                        04732000
  FIN:    STAT.(6:2) := CONCODE;       <<SET CONDITION CODE>>           04734000
      END <<INVAL>> ;                                                   04736000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04738000
                                                                        04740000
          <<--------------------------                                  04742000
            GET "YES" OR "NO" ANSWER                                    04744000
          -------------------------->>                                  04746000
  PROCEDURE GETYESNO(NOLABEL,MESSN);                                    04748000
    VALUE NOLABEL,MESSN;                                                04750000
    INTEGER NOLABEL,    <<LABEL OF RETURN FOR "NO" RESPONSE>>           04752000
            MESSN;      <<MESSAGE NUMBER>>                              04754000
    OPTION PRIVILEGED,UNCALLABLE;                                       04756000
    COMMENT                                                             04758000
      OUTPUTS A MESSAGE AND LOOKS FOR A "Y" RESPONSE (NORMAL RETURN)    04760000
    OR A "N" OR CARRIAGE RETURN RESPONSE (RETURN TO NOLABEL);           04762000
      BEGIN                                                             04764000
        EQUATE BLANK = %6440;                                           04766000
  AGAIN:  MESSAGE(-MESSN);    <<OUTPUT MESSAGE>>                        04768000
          READINPUT;                                                    04770000
          SCAN BINBUF WHILE BLANK,1;                                    04772000
          ASSEMBLE(DUP,DUP);                                            04774000
          MOVE * := * WHILE ANS;  <<UPSHIFT LOWER CASE>>                04776000
          IF CARRY OR (BPS0="N") THEN                                   04778000
            BEGIN    <<"NO" RESPONSE>>                                  04780000
              RETURNP := NOLABEL;                                       04782000
              RETURN;                                                   04784000
            END                                                         04786000
          ELSE                                                          04788000
          IF BPS0<>"Y" THEN                                             04790000
            BEGIN    <<ERROR>>                                          04792000
              DEL;                                                      04794000
              MESSAGE(1);  <<ILLEGAL INPUT>>                            04796000
              GO AGAIN;                                                 04798000
            END;                                                        04800000
                    <<FALLS THROUGH IN "Y" CASE>>                       04802000
      END <<GETYESNO>> ;                                                04804000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04806000
     LOGICAL PROCEDURE YESANSWER(MESSN);                       <<01073>>04808000
     VALUE MESSN;                                              <<01073>>04810000
     INTEGER MESSN;                                            <<01073>>04812000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>04814000
     BEGIN                                                     <<01073>>04816000
      GETYESNO(@NOANSWER,MESSN);                               <<01073>>04818000
      YESANSWER := TRUE;                                       <<01073>>04820000
      RETURN;                                                  <<01073>>04822000
 NOANSWER:                                                     <<01073>>04824000
      YESANSWER := FALSE;                                      <<01073>>04826000
      RETURN;                                                  <<01073>>04828000
     END;                                                      <<01073>>04830000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>04832000
                                                                        04834000
          <<-----------                                                 04836000
            GET VALUE                                                   04838000
          ----------->>                                                 04840000
  INTEGER PROCEDURE GETVAL(MESSN,LLIM,ULIM,TERM);                       04842000
    VALUE MESSN,LLIM,ULIM,TERM;                                         04844000
    INTEGER MESSN,   <<MESSAGE NUMBER>>                                 04846000
            LLIM,    <<LOWER LIMIT>>                                    04848000
            ULIM,    <<UPPER LIMIT>>                                    04850000
            TERM;    <<TERMINATING CONTROL:                             04852000
                          2 - CR ONLY (NO VALUE INPUT OK)               04854000
                          1 - CR ONLY (NO VALUE INPUT IS ERROR)         04856000
                          0 - COMMA ONLY                                04858000
                         -1 - CR OR COMMA  >>                           04860000
    OPTION PRIVILEGED,UNCALLABLE;                                       04862000
    COMMENT                                                             04864000
      OUTPUTS A MESSAGE AND LOOKS FOR THE INPUT OF A NUMBER IN THE      04866000
    RANGE  LLIM <= N <= ULIM.                                  <<00.04>>04868000
    THE CONDITION CODE IS SET AS FOLLOWS:                      <<00.04>>04870000
         CCG - VALUE FOLLOWED BY CARRIAGE RETURN               <<00.04>>04872000
         CCL - VALUE FOLLOWED BY COMMA                         <<00.04>>04874000
         CCE - NO VALUE INPUT AND TERMINATING CONTROL=2;       <<00.04>>04876000
      BEGIN                                                             04878000
        INTEGER TERMTEMP;                                               04880000
  AGAIN:  MESSAGE(-MESSN);       <<OUTPUT MESSAGE>>                     04882000
          READINPUT;                                                    04884000
          TOS := INVAL(@ERROR1,",");                                    04886000
          IF = THEN IF TERM<>2 THEN GOTO ERROR                          04888000
          ELSE                                                          04890000
            BEGIN  <<<<NO VALUE INPUT>>                                 04892000
              STAT.(6:2) := CCE;                                        04894000
              RETURN;                                                   04896000
            END;                                                        04898000
          PUSH(STATUS);                                                 04900000
          TOS := TOS.(6:2);                                             04902000
          STAT.(6:2) := S0;        <<SET CONDITION CODE>>               04904000
          TERMTEMP := (IF TERM=2 THEN 1 ELSE TERM);                     04906000
          IF TOS=TERMTEMP THEN GOTO ERROR;<<WRONG FOLLOWING CHAR>>      04908000
          IF (LLIM<=S0<=ULIM) THEN                                      04910000
            BEGIN                                                       04912000
              GETVAL := TOS;                                            04914000
              RETURN;                                                   04916000
            END;                                                        04918000
  ERROR:  DEL;                                                          04920000
  ERROR1: MESSAGE(1);                                                   04922000
          GO AGAIN;                                                     04924000
      END <<GETVAL>> ;                                                  04926000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>04928000
                                                                        04930000
          <<-----------------------                                     04932000
            GET REPLACEMENT VALUE                                       04934000
          ----------------------->>                                     04936000
  PROCEDURE GETNEWVAL(MESSN,VAL,LLIM,ULIM);                             04938000
    VALUE MESSN,LLIM,ULIM;                                              04940000
  INTEGER MESSN;    <<MESSAGE NUMBER>>                         <<00550>>04942000
  LOGICAL VAL,      <<VALUE TO BE REPLACED>>                   <<00550>>04944000
          LLIM,     <<LOWER LIMIT>>                            <<00550>>04946000
          ULIM;     <<UPPER LIMIT>>                            <<00550>>04948000
    OPTION PRIVILEGED,UNCALLABLE;                                       04950000
    COMMENT                                                             04952000
        OUTPUTS A MESSAGE FOLLOWED BY THE CURRENT VALUE, A PERIOD (.)   04954000
      AND A QUESTION MARK(?). LOOKS FOR THE INPUT OF A CARRIAGE         04956000
      RETURN, WHICH LEAVES THE VALUE THE SAME, OR AN INTEGER IN THE     04958000
      RANGE  LLIM <= N <= ULIM;                                         04960000
<<UPPER AND LOWER LIMITS ARE TREATED AS DOUBLE VALUES FOR>>    <<00550>>04962000
<<RANGE CHECKING.  A ONE WORD LOGICAL VALUE IS RETURNED  >>    <<00550>>04964000
      BEGIN                                                             04966000
        LOGICAL B0:="= ",B1,B2,B3,B4,B5;                                04968000
        BYTE ARRAY BOUTBUF(*) = B0;                                     04970000
        LOGICAL ARRAY OUTBUF(*) = B0;                                   04972000
        INTEGER LEN;                                                    04974000
        DOUBLE DLLIM,DULIM,DVAL;                               <<00550>>04976000
          DLLIM:=DOUBLE(LLIM);  <<DOUBLE VERSION>>             <<00550>>04978000
          DULIM:=DOUBLE(ULIM);  <<DOUBLE VERSION>>             <<00550>>04980000
          DVAL:=DOUBLE(VAL);    <<DOUBLE VERSION>>             <<00550>>04982000
AGAIN:                                                         <<00550>>04984000
          MESSAGE(MESSN);     <<OUTPUT MESSAGE>>               <<00550>>04986000
          LEN:=DASCII(DVAL,10,BOUTBUF(2));<<CONVERT OLD VALUE>><<00550>>04988000
          BOUTBUF(LEN+2) := ".";                                        04990000
          BOUTBUF(X+1) := "?";                                          04992000
          BOUTBUF(X+1) := " ";                                          04994000
          PRINT(OUTBUF,-LEN-5 ,%320);   <<PRINT VALUE>>                 04996000
          READINPUT;                                                    04998000
          TOS:=0D;                                             <<00550>>05000000
          TOS:=@ERROR1;                                        <<00550>>05002000
          TOS:=INVAL(*,",",TRUE);                              <<00550>>05004000
          IF = THEN RETURN;                                             05006000
          IF < THEN GOTO ERROR;                                         05008000
          IF DLLIM <= DS0 AND DS0 <= DULIM THEN                <<00550>>05010000
          BEGIN                                                         05012000
              VAL := TOS;                                               05014000
              RETURN;                                                   05016000
            END;                                                        05018000
ERROR:    DDEL;                                                <<00550>>05020000
  ERROR1: MESSAGE(1);                                                   05022000
          GO AGAIN;                                                     05024000
      END <<GETNEWVAL>> ;                                               05026000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>05028000
          <<--------------------------                                  05030000
            CONVERT ASCII AND EBCDIC                                    05032000
          -------------------------->>                                  05034000
PROCEDURE CONVERT(CODE,INSTRING,OUTSTRING,STRINGLENGTH);                05036000
VALUE CODE,STRINGLENGTH;                                                05038000
INTEGER CODE,STRINGLENGTH;                                              05040000
BYTE ARRAY INSTRING,OUTSTRING;                                          05042000
BEGIN                                                                   05044000
     INTEGER I := -1;                                                   05046000
     ARRAY ASCI(0:255)=PB:=                                             05048000
                                                                        05050000
          << EBCDIC TO ASCII CONVERSION TABLE >>                        05052000
                                                                        05054000
          %000, %001, %002, %003, %000, %011, %000, %177,               05056000
          %000, %000, %000, %013, %014, %015, %016, %017,               05058000
          %020, %021, %022, %023, %000, %000, %010, %000,               05060000
          %030, %031, %000, %000, %034, %035, %036, %037,               05062000
          %000, %000, %000, %000, %000, %012, %027, %033,               05064000
          %000, %000, %000, %000, %000, %005, %006, %007,               05066000
          %000, %000, %026, %000, %000, %000, %000, %004,               05068000
          %000, %000, %000, %000, %024, %025, %000, %032,               05070000
          %040, %000, %000, %000, %000, %000, %000, %000,               05072000
          %000, %000, %133, %056, %074, %050, %053, %041,               05074000
          %046, %000, %000, %000, %000, %000, %000, %000,               05076000
          %000, %000, %135, %044, %052, %051, %073, %136,               05078000
          %055, %057, %000, %000, %000, %000, %000, %000,               05080000
          %000, %000, %174, %054, %045, %137, %076, %077,               05082000
          %000, %000, %000, %000, %000, %000, %000, %000,               05084000
          %000, %140, %072, %043, %100, %047, %075, %042,               05086000
          %000, %141, %142, %143, %144, %145, %146, %147,               05088000
          %150, %151, %000, %000, %000, %000, %000, %000,               05090000
          %000, %152, %153, %154, %155, %156, %157, %160,               05092000
          %161, %162, %000, %000, %000, %000, %000, %000,               05094000
          %000, %176, %163, %164, %165, %166, %167, %170,               05096000
          %171, %172, %000, %000, %000, %000, %000, %000,               05098000
          %000, %000, %000, %000, %000, %000, %000, %000,               05100000
          %000, %000, %000, %000, %000, %000, %000, %000,               05102000
          %173, %101, %102, %103, %104, %105, %106, %107,               05104000
          %110, %111, %000, %000, %000, %000, %000, %000,               05106000
          %175, %112, %113, %114, %115, %116, %117, %120,               05108000
          %121, %122, %000, %000, %000, %000, %000, %000,               05110000
          %134, %000, %123, %124, %125, %126, %127, %130,               05112000
          %131, %132, %000, %000, %000, %000, %000, %000,               05114000
          %060, %061, %062, %063, %064, %065, %066, %067,               05116000
          %070, %071, %000, %000, %000, %000, %000, %000;               05118000
                                                                        05120000
     ARRAY EBCDIC(0:255)=PB:=                                           05122000
                                                                        05124000
          << ASCII TO EBCDIC CONVERSION TABLE >>                        05126000
                                                                        05128000
          %000, %001, %002, %003, %067, %055, %056, %057,               05130000
          %026, %005, %045, %013, %014, %015, %016, %017,               05132000
          %020, %021, %022, %023, %074, %075, %062, %046,               05134000
          %030, %031, %077, %047, %034, %035, %036, %037,               05136000
          %100, %117, %177, %173, %133, %154, %120, %175,               05138000
          %115, %135, %134, %116, %153, %140, %113, %141,               05140000
          %360, %361, %362, %363, %364, %365, %366, %367,               05142000
          %370, %371, %172, %136, %114, %176, %156, %157,               05144000
          %174, %301, %302, %303, %304, %305, %306, %307,               05146000
          %310, %311, %321, %322, %323, %324, %325, %326,               05148000
          %327, %330, %331, %342, %343, %344, %345, %346,               05150000
          %347, %350, %351, %112, %340, %132, %137, %155,               05152000
          %171, %201, %202, %203, %204, %205, %206, %207,               05154000
          %210, %211, %221, %222, %223, %224, %225, %226,               05156000
          %227, %230, %231, %242, %243, %244, %245, %246,               05158000
          %247, %250, %251, %300, %152, %320, %241, %007,               05160000
          %000, %000, %000, %000, %000, %000, %000, %000,               05162000
          %000, %000, %000, %000, %000, %000, %000, %000,               05164000
          %000, %000, %000, %000, %000, %000, %000, %000,               05166000
          %000, %000, %000, %000, %000, %000, %000, %000,               05168000
          %000, %000, %000, %000, %000, %000, %000, %000,               05170000
          %000, %000, %000, %000, %000, %000, %000, %000,               05172000
          %000, %000, %000, %000, %000, %000, %000, %000,               05174000
          %000, %000, %000, %000, %000, %000, %000, %000,               05176000
          %000, %000, %000, %000, %000, %000, %000, %000,               05178000
          %000, %000, %000, %000, %000, %000, %000, %000,               05180000
          %000, %000, %000, %000, %000, %000, %000, %000,               05182000
          %000, %000, %000, %000, %000, %000, %000, %000,               05184000
          %000, %000, %000, %000, %000, %000, %000, %000,               05186000
          %000, %000, %000, %000, %000, %000, %000, %000,               05188000
          %000, %000, %000, %000, %000, %000, %000, %000,               05190000
          %000, %000, %000, %000, %000, %000, %000, %000;               05192000
                                                                        05194000
     CASE * CODE OF                                                     05196000
     BEGIN                                                              05198000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 05200000
          BEGIN     <<CASE 0, CONVERT EBCDIC TO ASCII>>                 05202000
               X := INSTRING(I);                                        05204000
               TOS := ASCI(X);                                          05206000
               OUTSTRING(I) := TOS;                                     05208000
          END;                                                          05210000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 05212000
          BEGIN     <<CASE 1, CONVERT ASCII TO EBCDIC>>                 05214000
               X := INSTRING(I);                                        05216000
               TOS := EBCDIC(X);                                        05218000
               OUTSTRING(I) := TOS;                                     05220000
          END;                                                          05222000
     END;                                                               05224000
END <<CONVERT>>;                                                        05226000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>05228000
                                                                        05230000
          <<------------                                                05232000
            GET STRING                                                  05234000
          ------------>>                                                05236000
  INTEGER PROCEDURE GETSTR(ERRLABEL,ADDR,TERM,SPEC,MAXLEN);             05238000
    VALUE ERRLABEL,TERM,SPEC,MAXLEN;                                    05240000
    BYTE ARRAY ADDR;    <<DESTINATION ARRAY>>                           05242000
    INTEGER ERRLABEL,   <<ERROR RETURN>>                                05244000
            SPEC,       <<ALLOWED SPECIAL CHARACTER>>                   05246000
            MAXLEN,     <<MAX PERMITTED LENGTH>>                        05248000
            TERM;       <<TERMINATING CONTROL                           05250000
                           0 - COMMA ONLY                               05252000
                           1 - CR ONLY                                  05254000
                          -1 - CR OR COMMA(NO INPUT NOT OK)             05256000
                           2 - CR OR COMMA(NO INPUT OK)                 05258000
                           3 - CR ONLY(NO INPUT OK) >>                  05260000
    OPTION PRIVILEGED,UNCALLABLE;                                       05262000
    COMMENT                                                             05264000
      EXTRACTS AN UP-TO-8 CHARACTER STRING FROM THE INPUT BUFFER        05266000
    POINTED TO BY BPINBUF AND MOVES IT TO BYTE ARRAY ADDR. IF AN        05268000
    ERROR IS ENCOUNTERED, IT EXITS TO ERRLABEL.                <<00.04>>05270000
    CONDITION CODE IS SET AS FOLLOWS:                          <<00.04>>05272000
         CCG - FOLLOWED BY CARRIAGE RETURN                              05274000
         CCL - FOLLOWED BY COMMA                               <<00.04>>05276000
         CCE - NO INPUT AND TERMINATING CONTROL=2 OR 3;        <<00.04>>05278000
      BEGIN                                                             05280000
        EQUATE BLANK=%6440;                                             05282000
        INTEGER CONCODE;                                                05284000
          TOS := @ADDR;       <<DESTINATION FOR FINAL MOVE>>            05286000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        05288000
          IF CARRY AND (TERM=3 OR TERM=2)  THEN                         05290000
            BEGIN                                                       05292000
            GETSTR := 0;                                                05294000
            STAT.(6:2) := CCE;                                          05296000
            RETURN;                                                     05298000
            END;                                                        05300000
          IF TERM=2 THEN TERM:=-1 ELSE                                  05302000
          IF TERM=3 THEN TERM:=1;                                       05304000
          IF BPS0<>ALPHA THEN GOTO ERROR;                               05306000
          ASSEMBLE(DUP,DDUP);                                           05308000
  MOVEUP: MOVE * := * WHILE ANS,0;  <<UPSHIFT LOWER CASE>>              05310000
          IF INTEGER(BPS0) = SPEC THEN                                  05312000
            BEGIN                                                       05314000
              IF S0 = S2 THEN GOTO ERROR;                               05316000
              ASSEMBLE(INCA,INCB);   <<BUMP BUFFER POINTERS>>           05318000
              GOTO MOVEUP;                                              05320000
            END;                                                        05322000
          SCAN * WHILE BLANK,1;     <<DELETE TRAILING BLANKS>>          05324000
          IF CARRY THEN CONCODE := CCG                                  05326000
          ELSE IF BPS0="," THEN CONCODE := CCL                          05328000
          ELSE GOTO ERROR;                                              05330000
          IF CONCODE=TERM THEN GOTO ERROR;                              05332000
          STAT.(6:2) := CONCODE;  <<SET CONDITION CODE>>                05334000
          @BPINBUF := TOS+1;  <<UPDATE BUFFER POINTER>>                 05336000
          ASSEMBLE(XCH,SUB; DUP,STAX);  <<COMPUTE LENGTH>>              05338000
          ASSEMBLE(DUP,DUP);                                            05340000
          GETSTR := TOS;   <<LENGTH>>                                   05342000
          IF = OR TOS>MAXLEN THEN                                       05344000
            BEGIN    <<LENGTH OUT OF RANGE>>                            05346000
  ERROR:      MESSAGE(1);                                               05348000
              RETURNP := ERRLABEL;                                      05350000
              ASSEMBLE(EXIT 6);  <<GET RID OF RETURN VALUE>>            05352000
            END;                                                        05354000
          ASSEMBLE(MVB 3);   <<TRANSFER STRING>>                        05356000
          WHILE X < MAXLEN DO                                           05358000
            BEGIN    <<FILL WITH BLANKS>>                               05360000
              ADDR(X) := " ";                                           05362000
              X := X+1;                                                 05364000
            END;                                                        05366000
      END <<GETSTR>> ;                                                  05368000
$PAGE "DEVICE TABLES MANIPULATION PROCEDURES"                           05370000
                                                                        05372000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>05374000
          <<------------------                                          05376000
            GET PHONE NUMBER                                            05378000
          ------------------>>                                          05380000
  INTEGER PROCEDURE GETPHNB(ERRLABEL,ADDR,SPEC);                        05382000
    VALUE ERRLABEL,SPEC;                                                05384000
    INTEGER ERRLABEL,SPEC;                                              05386000
    BYTE ARRAY ADDR;                                                    05388000
      BEGIN                                                             05390000
        EQUATE BLANK=%6440;                                             05392000
        EQUATE SPACE=%40;                                      <<04260>>05394000
        EQUATE DELETE=%177;                                    <<04260>>05396000
        INTEGER CONCODE:=CCG;                                           05398000
          TOS := @ADDR;                                                 05400000
          SCAN BPINBUF WHILE BLANK,1;                                   05402000
          IF CARRY THEN CONCODE:=CCE;                                   05404000
          ASSEMBLE(DUP,DDUP);                                           05408000
  MOVEUPS:MOVE *:=* WHILE ANS,0;  <<UPSHIFT LOWER CASE>>       <<04260>>05410000
          IF INTEGER(BPS0) >= SPACE AND INTEGER(BPS0) < DELETE <<04260>>05412000
            THEN                                               <<04260>>05414000
            BEGIN                                                       05416000
            ASSEMBLE(INCA,INCB);                                        05418000
            GO MOVEUPS;                                                 05420000
            END;                                                        05422000
          SCAN * WHILE BLANK;                                           05424000
          IF NOCARRY  THEN                                              05426000
  ERROR:    BEGIN                                                       05428000
            MESSAGE(1);                                                 05430000
            RETURNP:=ERRLABEL;                                          05432000
            ASSEMBLE(EXIT 4);                                           05434000
            END;                                                        05436000
          ASSEMBLE(XCH,SUB);  <<CALCULATE LENGTH>>                      05438000
          IF S0>30 THEN GO ERROR;                              <<04260>>05440000
          GETPHNB := S0;                                                05442000
          ASSEMBLE(MVB 3);                                              05444000
          STAT.(6:2):=CONCODE;                                          05446000
      END  <<GETPHNB>>;                                                 05448000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>05450000
                                                                        05452000
          <<----------------------------                                05454000
            LIST ADDIIIONAL CS DRIVERS                                  05456000
          ---------------------------->>                                05458000
                                                                        05460000
  PROCEDURE LISTDVRS;                                                   05462000
    BEGIN                                                               05464000
        ARRAY HED(0:10)=PB:="ADDITIONAL CS DRIVERS";                    05466000
        INTEGER I:=-1,J:=0,K,L;                                         05468000
          INBUF := "  ";                                                05470000
          MOVE INBUF(1) := INBUF,(35);                                  05472000
          MOVE INBUF(12) := HED,(11);                                   05474000
          FWRITE(LISTFNUM,INBUF,-47,0);                                 05476000
  LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                         05478000
          L := CTAB0(NUMADVRS);                                         05480000
          WHILE I<L DO                                                  05482000
            BEGIN                                                       05484000
            K:=-1;                                                      05486000
            INBUF := "  ";                                              05488000
            MOVE INBUF(1):=INBUF,(35);                                  05490000
            WHILE (K:=K+1)<=5 AND (I:=I+1)<L DO                         05492000
              MOVE INBUF(K*6):=CSDVR(I*4),(4);                          05494000
            FWRITE(LISTFNUM,INBUF,-72,0);                               05496000
            IF <> THEN GO LISTERR;                                      05498000
            END;                                                        05500000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 05502000
          IF <> THEN GO LISTERR;                                        05504000
    END  <<LISTDVRS>>;                                                  05506000
$CONTROL SEGMENT=IOCHANGE                                      <<03544>>05508000
       <<------------------------------------>>                <<03544>>05510000
       << CHECK FOR SYSTEM-DISC TYPE DEVICES >>                <<03544>>05512000
       <<------------------------------------>>                <<03544>>05514000
LOGICAL PROCEDURE SYSDISC'TYPE( TYPE, SUBTYP);                 <<03544>>05516000
VALUE TYPE, SUBTYP;                                            <<03544>>05518000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03544>>05520000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03544>>05522000
COMMENT                                                        <<03544>>05524000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03544>>05526000
THE GIVEN TYPE AND SUBTYPE IS A VALID SYSTEM-                  <<03544>>05528000
DOMAIN DISC.  IT RETURNS FALSE OTHERWISE.                      <<03544>>05530000
;                                                              <<03544>>05532000
BEGIN                                                          <<03544>>05534000
IF TYPE = DISC0 OR                                             <<03544>>05536000
   TYPE = DISC1 OR                                             <<03544>>05538000
   TYPE = DISC3 AND SUBTYP <> LINUS THEN                       <<03544>>05540000
   SYSDISC'TYPE := TRUE                                        <<03544>>05542000
ELSE                                                           <<03544>>05544000
   SYSDISC'TYPE := FALSE;                                      <<03544>>05546000
END;   << SYSDISC'TYPE >>                                      <<03544>>05548000
$CONTROL SEGMENT=IOCHANGE                                      <<03544>>05550000
        <<----------------------------------->>                <<03544>>05552000
        << CHECK FOR SERIAL-DISC TYPE DEVICE >>                <<03544>>05554000
        <<----------------------------------->>                <<03544>>05556000
LOGICAL PROCEDURE SDISC'TYPE( TYPE, SUBTYP);                   <<03544>>05558000
VALUE TYPE, SUBTYP;                                            <<03544>>05560000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03544>>05562000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03544>>05564000
COMMENT                                                        <<03544>>05566000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03544>>05568000
THE GIVEN TYPE AND SUBTYPE CAN BE A SERIAL DISC.               <<03544>>05570000
IT RETURNS FALSE OTHERWISE.  ALL REMOVABLE DISCS               <<03544>>05572000
EXCEPT THE 7900 CAN BE SERIAL DISCS.                           <<03544>>05574000
;                                                              <<03544>>05576000
BEGIN                                                          <<03544>>05578000
IF TYPE=DISC0 AND (SUBTYP=UH7905 OR SUBTYP=UH7906              <<03544>>05580000
                OR SUBTYP=S7920  OR SUBTYP=S7925 ) OR          <<03544>>05582000
   TYPE=DISC2 OR                                               <<03544>>05584000
   TYPE=DISC3 AND (SUBTYP=S7935 OR SUBTYP=LINUS) THEN          <<03544>>05586000
                                                               <<03544>>05588000
   SDISC'TYPE := TRUE    << IT CAN BE A SERIAL DISC >>         <<03544>>05590000
ELSE                                                           <<03544>>05592000
   SDISC'TYPE := FALSE;  << IT CAN'T BE SERIAL >>              <<03544>>05594000
END;   << SDISC'TYPE >>                                        <<03544>>05596000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>05598000
          <<-----------------                                           05600000
            GET CLASS INDEX                                             05602000
          ----------------->>                                           05604000
  INTEGER PROCEDURE CLINDEX(CLNAME);                                    05606000
    BYTE ARRAY CLNAME;                                                  05608000
    OPTION PRIVILEGED,UNCALLABLE;                                       05610000
      BEGIN                                                             05612000
        INTEGER INDEX := 10,I:=0;                                       05614000
          WHILE (I:=I+1)<=LDT(DCNUM) DO                                 05616000
          IF DVCLTAB(INDEX-10)=CLNAME,(8) THEN                          05618000
            BEGIN   <<FOUND IT>>                                        05620000
              CLINDEX := I;                                             05622000
              RETURN;                                                   05624000
            END                                                         05626000
          ELSE                                                          05628000
            BEGIN   <<BUMP INDEX>>                                      05630000
              TOS := DVCLTAB(INDEX);                                    05632000
              ASSEMBLE(DUP,NOT);                                        05634000
              IF TOS THEN TOS := TOS+1;                                 05636000
              INDEX := TOS+INDEX+11;                                    05638000
            END;                                                        05640000
      END <<CLINDEX>> ;                                                 05642000
$CONTROL SEGMENT=IOCHANGE                                      <<03702>>05644000
          <<------------------------------->>                  <<03702>>05646000
          <<  CHECK INPUT TERMINAL SPEED   >>                  <<03702>>05648000
          <<------------------------------->>                  <<03702>>05650000
LOGICAL PROCEDURE CHECKSPEED( TSPEED, SPEEDCDE );              <<03702>>05652000
INTEGER                                                        <<03702>>05654000
   TSPEED,       << SPEED (CHARS/SEC), PASSED OR RETURNED >>   <<03702>>05656000
   SPEEDCDE;     << BAUDRATE CODE, PASSED OR RETURNED >>       <<03702>>05658000
COMMENT                                                        <<03702>>05660000
THIS PROCEDURE CONVERTS THE TERMINAL SPEED (CHARS/SEC)         <<03702>>05662000
TO ITS INTERNAL BAUD RATE CODE AND VICE-VERSA.                 <<03702>>05664000
IF 'TSPEED' IS NEGATIVE, WE CONVERT 'SPEEDCDE' TO              <<03702>>05666000
CHARS/SEC, RETURNING THE RESULT IN 'TSPEED'.  IF               <<03702>>05668000
'TSPEED' IS POSITIVE, WE CONVERT IT TO THE BAUDRATE            <<03702>>05670000
CODE, RETURNING THE RESULT IN 'SPEEDCDE'.  IN EITHER           <<03702>>05672000
CASE, THE PROCEDURE RETURNS TRUE IF THE CONVERSION WAS         <<03702>>05674000
VALID, FALSE OTHERWISE.                                        <<03702>>05676000
;                                                              <<03702>>05678000
BEGIN                                                          <<03702>>05680000
EQUATE                                                         <<03702>>05682000
   UNUSED  = 32000;    << INDICATES UNUSED SPEED CODE >>       <<03702>>05684000
EQUATE                                                         <<03702>>05686000
   START'III = 0,    << STARTING ARRAY INDEX >>                <<03702>>05688000
   HIGH'III  = 7;    << ENDING ARRAY INDEX   >>                <<03702>>05690000
INTEGER ARRAY                        << ALLOWED SPEEDS FOR >>  <<03702>>05692000
   SPEEDS'III(START'III:HIGH'III) = PB :=                      <<03702>>05694000
   0,240,120,60,30,15,10,14;         << ATC IN CHARS/SEC   >>  <<03702>>05696000
EQUATE                                                         <<03702>>05698000
   START'33 = 6,    << STARTING ARRAY INDEX >>                 <<03702>>05700000
   HIGH'33  = 18;   << ENDING ARRAY INDEX FOR ATP >>           <<03702>>05702000
INTEGER ARRAY                       << ALLOWED SPEEDS FOR  >>  <<03702>>05704000
   SPEEDS'33(START'33:HIGH'33) = PB :=                         <<03702>>05706000
   60,240,960,480,UNUSED,120,       << ADCC, ATP.   (CODES >>  <<03702>>05708000
   UNUSED,30,15,10,1920,3840,180;   << 10,12 ARE NOT USED) >>  <<03702>>05710000
INTEGER                                                        <<03702>>05712000
   I,             << INDEX VAR. >>                             <<03702>>05714000
   STARTSPEED,    << INDEX OF FIRST SPEED >>                   <<03702>>05716000
   HIGHSPEED;     << INDEX OF LAST SPEED  >>                   <<03702>>05718000
INTEGER ARRAY                                                  <<03702>>05720000
   SPEEDS(0:HIGH'33);     << LOCAL ARRAY FOR SPEEDS >>         <<03702>>05722000
                                                               <<03702>>05724000
CHECKSPEED := FALSE;                                           <<03702>>05726000
                                                               <<03702>>05728000
IF SERIESII'III THEN                                           <<03702>>05730000
   BEGIN              << SET UP PARAMETERS FOR ATC SPEEDS >>   <<03702>>05732000
   STARTSPEED := START'III;                                    <<03702>>05734000
   HIGHSPEED := HIGH'III;                                      <<03702>>05736000
   MOVE SPEEDS(START'III) :=                                   <<03702>>05738000
        SPEEDS'III(START'III),(HIGH'III - START'III + 1);      <<03702>>05740000
   END                                                         <<03702>>05742000
                                                               <<03702>>05744000
ELSE                                                           <<03702>>05746000
   BEGIN         << SET UP PARAMETERS FOR ADCC, ATP SPEEDS >>  <<03702>>05748000
   STARTSPEED := START'33;                                     <<03702>>05750000
   HIGHSPEED := HIGH'33;                                       <<03702>>05752000
   MOVE SPEEDS(START'33) :=                                    <<03702>>05754000
        SPEEDS'33(START'33),(HIGH'33 - START'33 + 1);          <<03702>>05756000
   END;                                                        <<03702>>05758000
                                                               <<03702>>05760000
IF TSPEED < 0 THEN                                             <<03702>>05762000
   BEGIN   << CONVERT FROM BAUDRATE CODE TO CHARS/SEC >>       <<03702>>05764000
   IF STARTSPEED <= SPEEDCDE <= HIGHSPEED THEN                 <<03702>>05766000
      BEGIN                                                    <<03702>>05768000
      TSPEED := SPEEDS(SPEEDCDE);                              <<03702>>05770000
      IF TSPEED < UNUSED THEN                                  <<03702>>05772000
         CHECKSPEED := TRUE;                                   <<03702>>05774000
      END;                                                     <<03702>>05776000
   END                                                         <<03702>>05778000
                                                               <<03702>>05780000
ELSE                                                           <<03702>>05782000
   BEGIN   << CONVERT FROM CHARS/SEC TO BAUDRATE CODE >>       <<03702>>05784000
   I := STARTSPEED - 1;                                        <<03702>>05786000
   WHILE (I:=I+1) <= HIGHSPEED DO    << COMPARE AGAINST >>     <<03702>>05788000
      IF SPEEDS(I) = TSPEED THEN     <<    ALL SPEEDS   >>     <<03702>>05790000
         BEGIN      << VALID SPEED >>                          <<03702>>05792000
         SPEEDCDE  := I;                                       <<03702>>05794000
         CHECKSPEED := TRUE;                                   <<03702>>05796000
         END;                                                  <<03702>>05798000
   END;                                                        <<03702>>05800000
END;   << CHECKSPEED >>                                        <<03702>>05802000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>05804000
                                                                        05806000
          <<-----------------                                           05808000
            LIST CS DEVICES                                             05810000
          ----------------->>                                           05812000
                                                                        05814000
  PROCEDURE LISTCSDEV;                                                  05816000
    BEGIN                                                               05818000
     ARRAY GENHED1(0:35)=PB:=                                           05820000
      "LDN PM PRT LCL TC  RCV   LCL   CON  MODE   TRANSMIT ",           05822000
      " TM BUFFER D DRIVER ";                                           05824000
     ARRAY GENHED2(0:35)=PB:=                                           05826000
      "           MOD    TMOUT TMOUT TMOUT          SPEED    ",         05828000
      "   SIZE  C OPTIONS";                                             05830000
     ARRAY SWHED1(0:23)=PB:=                                            05832000
      "LDN CTRL  PHONE NUMBER LIST    LOCAL ID SEQUENCE";               05834000
     ARRAY SWHED2(0:26)=PB:=                                            05836000
      "     LEN                          REMOTE ID SEQUENCES ";         05838000
     ARRAY NSWHED1(0:25)=PB:=                                           05840000
      "LDN INCOM POLL   CIR  C/S NUM C P COMPONENT SEQUENCE";           05842000
     ARRAY NSWHED2(0:16)=PB:=                                           05844000
      "    DELAY REPET DELAY     COM T L ";                             05846000
     LOGICAL SWTCHED:=FALSE,NONSWTCHED:=FALSE,REMOTE:=FALSE;            05848000
     ARRAY BUFR(0:35);                                                  05850000
     BYTE POINTER PHONE,IDLIST,CNTRLSEQ=PHONE;                          05852000
     INTEGER I,J,N,TEMP,PHINX,IDINX,LEN,CINX=PHINX;                     05854000
     INTEGER K,START,TYPE,LEN1,NUMS,NUMP;                               05856000
     EQUATE  QUOT   = %42,                                              05858000
             ATYP   = 0,                                                05860000
             ETYP   = 1,                                                05862000
             OTYP   = 2,                                                05864000
             HTYP   = 3;                                                05866000
     BYTE ARRAY OUTTEMP(0:71),OCTDIGIT(0:5);                            05868000
     INTEGER POINTER CONTROL;                                           05870000
                                                                        05872000
  SUBROUTINE OCTTOASCI(INSTRING,OUTSTRING,LENGTH);                      05874000
     INTEGER LENGTH;                                                    05876000
     BYTE ARRAY INSTRING,OUTSTRING;                                     05878000
       BEGIN                                                            05880000
       MOVE OUTSTRING := "O(";                                          05882000
       I := -1;                                                         05884000
       J := 2;                                                          05886000
       WHILE(I:=I+1)<LENGTH DO                                          05888000
         BEGIN                                                          05890000
         TOS := ASCII(INSTRING(I),8,OCTDIGIT);                          05892000
         K := TOS;                                                      05894000
         MOVE OUTSTRING(J):=OCTDIGIT(6-K),(K);                          05896000
         TOS := J+K;                                                    05898000
         J := S0+1;                                                     05900000
         X := TOS;                                                      05902000
         OUTSTRING(X) := ",";                                           05904000
         END;                                                           05906000
       OUTSTRING(X) := ")";                                             05908000
       LENGTH := J;                                                     05910000
       END;  <<OCTTOASCI>>                                              05912000
                                                                        05914000
  SUBROUTINE HEXTOASCI(INSTRING,OUTSTRING,LENGTH);                      05916000
    INTEGER LENGTH;                                                     05918000
    BYTE ARRAY INSTRING,OUTSTRING;                                      05920000
      BEGIN                                                             05922000
      MOVE OUTSTRING := "H(";                                           05924000
      I := -1;                                                          05926000
      J := 2;                                                           05928000
      WHILE(I:=I+1)<LENGTH DO                                           05930000
        BEGIN                                                           05932000
        TOS := INSTRING(I);                                             05934000
        TOS := %20;                                                     05936000
        ASSEMBLE(DIV);                                                  05938000
        IF S1=0 THEN                                                    05940000
          BEGIN  <<ONE HEX DIGIT>>                                      05942000
          X := TOS;                                                     05944000
          DEL;                                                          05946000
          OUTSTRING(J) := HEX(X);                                       05948000
          J := J+1;                                                     05950000
          END                                                           05952000
        ELSE                                                            05954000
          BEGIN                                                         05956000
          ASSEMBLE(XCH);                                                05958000
          X := TOS;                                                     05960000
          K := TOS;                                                     05962000
          OUTSTRING(J) := HEX(X);                                       05964000
          J := J+1;                                                     05966000
          OUTSTRING(J) := HEX(K);                                       05968000
          J := J+1;                                                     05970000
          END;                                                          05972000
        OUTSTRING(J) := ",";                                            05974000
        J := J+1;                                                       05976000
        END;                                                            05978000
      OUTSTRING(X) := ")";                                              05980000
      LENGTH := J;                                                      05982000
      END;   <<HEXTOASCI>>                                              05984000
                                                                        05986000
          MOVE INBUF := GENHED1,(36);                                   05988000
          FWRITE(LISTFNUM,INBUF,-72,0);                                 05990000
  LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                         05992000
          MOVE INBUF := GENHED2,(36);                                   05994000
          FWRITE(LISTFNUM,INBUF,-72,0);                                 05996000
          IF <> THEN GO LISTERR;                                        05998000
          LDEV:=0;                                                      06000000
          WHILE(LDEV:=LDEV+1)<=HLDEV DO                                 06002000
            BEGIN                                                       06004000
            @LDTENT := @LDT+LDEV*LDTSIZE;                               06006000
            IF CSDEVICE THEN                                   <<01165>>06008000
              BEGIN  <<CS DEVICE>>                                      06010000
              @LPDTENT := @LPDT+LDEV&LSL(1);                            06012000
              INBUF := "  ";                                            06014000
              MOVE INBUF(1):=INBUF,(35);  <<BLANK BUFFER>>              06016000
              ASCII(LDEV,10,BINBUF);   <<LOGICAL DEVICE #>>             06018000
              N := CSDEF(LDEV);                                         06020000
              @CSLDTX := @CSTAB+CSXSTART;                               06022000
              I:=-1;                                                    06024000
              WHILE(I:=I+1)<N DO  <<FIND CSLDTX ENTRY>>                 06026000
                @CSLDTX := @CSLDTX+CSLDTX;                              06028000
              ASCII(CSLDTXHSI'CHAN,10,BINBUF(4));<<PORT MASK>>          06030000
              IF LDTENT(LDT2).TYP=CSDEV17 THEN                 <<01165>>06032000
                BEGIN                                          <<01165>>06034000
                BINBUF(7):="X"; BINBUF(12):="X";               <<01165>>06036000
                BINBUF(15):="X";                               <<01165>>06038000
                END                                            <<01165>>06040000
              ELSE                                             <<01165>>06042000
                BEGIN                                          <<01165>>06044000
              ASCII(CSLDTXPROTOCOL,10,BINBUF(7)); <<PROTOCOL>>          06046000
              ASCII(CSLDTXMODE,10,BINBUF(12)); <<LOCAL MODE>>           06048000
              ASCII(CSLDTXCODE,10,BINBUF(15));  <<TRANSMISSION CODE>>   06050000
                END;                                           <<01165>>06052000
              ASCII(CSLDTXRECV'TIMEOUT,10,BINBUF(18));                  06054000
                                 <<RECEIVE TIMEOUT>>                    06056000
              ASCII(CSLDTXLOCAL'TIMEOUT,10,BINBUF(24));                 06058000
                                 <<LOCAL TIMEOUT>>                      06060000
              ASCII(CSLDTXCONCT'TIMEOUT,10,BINBUF(30));                 06062000
                                 <<CONNECT TIMEOUT>>                    06064000
              IF LOGICAL(CSLDTXDIAL) THEN BINBUF(36):="O";              06066000
              IF 1<=CSLDTXANSWER<=2 THEN BINBUF(37):="I";               06068000
              IF CSLDTXANSWER=AUTOANSWER THEN BINBUF(38):="A";          06070000
              IF LOGICAL(CSLDTXDUAL'SPEED) THEN                         06072000
                BEGIN                                                   06074000
                BINBUF(39) := "D";                                      06076000
                IF LOGICAL(CSLDTXHALF'SPEED) THEN BINBUF(40):="H";      06078000
                END;                                                    06080000
              IF LOGICAL(CSLDTXSPEEDCHNGBLE) THEN BINBUF(41):="C";      06082000
              DASCII(CSLDTXINSPEED,10,BINBUF(43));                      06084000
              ASCII(CSLDTXXMSNMODE,10,BINBUF(54));                      06086000
              ASCII(CSLDTXPBUFFSIZE,10,BINBUF(57));                     06088000
              IF LOGICAL(CSLDTXDVRCHANGABLE) THEN BINBUF(63):="Y"       06090000
                ELSE BINBUF(63):="N";                                   06092000
              ASCII(CSLDTXDOPTIONS,10,BINBUF(66));                      06094000
              FWRITE(LISTFNUM,INBUF,-72,0);                             06096000
              IF <> THEN GO LISTERR;                                    06098000
              IF SWITCHED THEN SWTCHED:=TRUE                            06100000
                ELSE IF NONSWITCHED AND SUPERVISED                      06102000
                     THEN NONSWTCHED:=TRUE;                             06104000
              END;                                                      06106000
            END;                                                        06108000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 06110000
          IF <> THEN GO LISTERR;                                        06112000
          IF SWTCHED THEN                                               06114000
            BEGIN  <<SWITCHED DEVICES PRESENT>>                         06116000
            MOVE INBUF:=SWHED1,(24);                                    06118000
            FWRITE(LISTFNUM,INBUF,-48,0);                               06120000
            IF <> THEN GO LISTERR;                                      06122000
            MOVE INBUF:=SWHED2,(26);                                    06124000
            FWRITE(LISTFNUM,INBUF,-52,0);                               06126000
            IF <> THEN GO LISTERR;                                      06128000
            LDEV := 0;                                                  06130000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               06132000
              IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN      06134000
                IF LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE=0 THEN               06136000
                  BEGIN   <<SWITCHED DEVICE>>                           06138000
                  INBUF := "  ";                                        06140000
                  MOVE INBUF(1):=INBUF,(35);                            06142000
                  ASCII(LDEV,10,BINBUF);                                06144000
                  @CSLDTX := @CSTAB+CSXSTART;                           06146000
                  I:=-1;                                                06148000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          06150000
                    @CSLDTX := @CSLDTX+CSLDTX;                          06152000
                  ASCII(0,10,BINBUF(4));<<CONTROL SIZE>>       <<00.06>>06154000
                  IF CSLDTXPHLISTPTR<>0 THEN                            06156000
                    BEGIN <<POINT TO PHONE LIST>>                       06158000
                    @PHONE:=(@CSLDTX+CSLDTXPHLISTPTR)&LSL(1);  <<03704>>06160000
                                    <<BYTE POINTER TO PHONE LIST>>      06162000
                    NUMP := PHONE(NUMSEQ);  <<# OF PHONE SEQUENCES>>    06164000
                    END                                                 06166000
                  ELSE NUMP:=0;                                         06168000
                  IF CSLDTXIDLISTPTR<>0 THEN                            06170000
                    BEGIN                                               06172000
                    @IDLIST :=(@CSLDTX+CSLDTXIDLISTPTR)&LSL(1);<<03704>>06174000
                              <<BYTE POINTER TO ID LIST>>               06176000
                    NUMS := IDLIST(NUMSEQ);   <<# OF ID SEQUENCES>>     06178000
                    END                                                 06180000
                  ELSE NUMS:=0;                                         06182000
                  TEMP := 0;                                            06184000
                  PHINX:=IDINX:=3;                                      06186000
                  WHILE((NUMP>0) OR (NUMS>0)) DO                        06188000
                    BEGIN  <<MORE SEQUENCES OR A CONTINUATION>>         06190000
                    IF NUMP>0 THEN                                      06192000
                      BEGIN      <<MORE PHONE SEQUENCES>>               06194000
                      MOVE BINBUF(10):=PHONE(PHINX+1),(PHONE(PHINX));   06196000
                      PHINX:=PHINX+INTEGER(PHONE(PHINX))+1;             06198000
                      NUMP := NUMP-1;                                   06200000
                      END;                                              06202000
                    IF NUMS>0 OR TEMP>0 THEN                            06204000
                      BEGIN      <<MORE ID SEQUENCES>>                  06206000
                      IF TEMP>0 THEN                                    06208000
                        BEGIN <<CONTINUATION OF SEQUENCE>>              06210000
                        N:=(IF REMOTE THEN 35 ELSE 32);                 06212000
                        START := LEN;                                   06214000
                        LEN := TEMP;                                    06216000
                        TEMP := 0;                                      06218000
                        NUMS := NUMS-1;                                 06220000
                        REMOTE := TRUE;                                 06222000
                        END                                             06224000
                      ELSE                                              06226000
                        BEGIN <<NEW SEQUENCES>>                         06228000
                        START := 0;                                     06230000
                        TOS := IDLIST(IDINX);                           06232000
                        DUPLICATE;                                      06234000
                        TOS := TOS LAND %77;                            06236000
                        LEN := S0;                                      06238000
                        LEN1 := TOS;                                    06240000
                        TYPE := TOS&LSR(6);                             06242000
                        IF TYPE=OTYP THEN OCTTOASCI                     06244000
                           (IDLIST(IDINX+1),OUTTEMP,LEN)                06246000
                        ELSE IF TYPE=HTYP THEN HEXTOASCI                06248000
                                (IDLIST(IDINX+1),OUTTEMP,LEN)           06250000
                             ELSE                                       06252000
                               BEGIN                                    06254000
                               IF TYPE=ETYP THEN                        06256000
                                 BEGIN                                  06258000
                                 OUTTEMP := "E";                        06260000
                                 CONVERT(0,IDLIST(IDINX+1),             06262000
                                         OUTTEMP(2),LEN);               06264000
                                 END                                    06266000
                               ELSE                                     06268000
                                 BEGIN                                  06270000
                                 OUTTEMP := "A";                        06272000
                                 MOVE OUTTEMP(2):=IDLIST                06274000
                                      (IDINX+1),(LEN);                  06276000
                                 END;                                   06278000
                               OUTTEMP(1):=OUTTEMP(LEN+2):=QUOT;        06280000
                               LEN := LEN+3;                            06282000
                               END;                                     06284000
                        IDINX := IDINX+LEN1+1;                          06286000
                        IF REMOTE THEN                                  06288000
                          BEGIN                                         06290000
                          N := 34;                                      06292000
                          IF LEN>38 THEN                                06294000
                            BEGIN                                       06296000
                            TEMP := LEN-38;                             06298000
                            LEN := 38;                                  06300000
                            END                                         06302000
                          ELSE NUMS:=NUMS-1;                            06304000
                          END                                           06306000
                        ELSE                                            06308000
                          BEGIN <<LOCAL>>                               06310000
                          N := 31;                                      06312000
                          IF LEN>41 THEN                                06314000
                            BEGIN                                       06316000
                            TEMP := LEN-41;                             06318000
                            LEN := 41;                                  06320000
                            END                                         06322000
                          ELSE                                          06324000
                            BEGIN                                       06326000
                            NUMS := NUMS-1;                             06328000
                            REMOTE := TRUE;                             06330000
                            END;                                        06332000
                          END;                                          06334000
                        END; <<NEW SEQUENCES>>                          06336000
                      MOVE BINBUF(N):=OUTTEMP(START),(LEN);             06338000
                      END;<<MORE ID SEQUENCES>>                         06340000
                    FWRITE(LISTFNUM,INBUF,-72,0);                       06342000
                    IF <> THEN GOTO LISTERR;                            06344000
                    INBUF := "  ";                                      06346000
                    MOVE INBUF(1) := INBUF,(35);                        06348000
                    END;<<MORE SEQUENCES OR A CONTIUATION>>             06350000
                  REMOTE := FALSE; <<FINISHED WITH DEVICE>>             06352000
                  IF CSLDTXPHLISTPTR=CSLDTXIDLISTPTR THEN               06354000
                    BEGIN <<NO PHONE #'S OR ID SEQUENCES>>              06356000
                    FWRITE(LISTFNUM,INBUF,-72,0);                       06358000
                    IF <> THEN GO LISTERR;                              06360000
                    END;                                                06362000
                  END; <<SWITCHED DEVICE>>                              06364000
            FWRITE(LISTFNUM,INBUF,0,%61);                               06366000
            IF<> THEN GO LISTERR;                                       06368000
            END; <<SWITCHED DEVICES PRESENT>>                           06370000
          IF NONSWTCHED THEN                                            06372000
            BEGIN                                                       06374000
            MOVE  INBUF:=NSWHED1,(26);                                  06376000
            FWRITE(LISTFNUM,INBUF,-52,0);                               06378000
            IF <> THEN GO LISTERR;                                      06380000
            MOVE INBUF:=NSWHED2,(17);                                   06382000
            FWRITE(LISTFNUM,INBUF,-33,0);                               06384000
            IF <> THEN GO LISTERR;                                      06386000
            INBUF := "  ";                                              06388000
            MOVE INBUF(1):=INBUF,(35);                                  06390000
            LDEV := 0;                                                  06392000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               06394000
              IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN      06396000
                IF LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE<>0 THEN              06398000
                  BEGIN  <<NONSWITCHED DEVICE>>                         06400000
                  @CSLDTX := @CSTAB+CSXSTART;                           06402000
                  I:=-1;                                                06404000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          06406000
                    @CSLDTX := @CSLDTX+CSLDTX;                          06408000
                  IF NOT(SUPERVISED) THEN GOTO NEXTNSW;                 06410000
                  TOS := @CSLDTX+CSLDTXCONTPTR;                         06412000
                  @CONTROL  := S0;                                      06414000
                  IF CONTROLST THEN @CNTRLSEQ :=               <<03704>>06416000
                     (TOS+CONSEQSTART)&LSL(1)                  <<03704>>06418000
                  ELSE @CNTRLSEQ:=(TOS+1)&LSL(1); <<TRIBUTARY>><<03704>>06420000
                  CINX := 0;                                            06422000
                  ASCII(LDEV,10,BINBUF);                                06424000
                  IF TRIBUTARY THEN                                     06426000
                    BEGIN                                               06428000
                    ASCII(N:=CONTROL.(8:8),10,BINBUF(26));              06430000
                    GO AROUND;                                          06432000
                    END;                                                06434000
                  ASCII(CONTROL(INTCOMDELAY),10,BINBUF(4));             06436000
                  ASCII(CONTROL,10,BINBUF(10));                         06438000
                  ASCII(CONTROL(CIRPDELAY),10,BINBUF(16));              06440000
                  TOS := 0;                                             06442000
                  TOS:=(CONTROL(NUMCOMP)+CONTROL(REMOSTAT)-1)/          06444000
                        CONTROL(REMOSTAT);                              06446000
                  ASCII(*,10,BINBUF(22));                               06448000
                  ASCII((N:=CONTROL(NUMCOMP)),10,BINBUF(26));           06450000
  AROUND:         NUMS := 0;                                            06452000
                  WHILE(NUMS:=NUMS+1)<=N DO                             06454000
                    BEGIN                                               06456000
                    TOS:=0;                                             06458000
                    TOS := CNTRLSEQ(CINX); <<SEQUENCE TYPE>>            06460000
                    TOS := TOS LAND 3;                                  06462000
                    ASCII(*,10,BINBUF(30));                             06464000
                    TOS := CNTRLSEQ(CINX);                              06466000
                    TOS:=TOS&LSR(2);                                    06468000
                    IF TOS>0 THEN BINBUF(32):="Y"                       06470000
                      ELSE BINBUF(32):="N";                             06472000
                    TOS := CNTRLSEQ(CINX+1);                            06474000
                    DUPLICATE;                                          06476000
                    TYPE := TOS&LSR(6);                                 06478000
                    TOS := TOS LAND %77;                                06480000
                    LEN1 := LEN := TOS;                                 06482000
                    IF TYPE=OTYP THEN OCTTOASCI                         06484000
                       (CNTRLSEQ(CINX+2),BINBUF(34),LEN)                06486000
                    ELSE IF TYPE=HTYP THEN HEXTOASCI                    06488000
                            (CNTRLSEQ(CINX+2),BINBUF(34),LEN)           06490000
                         ELSE                                           06492000
                           BEGIN                                        06494000
                           IF TYPE=ETYP THEN                            06496000
                             BEGIN                                      06498000
                             BINBUF(34) := "E";                         06500000
                             CONVERT(0,CNTRLSEQ(CINX+2),                06502000
                                     BINBUF(36),LEN);                   06504000
                             END                                        06506000
                           ELSE                                         06508000
                             BEGIN                                      06510000
                             BINBUF(34) := "A";                         06512000
                             MOVE BINBUF(36):=                          06514000
                                  CNTRLSEQ(CINX+2),(LEN);               06516000
                             END;                                       06518000
                           BINBUF(35):=BINBUF(LEN+36):=QUOT;            06520000
                           END;                                         06522000
                    CINX:=CINX+LEN1+2;                                  06524000
                    FWRITE(LISTFNUM,INBUF,-72,0);                       06526000
                    IF<> THEN GO LISTERR;                               06528000
                    INBUF:="  ";                                        06530000
                    MOVE INBUF(1):=INBUF,(35);                          06532000
                    END;                                                06534000
  NEXTNSW:        END;                                                  06536000
            FWRITE(LISTFNUM,INBUF,0,%61);                               06538000
            IF <> THEN GO LISTERR;                                      06540000
            END;                                                        06542000
          END <<LISTCSDEV>>;                                            06544000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>06546000
                                                                        06548000
          <<----------------                                            06550000
            GET CLASS NAME                                              06552000
          ---------------->>                                            06554000
  PROCEDURE CLNAME(CLINDEX,NAME);                                       06556000
    VALUE CLINDEX;                                                      06558000
    INTEGER CLINDEX;                                                    06560000
    BYTE ARRAY NAME;                                                    06562000
    OPTION PRIVILEGED,UNCALLABLE;                                       06564000
      BEGIN                                                             06566000
        INTEGER I:=0;                                                   06568000
          X := 10;                                                      06570000
          WHILE (I:=I+1) < CLINDEX DO                                   06572000
            BEGIN                                                       06574000
              TOS := DVCLTAB(X);                                        06576000
              ASSEMBLE(DUP,NOT);                                        06578000
              IF TOS THEN TOS := TOS+1;                                 06580000
              X := TOS+X+11;                                            06582000
            END;                                                        06584000
          MOVE NAME := DVCLTAB(X-10),(8);                               06586000
      END <<CLNAME>> ;                                                  06588000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>06590000
                                                                        06592000
   <<--------------                                                     06594000
     LIST CLASSES                                                       06596000
   -------------->>                                                     06598000
   PROCEDURE LISTCLASSES;                                               06600000
   <<LISTS DEVICE CLASSES FOLLOWED CLASS TYPE AND LOGICAL DEV. #'S>>    06602000
     BEGIN                                                              06604000
       EQUATE SDISC = 31; <<CLASS ACCESS TYPE FOR SERIAL DISC>><<SD.00>>06606000
       EQUATE FDISC = 7;  <<FOREIGN DISC CLASS ACCESS TYPE>>   <<01115>>06608000
       INTEGER ARRAY HED1(0:13)=PB:=                                    06610000
           "  CLASS     ACCESS  LOGICAL ";                              06612000
       INTEGER ARRAY HED2(0:13)=PB:=                                    06614000
           "  NAME      TYPE    DEVICES ";                              06616000
       INTEGER INDEX:=10,BINDX:=20;                                     06618000
          MOVE INBUF := HED1,(14);                                      06620000
          FWRITE(LISTFNUM,INBUF,-27,0);                                 06622000
   LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                        06624000
          MOVE INBUF := HED2,(14);                                      06626000
          FWRITE(LISTFNUM,INBUF,-27,0);                                 06628000
          IF <> THEN GO LISTERR;                                        06630000
          I := -1;                                                      06632000
          WHILE (I:=I+1)<LDT(DCNUM) DO                                  06634000
            BEGIN                                                       06636000
            INBUF := "  ";                                              06638000
            MOVE INBUF(1):=INBUF,(35);                                  06640000
            MOVE BINBUF:= DVCLTAB(INDEX-10),(8);                        06642000
            TOS := DVCLTAB(INDEX-1);<<CLASS ACCESS TYPE & TERMACC BIT>> 06644000
            DUPLICATE;                                                  06646000
            TOS := TOS LAND 7;                                          06648000
            IF TOS<>0 THEN                                              06650000
              BEGIN <<ALL DEVICES ARE OF SAME TYPE>>                    06652000
              IF S0=SDISC THEN                                 <<SD.00>>06654000
                 BEGIN                                         <<SD.00>>06656000
                 DEL;                                          <<SD.00>>06658000
                 MOVE BINBUF(12):="SD";                        <<SD.00>>06660000
                 END                                           <<SD.00>>06662000
              ELSE                                             <<SD.00>>06664000
              IF S0=FDISC THEN                                 <<01115>>06666000
                 BEGIN                                         <<01115>>06668000
                 DEL;                                          <<01115>>06670000
                 MOVE BINBUF(12):="FD";                        <<01115>>06672000
                 END                                           <<01115>>06674000
              ELSE                                             <<01115>>06676000
                 BEGIN                                         <<SD.00>>06678000
                 ASSEMBLE(ZERO,XCH);                           <<SD.00>>06680000
                 ASCII(*,10,BINBUF(12));                       <<SD.00>>06682000
                 END;                                          <<SD.00>>06684000
              END                                                       06686000
            ELSE                                                        06688000
              BEGIN                                                     06690000
              TOS := (TOS LAND %77)&LSR(3);<<CLEAR TERMACC BIT>>        06692000
              CASE TOS OF                                               06694000
                BEGIN                                                   06696000
                MOVE BINBUF(12):="DA";                                  06698000
                MOVE BINBUF(12):="IN";                                  06700000
                MOVE BINBUF(12):="I/O,C";                               06702000
                MOVE BINBUF(12):="I/O,NC";                              06704000
                MOVE BINBUF(12):="OUT";                                 06706000
                END;                                                    06708000
              END;                                                      06710000
            IF (N:=(INTEGER(DVCLTAB(INDEX))))<>0 THEN                   06712000
              BEGIN                                                     06714000
              K := 0;                                                   06716000
              WHILE (K:=K+1)<=N DO                                      06718000
                BEGIN                                                   06720000
                LDEV := INTEGER(DVCLTAB(INDEX+K));                      06722000
                IF (LDEV>99) AND (BINDX>69) OR                          06724000
                   (LDEV>9) AND (BINDX>70) OR (BINDX>71)                06726000
                THEN                                                    06728000
                  BEGIN <<WON'T FIT ON THIS LINE>>                      06730000
                  FWRITE(LISTFNUM,INBUF,-72,0);                         06732000
                  IF<>THEN GO LISTERR;                                  06734000
                  BINDX := 20;                                          06736000
                  INBUF := "  ";                                        06738000
                  MOVE INBUF(1):=INBUF,(35);                            06740000
                  END;                                                  06742000
                M := ASCII(LDEV,10,BINBUF(BINDX));                      06744000
                BINDX := BINDX + M;                                     06746000
                IF K<N THEN                                             06748000
                  BEGIN                                                 06750000
                  BINBUF(BINDX) := ",";                                 06752000
                  BINDX :=BINDX+1;                                      06754000
                  END;                                                  06756000
                END;                                                    06758000
              FWRITE(LISTFNUM,INBUF,-BINDX,0);                          06760000
              IF <> THEN GO LISTERR;                                    06762000
              END;                                                      06764000
            TOS := N;                                                   06766000
            ASSEMBLE(DUP,NOT);                                          06768000
            IF TOS THEN TOS:=TOS+1;                                     06770000
            INDEX := TOS+INDEX+11;                                      06772000
            BINDX := 20;                                                06774000
            END;                                                        06776000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 06778000
          IF <> THEN GO LISTERR;                                        06780000
     END  <<LISTCLASSES>>;                                              06782000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>06784000
                                                                        06786000
          <<-----------------                                           06788000
            LIST I/O DEVICES                                            06790000
          ------------------>>                                          06792000
  PROCEDURE LISTIODEV;                                                  06794000
    OPTION PRIVILEGED,UNCALLABLE;                                       06796000
    COMMENT                                                             06798000
      PRINTS A LISTING OF THE I/O DEVICE CONFIGURATION ON THE JOB       06800000
    LIST DEVICE;                                                        06802000
      BEGIN                                                             06804000
        INTEGER ARRAY HEAD1(0:34)=PB:=                                  06806000
         "LOG DRT U  C T SUB              REC   OUTPUT ",      <<03007>>06808000
         " MODE   DRIVER   DEVICE ";                                    06810000
        INTEGER ARRAY HEAD2(0:35)=PB:=                                  06812000
         "DEV  #  N  H Y TYPE  TERMINAL   WIDTH  DEV ",        <<03007>>06814000
         "           NAME    CLASSES ";                                 06816000
        INTEGER ARRAY HEAD3(0:15)=PB:=                         <<03007>>06818000
         " #      I  A P      TYPE SPEED  ";                   <<03702>>06820000
        INTEGER ARRAY HEAD4(0:6)=PB:=                          <<00.06>>06822000
         "        T  N E";                                     <<00.06>>06824000
        INTEGER TSPEED,                                        <<03702>>06828000
                SPEEDCDE;                                      <<03702>>06830000
        LOGICAL FIRSTCLASS;                                             06832000
        INTEGER I;                                             <<02509>>06834000
           MOVE INBUF := HEAD1,(35);                                    06836000
           FWRITE(LISTFNUM,INBUF,-69,0);                                06838000
  LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                         06840000
           MOVE INBUF := HEAD2,(35);                                    06842000
           FWRITE(LISTFNUM,INBUF,-70,0);                                06844000
          IF <> THEN GOTO LISTERR;                                      06846000
          MOVE INBUF := HEAD3,(16);                            <<03007>>06848000
          FWRITE(LISTFNUM,INBUF,-32,0);                        <<03007>>06850000
          IF <> THEN GOTO LISTERR;                             <<00.06>>06852000
          MOVE INBUF:=HEAD4,(7);                               <<00.06>>06854000
          FWRITE(LISTFNUM,INBUF,-14,0);                        <<00.06>>06856000
          IF <> THEN GOTO LISTERR;                             <<00.06>>06858000
          LDEV:=0;                                                      06860000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              06862000
          IF (DRTN:=DVRTAB(LDEV*DVRSIZE))<>0 OR                <<03006>>06864000
              DVRTAB(LDEV*DVRSIZE+1).DSBIT=1 <<DS DEV>>        <<03006>>06866000
          THEN BEGIN                                           <<03006>>06868000
              @DVRENT:=@DVRTAB(LDEV*DVRSIZE);                  <<03006>>06870000
              @LDTENT := @LDT(LDEV*LDTSIZE);                            06872000
              @LPDTENT := @LPDT(LDEV*LPDTSIZE);                         06874000
              @LDTXENT:=@LDTX(LDEV*LDTXSIZE);                  <<00.06>>06876000
              INBUF:="  ";                                              06878000
              MOVE INBUF(1) := INBUF,(35);   <<BLANK OUT BUFFER>>       06880000
              ASCII(LDEV,10,BINBUF);  <<LOGICAL DEVICE #>>              06882000
              IF DVRENT(DVR1).DSBIT=1  THEN                    <<03006>>06884000
                BEGIN  <<DS DEVICE>>                                    06886000
                BINBUF(3) := "#";                                       06888000
                ASCII(DVRENT(DVR1).DSDRTN,10,BINBUF(4));                06890000
                END                                                     06892000
              ELSE ASCII(DRTN.DRTFIELD,10,BINBUF(4)); <<DRT #>><<03006>>06894000
              ASCII(DRTN.UNITFIELD,10,BINBUF(8));   <<UNIT #>> <<03006>>06896000
              ASCII(DVRENT(DVR1).DVRCHAN,10,BINBUF(11));<<CHANNEL#>>    06898000
              ASCII(LDTENT(LDT2).TYP,10,BINBUF(13));<<TYPE>>   <<00.06>>06900000
              ASCII(LPDTENT(LPDT1).SUBTYPE,10,BINBUF(16));<<SUBTYPE>>   06902000
              I := LPDTENT(LPDT1).SUBTYPE;  <<DEV. SUBTYPE>>   <<03007>>06904000
              IF LDTENT(LDT2).TYP = TERMDEVTYPE OR             <<03007>>06906000
                 LDTENT(LDT2).TYP = 32 AND                     <<03007>>06908000
                 ( I=14 OR I=15) THEN                          <<03007>>06910000
                BEGIN <<TERMINAL>>                             <<00.06>>06912000
                IF LDTENT(LDT4).TERMTYP=%37 THEN               <<00.06>>06914000
                  MOVE BINBUF(21) := "??"                      <<03702>>06916000
                ELSE ASCII(LDTENT(LDT4).TERMTYP,10,BINBUF(21));<<03702>>06918000
                SPEEDCDE := LDTXENT.TERMSPEED;  <<SPEED CODE>> <<03702>>06922000
                                                               <<03702>>06924000
                TSPEED := -1;       << SET PARAMETER FOR >>    <<03702>>06926000
                                    <<    CHECKSPEED     >>    <<03702>>06928000
                CHECKSPEED(TSPEED,SPEEDCDE);  <<CONVERT CODE>> <<03702>>06930000
                                              <<   TO SPEED >> <<03702>>06932000
                IF SPEEDCDE = 0 THEN                           <<03702>>06934000
                   MOVE BINBUF(26) := "??"                     <<03702>>06936000
                ELSE                           << CONVERT TO>> <<03702>>06938000
                   ASCII(TSPEED,10,BINBUF(26));  <<  ASCII  >> <<03702>>06940000
                                                               <<03702>>06942000
                END;                                           <<03702>>06944000
              ASCII(LDTENT(LDT2).RECW,10,BINBUF(33)); <<RECORD WIDTH>>  06946000
              IF LOGICAL(LDTENT(LDT3).OUTCL) THEN                       06948000
                BEGIN    <<OUTPUT DEVICE IS CLASS INDEX>>               06950000
                  TOS := LDTENT(LDT3).OUTDEV;                           06952000
                  IF = THEN DEL                                         06954000
                  ELSE CLNAME(*,BINBUF(38));                            06956000
                END                                                     06958000
              ELSE ASCII(LDTENT(LDT3).OUTDEV,10,BINBUF(40));            06960000
              IF LOGICAL(LDTXENT.LDTX'SA) THEN BINBUF(46):="E";<<01852>>06962000
              IF LOGICAL(LPDTENT(LPDT1).AJOBS) THEN BINBUF(47):="J";    06964000
                      <<ACCEPT JOBS/SESSIONS>>                          06966000
              IF LOGICAL(LPDTENT(LPDT1).ADATA) THEN BINBUF(48):="A";    06968000
                          <<ACCEPT DATA>>                               06970000
              IF LOGICAL(LPDTENT(LPDT1).INTRACT) THEN BINBUF(49):="I";  06972000
                                      <<INTERACTIVE>>                   06974000
              IF LOGICAL(LPDTENT(LPDT1).DUPLIC) THEN BINBUF(50):="D";   06976000
                                      <<DUPLICATIVE>>                   06978000
              IF LDTENT(LDT3).SPOOLST<>0 THEN BINBUF(51) := "S";        06980000
              IF LOGICAL(DVRENT(DVR1).CRBIT) THEN BINBUF(53):="*";      06982000
                                      <<CORE RESIDENT DRIVER>>          06984000
              TOS := @BINBUF(54);                                       06986000
              TOS := @DVRENT(DVR2)&LSL(1);                     <<03704>>06988000
              MOVE * := *,(8); <<DRIVER NAME>>                          06990000
              FIRSTCLASS := TRUE;                                       06992000
              I := 0;                                                   06994000
              INDEX := 10;                                              06996000
              WHILE (I:=I+1) <= LDT(DCNUM) DO                           06998000
                BEGIN   <<SCAN DEVICE CLASSES>>                         07000000
                  J := 0;                                               07002000
                  WHILE (J:=J+1) <= INTEGER(DVCLTAB(INDEX)) DO          07004000
                  IF INTEGER(DVCLTAB(INDEX+J)) = LDEV THEN              07006000
                    BEGIN    <<DEVICE IS IN THIS CLASS>>                07008000
                      IF FIRSTCLASS THEN FIRSTCLASS := FALSE            07010000
                      ELSE                                              07012000
                        BEGIN                                           07014000
                          FWRITE(LISTFNUM,INBUF,36,0);                  07016000
                          IF <> THEN GOTO LISTERR;                      07018000
                          INBUF := "  ";                                07020000
                          MOVE INBUF(1) := INBUF,(35);  <<BLANK BUFFER>>07022000
                        END;                                            07024000
                      MOVE BINBUF(63) := DVCLTAB(INDEX-10),(8);         07026000
                                         <<MOVE DEVICE CLASS TO BUFFER>>07028000
                    END;                                                07030000
                  TOS := DVCLTAB(INDEX);                                07032000
                  ASSEMBLE(DUP,NOT);                                    07034000
                  IF TOS THEN TOS := TOS+1;                             07036000
                  INDEX := TOS+INDEX+11;                                07038000
                END;                                                    07040000
              FWRITE(LISTFNUM,INBUF,36,0);                              07042000
              IF <> THEN GOTO LISTERR;                                  07044000
            END;                                                        07046000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 07048000
          IF <> THEN GOTO LISTERR;                                      07050000
      END <<LISTIODEV>>;                                                07052000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>07054000
                                                                        07056000
  PROCEDURE PUTINTEMPCLASS(LDEV);                              <<00.03>>07058000
  VALUE LDEV;                                                  <<00.03>>07060000
  INTEGER LDEV;                                                <<00.03>>07062000
  OPTION FORWARD;                                              <<00.03>>07064000
                                                               <<00.03>>07066000
          <<--------------------------------                            07068000
            REMOVE DEVICE CLASS REFERENCES                              07070000
          -------------------------------->>                            07072000
  PROCEDURE REMOVECLASSREFS;                                            07074000
    OPTION PRIVILEGED,UNCALLABLE;                                       07076000
    COMMENT                                                             07078000
      REMOVE REFERENCES TO LOGICAL DEVICE LDEV FROM DEVICE CLASS TABLE; 07080000
      BEGIN                                                             07082000
        INTEGER INDEX:=10,           <<DEVICE CLASS TABLE INDEX>>       07084000
                I:=0,                <<DEVICE CLASS NUMBER>>            07086000
                J,                   <<INDEX WITHIN CLASS>>             07088000
                K,                   <<LOGICAL DEVICE NUMBER INDEX>>    07090000
                N;                   <<NUMBER OF DEVICES IN CLASS>>     07092000
          WHILE(I:=I+1) <= LDT(DCNUM) DO                                07094000
            BEGIN                                                       07096000
              J := 0;                                                   07098000
              WHILE (J:=J+1) <= (N:=INTEGER(DVCLTAB(INDEX))) DO         07100000
              IF INTEGER(DVCLTAB(INDEX+J))=LDEV THEN                    07102000
                BEGIN   <<IN THIS CLASS>>                               07104000
                  IF N=1 THEN                                           07106000
                    BEGIN  <<CLASS MUST BE REMOVED>>                    07108000
                      MOVE DEVCLASS:=DVCLTAB(INDEX-10),(8);    <<00.03>>07110000
                      TOS := @DVCLTAB(INDEX-10);                        07112000
                      TOS := S0+12;                                     07114000
                      ASSEMBLE(DUP,NEG);                                07116000
                      TOS := TOS+@DVCLTAB(DVCLSIZE);<<# BYTES TO MOVE>> 07118000
                      ASSEMBLE(MVB 3);  <<MOVE REST OF TABLE>>          07120000
                      DVCLTABINCR := DVCLTABINCR-6; <<6 WORDS SHORTER>> 07122000
                      DVCLSIZE := DVCLSIZE-12;                          07124000
                      LDT(X) := LDT(DCNUM)-1;  <<# DEVICES>>            07126000
                      K := 0;                                           07128000
                      WHILE (K:=K+1)<=HLDEV DO <<SEARCH LDT FOR CLASS>> 07130000
                      IF LOGICAL(LDT((M:=K*LDTSIZE)+LDT3).OUTCL) THEN   07132000
                        BEGIN <<OUTPUT DEVICE IS CLASS>>                07134000
                          TOS := LDT(M+LDT3).OUTDEV;  <<INDEX>>         07136000
                          IF S0=I THEN                         <<00.03>>07138000
                            BEGIN <<OUTPT DEV IS DELETD CLAS>> <<00.03>>07140000
                            LDT(M+LDT3).OUTDEV := 0;           <<00.03>>07142000
                            PUTINTEMPCLASS(K);                 <<00.03>>07144000
                            END                                <<00.03>>07146000
                          ELSE IF S0>I THEN LDT(M+LDT3).OUTDEV := S0-1; 07148000
                          DEL;                                          07150000
                        END;                                            07152000
                      I := I-1;  <<ONE LESS CLASS>>                     07154000
                      GOTO NEXTCL;                                      07156000
                    END;                                                07158000
                <<REMOVE LDEV FROM CLASS>>                              07160000
                  TOS := @DVCLTAB(X);                                   07162000
                  DVCLTAB(INDEX-2) := 1;   <<RESET CYCLICAL PTR>>       07164000
                  ASSEMBLE(DUP,INCA);                                   07166000
                  TOS := N-J;                                           07168000
                  ASSEMBLE(MVB 2);  <<MOVE REST OF THIS CLASS>>         07170000
                  IF LOGICAL(N) THEN BPS0 := 0  <<FILLER BYTE>>         07172000
                  ELSE                                                  07174000
                    BEGIN<<1 WORD REMOVED FROM TABLE - MOVE REST OF IT>>07176000
                      TOS := @DVCLTAB(INDEX+N);                         07178000
                      ASSEMBLE(DUP,INCA; INCA,DUP; NEG);                07180000
                      TOS := TOS+@DVCLTAB(DVCLSIZE); <<# OF WORDS>>     07182000
                      ASSEMBLE(MVB 3);    <<MOVE  REST OF TABLE>>       07184000
                      DVCLSIZE := DVCLSIZE-2;  <<2 LESS BYTES>>         07186000
                      DVCLTABINCR := DVCLTABINCR-1;                     07188000
                    END;                                                07190000
                  DEL;                                                  07192000
                  DVCLTAB(X) := INTEGER(DVCLTAB(INDEX))-1;              07194000
                  J := J-1;                                             07196000
                END;                                                    07198000
              TOS := N; <<NUMBER OF DEVICES IN THIS CLASS>>             07200000
             ASSEMBLE(DUP,NOT);                                         07202000
              IF TOS THEN TOS:=TOS+1;  <<FILLER BYTE IN THIS ENTRY>>    07204000
              INDEX := TOS+INDEX+11;                                    07206000
  NEXTCL:   END;                                                        07208000
          IF DVCLTABINCR<>0 THEN MOVEDLTABLES; <<COMPACT TABLES>>       07210000
      END <<REMOVECLASSREFS>> ;                                         07212000
                                                                        07214000
   <<----------------------                                             07216000
     PUT IN TEMPORARY CLASS                                             07218000
     --------------------->>                                            07220000
   PROCEDURE PUTINTEMPCLASS(LDEV);                             <<00.03>>07222000
        VALUE LDEV;                                            <<00.03>>07224000
        INTEGER LDEV;                                          <<00.03>>07226000
     BEGIN                                                              07228000
     COMMENT                                                            07230000
       TEMPCLASS CONTAINS,IN BYTE ZERO, THE NUMBER OF UNDEFINED         07232000
       CLASSES USED AS OUTPUT DEVICES AND,IN BYTES 2+3,THE SIZE         07234000
       OF TEMPCLASS(IN BYTES). THE REMAINDER OF TEMPCLASS IS            07236000
       SIMILAR TO DVCLTAB EXCEPT THE CYCLICAL POINTER AND THE           07238000
       ACCESS TYPE ARE NOT INCLUDED IN TEMPCLASS. THE NAME IS           07240000
       FOLLOWED BY THE NUMBER OF DEVICES AND THE DEVICE #'S             07242000
       THAT REQUIRE THIS CLASS AS  OUTPUT DEVICE;                       07244000
        INTEGER INDEX:=12,I:=0;                                         07246000
          WHILE (I:=I+1)<=TCLASS DO                                     07248000
            BEGIN                                                       07250000
            IF TEMPCLASS(INDEX-8)=DEVCLASS,(8),2 THEN GO ENTEXST;       07252000
            TOS := TEMPCLASS(INDEX);                                    07254000
            ASSEMBLE(DELB,DUP;NOT);                                     07256000
            IF TOS THEN TOS:=TOS+1;                                     07258000
            INDEX := TOS+INDEX+9;                                       07260000
            END;                                                        07262000
          MOVE TEMPCLASS(INDEX-8):=DEVCLASS,(8);                        07264000
          TEMPCLASS(INDEX):=1;                                          07266000
          TEMPCLASS(X:=X+1):=LDEV;                                      07268000
          TCLASS := TCLASS + 1;                                         07270000
          TCLASS(X) := TCLASS(1) + 10;                                  07272000
          RETURN;                                                       07274000
   ENTEXST:                                                             07276000
          I := 0;                                                       07278000
          IF LOGICAL(N:=BPS0) THEN                                      07280000
            BEGIN    <<MUST MAKE ROOM FOR NEW ENTRY>>                   07282000
            TOS := @TEMPCLASS(TCLASS(1)-1);<<LAST BYTE>>                07284000
            ASSEMBLE(DUP,INCB,INCB,DUP;NEG);                            07286000
            TOS := TOS + @TEMPCLASS(INDEX+N);                           07288000
            ASSEMBLE(MVB 2);                                            07290000
            BPS0 := 0;  <<FILLER BYTE>>                                 07292000
            TOS := TOS - 1;                                             07294000
            TCLASS(X) := TCLASS(1) + 2;                                 07296000
            END                                                         07298000
          ELSE TOS := S0+N+1;                                           07300000
          BPS0 := LDEV;                                                 07302000
          BPS1 := BPS1 + 1;                                             07304000
     END <<PUTINTEMPCLASS>>;                                            07306000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>07308000
                                                                        07310000
   <<--------------                                                     07312000
     DELETE CLASS                                              <C0.00   07314000
   -------------->>                                                     07316000
   INTEGER PROCEDURE DELETECLASS(ERRLABEL);                             07318000
       VALUE ERRLABEL;                                                  07320000
       INTEGER ERRLABEL;                                                07322000
       BEGIN                                                            07324000
        INTEGER ARRAY ERR(0:13);                                        07326000
        BYTE ARRAY BERR(*)=ERR;                                         07328000
        INTEGER INDEX:=10,I:=0;                                         07330000
        WHILE (I:=I+1)<=LDT(DCNUM) DO                                   07332000
          IF DVCLTAB(INDEX-10)=DEVCLASS,(8) THEN                        07334000
            BEGIN <<FOUND IT>>                                          07336000
            DELETECLASS := I;                                           07338000
            GO PURGECL;                                                 07340000
            END                                                         07342000
          ELSE                                                          07344000
            BEGIN <<BUMP INDEX>>                                        07346000
            TOS := DVCLTAB(INDEX);                                      07348000
            ASSEMBLE(DUP,NOT);                                          07350000
            IF TOS THEN TOS:=TOS+1;                                     07352000
            INDEX := TOS+INDEX+11;                                      07354000
            END;                                                        07356000
        MOVE BERR := "CLASS ",2;                                        07358000
        MOVE * := DEVCLASS,(8),2;                                       07360000
        MOVE * := " DOESN'T EXIST";                                     07362000
        PRINT(ERR,-28,0);                                               07364000
        RETURNP := ERRLABEL;                                            07366000
        ASSEMBLE(EXIT 2); <<DELETE DELETECLASS'S VALUE>>                07368000
   PURGECL:                                                             07370000
        TOS := @DVCLTAB(INDEX-10);                                      07372000
        DUPLICATE;                                                      07374000
        TOS := DVCLTAB(INDEX);                                          07376000
        ASSEMBLE(DUP,NOT);                                              07378000
        IF TOS THEN TOS := TOS+1;                                       07380000
        I:= S0;                                                         07382000
        TOS :=TOS+TOS+11;                                               07384000
        DUPLICATE;                                                      07386000
        TOS := -TOS+@DVCLTAB+DVCLSIZE;                                  07388000
        ASSEMBLE(MVB 3);                                                07390000
        LDT(X) := LDT(DCNUM)-1;                                         07392000
        DVCLSIZE := DVCLSIZE-I-11;                                      07394000
        DVCLTABINCR := -(I+2)&LSR(1)-5; MOVEDLTABLES;                   07396000
        END <<DELETECLASS>>;                                            07398000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>07400000
                                                                        07402000
   <<--------------------                                               07404000
     DETERMINE CLASS TYPE                                      <C0.00   07406000
   -------------------->>                                               07408000
                                                                        07410000
   PROCEDURE DETERMCTYP(ERRLABEL,INDEX,ASKIO);                 <<03610>>07412000
     VALUE ERRLABEL,INDEX,ASKIO;                               <<03610>>07414000
     INTEGER INDEX,ERRLABEL;                                            07416000
     LOGICAL ASKIO;                                            <<03610>>07418000
        BEGIN                                                           07420000
        <<THIS PROCEDURE DETERMINES THE TYPE OF THE CLASS >>            07422000
        <<TO WHIC INDEX POINTS TO IN DVCLTAB.  INDEX POINTS>>           07424000
        <<PAST THE CLASS NAME TO THE # OF DEVICES IN THE CLASS>>        07426000
        SWITCH SW:=CER,DAC,SIP,CER,CIO,CER,SIP,CER,NCIO,CER,SIP,        07428000
                   CER,NCIO,CER,SIP,CER,SOU,CER,CER,CER,SOU,CER,        07430000
                   CER,CER,SOU,CER,CER,CER,SOU,CER,CER,CER,CER;         07432000
        INTEGER I,J,L,N,TEMP,DTYPE,DRANGE,TYPE,SUBTYP,         <<03610>>07434000
                CURRENT'CLASS'ACCESS'TYPE;                     <<03610>>07436000
        LOGICAL ALLSAME:=TRUE;                                          07438000
        LOGICAL ALL'SAME'RANGE:= TRUE;                         <<03610>>07440000
        LOGICAL CANBESERIAL:=TRUE;                             <<00134>>07442000
        EQUATE SDISC=31, FDISC=7;                              <<01115>>07446000
          N := DVCLTAB(INDEX);                                          07448000
          I := 0;                                                       07450000
          TEMP := 0;                                                    07452000
          CURRENT'CLASS'ACCESS'TYPE:= DVCLTAB(INDEX-1);        <<03610>>07454000
          X := DVCLTAB(INDEX+1)*LDTSIZE;                                07456000
          DTYPE := LDT(X+LDT2).TYP;<<TYPE OF FIRST DEVICE>>             07458000
          DRANGE :=LDT(DVCLTAB(INDEX+1)*LDTSIZE+LDT2).RANGE;   <<03610>>07460000
          WHILE (I:=I+1)<=N DO                                          07462000
            BEGIN                                                       07464000
            L := DVCLTAB(INDEX+I);  << LDEV >>                 <<03544>>07466000
            TYPE := LDT(L*LDTSIZE+LDT2).TYP;                   <<03544>>07468000
            SUBTYP := LPDT(L*LPDTSIZE+LPDT1).SUBTYPE;          <<03544>>07470000
            IF DTYPE <> TYPE THEN ALLSAME := FALSE;            <<03544>>07472000
            IF DRANGE<>J THEN ALL'SAME'RANGE:= FALSE;          <<03610>>07474000
            J := LDT(L*LDTSIZE+LDT2).RANGE;  << TYPE RANGE >>  <<03544>>07476000
            CASE J OF                                                   07478000
             BEGIN                                                      07480000
             BEGIN                                             <<00134>>07482000
             TEMP.DIRACC:=1;                                   <<00134>>07484000
             IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN               <<03544>>07486000
                CANBESERIAL:=FALSE;                            <<00134>>07488000
             END;                                              <<00134>>07490000
             TEMP.SERINP:=1;                                            07492000
             TEMP.CONIO :=1;                                            07494000
             TEMP.NCONIO:=1;                                            07496000
             TEMP.SEROUT:=1;                                            07498000
             END;                                                       07500000
            END;                                                        07502000
          GO SW(TEMP);                                                  07504000
   DAC:   IF CURRENT'CLASS'ACCESS'TYPE<>SDISC AND              <<03610>>07506000
             CURRENT'CLASS'ACCESS'TYPE<>FDISC THEN             <<03610>>07508000
          IF ALLSAME THEN DVCLTAB(INDEX-1):= DTYPE             <<03610>>07510000
          ELSE DVCLTAB(INDEX-1):=DIRACCESS&LSL(3);                      07512000
          IF CANBESERIAL AND ASKIO THEN                        <<03610>>07514000
            IF YESANSWER(169) THEN   <<SERIAL DISC CLASS>>     <<01115>>07516000
              DVCLTAB(INDEX-1) := SDISC                        <<01115>>07518000
            ELSE IF YESANSWER(185) THEN <<FOREIGN DISC CLASS>> <<01115>>07520000
              DVCLTAB(INDEX-1) := FDISC;                       <<01115>>07522000
          RETURN;                                              <<01073>>07524000
   SIP:   IF ALLSAME THEN DVCLTAB(INDEX-1):=DTYPE                       07526000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<03610>>07528000
                 DVCLTAB(INDEX-1):=SERINPUT&LSL(3);            <<03610>>07530000
          RETURN;                                                       07532000
   CIO:   IF ASKIO THEN                                        <<03610>>07534000
            BEGIN                                              <<03610>>07536000
            DVCLTAB(INDEX-1):= CONINOUT&LSL(3);                <<03610>>07538000
            GO PROMPT;                                         <<03610>>07540000
            END;                                               <<03610>>07542000
          IF CURRENT'CLASS'ACCESS'TYPE.(13:3)<>0 THEN          <<03610>>07544000
            DVCLTAB(INDEX-1):=CONINOUT&LSL(3);                 <<03610>>07546000
          RETURN;                                              <<03610>>07548000
   NCIO:  DVCLTAB(INDEX-1):= NCONINOUT&LSL(3);                 <<03610>>07550000
          IF ASKIO THEN GO PROMPT ELSE RETURN;                 <<03610>>07552000
   SOU:   IF ALLSAME THEN DVCLTAB(INDEX-1):=DTYPE                       07556000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<03610>>07558000
                 DVCLTAB(INDEX-1):=SEROUTPUT&LSL(3);           <<03610>>07560000
          RETURN;                                                       07562000
   CER:                                                        <<00298>>07564000
          IF ALLSAME THEN                                      <<00298>>07566000
             DVCLTAB(INDEX-1):=DTYPE                           <<00298>>07568000
          ELSE IF ASKIO THEN                                   <<03610>>07570000
             BEGIN                                             <<00298>>07572000
             MESSAGE(110);                                     <<03610>>07574000
             TOS := WORDADDRESS(DEVCLASS);<<CONV TO WORD ADDR>><<03704>>07576000
             PRINT(*,-8,0);                                    <<03704>>07578000
             RETURNP := ERRLABEL;                              <<00298>>07580000
             END;                                              <<00298>>07582000
          RETURN;                                                       07584000
   PROMPT:MESSAGE(-111);                                                07586000
          READINPUT;                                                    07588000
          M := GETSTR(@PROMPT,BTYP,1,"/",6);                            07590000
          IF BTYP="IN    " THEN DVCLTAB(X):=SERINPUT&LSL(3)             07592000
          ELSE IF BTYP="OUT   " THEN DVCLTAB(X):=SEROUTPUT&LSL(3)       07594000
               ELSE IF BTYP<>"IN/OUT" AND BTYP<>"IO    " THEN           07596000
                      BEGIN                                             07598000
                      MESSAGE(1);                                       07600000
                      GO PROMPT;                                        07602000
                      END;                                              07604000
          IF DVCLTAB(X)&LSR(3)=CONINOUT THEN                            07606000
            BEGIN                                                       07608000
   NORNC:   MESSAGE(-112);                                              07610000
            READINPUT;                                                  07612000
            GETSTR(@NORNC,BTYP,1,"A",2);                                07614000
            IF BTYP="NC" THEN DVCLTAB(X):=NCONINOUT&LSL(3)              07616000
            ELSE IF BTYP<>"C " AND BTYP<>"CO" THEN                      07618000
                   BEGIN                                                07620000
                   MESSAGE(1);                                          07622000
                   GO NORNC;                                            07624000
                   END;                                                 07626000
            END;                                                        07628000
          END  <<DETERMCTYP>>;                                          07630000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>07632000
                                                                        07634000
          <<--------------------------                                  07636000
            CHECK DEVICE CONSISTENCY                           <C0.00   07638000
          -------------------------->>                                  07640000
  LOGICAL PROCEDURE CHECKDEV;                                  <<01073>>07642000
    OPTION PRIVILEGED,UNCALLABLE;                                       07644000
    COMMENT                                                             07646000
      CHECK DEVICE TABLES FOR NON-EXISTENT OUTPUT DEVICES, DUPLICATELY  07648000
    DEFINED DRT-UNIT COMBINATIONS,DEVICES OR DEVICE CLASSES NOT         07650000
    ALLOW ARE DEFINED AS OUTPUT DEVICE, AND DEVICE CLASSES WITH         07652000
    BOTH SHARABLE AND NON-SHARABLE DEVICES. IF ANY OF THESE             07654000
    CONDITIONS ARE FOUND, PRINT A MESSAGE AND EXIT TO ERRLABEL;         07656000
      BEGIN                                                             07658000
        EQUATE CONSOLEDRTUNIT=[9/7,7/0],TAPEDRTUNIT=[9/6,7/0]; <<03006>>07660000
EQUATE TPCONSDRTUNIT=[9/8,7/0];                                <<03006>>07662000
        EQUATE SDISC=31;<<CLASS ACCESS TYPE FOR SERIAL DISCS>> <<00.SD>>07666000
        EQUATE FDISC=7; <<FOREIGN DISC CLASS ACCESS TYPE>>     <<01115>>07668000
        INTEGER I,J,K,N,INDEX,LDEV:=0,CONSOLELDEV:=0,TAPELDEV:=0;       07670000
        INTEGER LDEVRANGE,DTYP,TYPE,TYPE2,SUBTYP;              <<03544>>07672000
        LOGICAL ALLSAME;                                                07674000
        BYTE ARRAY ERRMESS0(0:20)=PB:="NO OUTPUT DEVICE FOR ";          07676000
        BYTE ARRAY ERRMESS1(0:14) =PB := "LOGICAL DEVICE ";             07678000
        BYTE ARRAY ERRMESS2(0:14) =PB := " DOES NOT EXIST";             07680000
        BYTE ARRAY ERRMESS3(0:33) = PB :=                      <<03007>>07682000
            "LDEV AND LDEV ON SAME DRT AND UNIT";              <<03007>>07684000
        BYTE ARRAY ERRMESS5(0:41)=PB:=                                  07686000
          "DEVICES OF DIFFERENT TYPE RANGES IN CLASS ";                 07688000
        BYTE ARRAY ERRMESS6(0:37)=PB:=                         <<03006>>07690000
          "USER SPECIFIED MAXIMUM DRT ALLOWED IS ";            <<03006>>07692000
        BYTE ARRAY ERRMESS7(0:23)=PB:="OUTPUT CLASS FOR DEVICE ";       07694000
        BYTE ARRAY ERRMESS8(0:16)=PB:=" NO LONGER EXISTS";              07696000
        BYTE ARRAY ERRMESS9(0:24)=PB:=                                  07698000
                   " CAN NOT BE OUTPUT DEVICE";                         07700000
        BYTE ARRAY ERRMES10(0:12)=PB:="DEVICE CLASS ";                  07702000
        BYTE ARRAY ERRMES11(0:34)=PB:=                                  07704000
              "ILLEGAL TYPE COMBINATIONS IN CLASS ";                    07706000
        BYTE ARRAY ERRMESS12(0:45)=PB:=                        <<03006>>07708000
          "WARNING  HIGHEST DRT SUPPORTED BY THIS CPU IS ";    <<03006>>07710000
        BYTE ARRAY ERRMESS13(0:45)=PB:=                        <<03006>>07712000
          "FOLLOWING DRT(S) EXCEED HIGHEST ALLOWABLE DRT:";    <<03006>>07714000
        LOGICAL SHARE,ERRORS:=FALSE,TOOBIGDRT:=FALSE;                   07716000
           LOGICAL CPUBIGDRT := FALSE;  <<CONFIG HAS A DRT   >><<03006>>07718000
                                        <<HIGHER THAN LOCAL>>  <<03006>>07720000
                                        <<SUPPORTABLE MAX DRT>><<03006>>07722000
           LOGICAL BIGUSERMAXDRT := FALSE;  <<USER PICKED A >> <<03006>>07724000
                  << "MAXDRT" WHICH IS LARGER THAN THE MAX >>  <<03006>>07726000
                  <<DRT WHICH THIS CPU CAN SUPPORT, BUT>>      <<03006>>07728000
                  <<MIGHT BE OK IF CONFIG FOR ANOTHER CPU >>   <<03006>>07730000
           INTEGER DRTCUTOFF;   <<MIN OF USER SPECIFIED MAX DRT<<03006>>07732000
                                <<AND CPU SUPPORTED MAX DRT>>  <<03006>>07734000
           LOGICAL WARNING:=FALSE;                             <<03006>>07736000
        LOGICAL DISCFOUND := FALSE;                                     07738000
        INTEGER LEN1,LEN2;                                              07740000
        INTEGER ACCTYPE;                                       <<00072>>07742000
  DO BEGIN  <<LOOP WHILE USER DESIRES TO CORRECT CONFIG>>      <<03006>>07746000
            <<WARNINGS CONCERNING DRTS>MAXDRT>>                <<03006>>07748000
                                                               <<03006>>07750000
    ERRORS := FALSE;   <<CLEAR THESE EACH TIME AROUND>>        <<03006>>07752000
    WARNING := FALSE;  <<SET IF DRT VALUE > MAX DRT>>          <<03006>>07754000
                       <<SUPPORTED BY THIS CPU>>               <<03006>>07756000
                                                               <<03006>>07758000
    BIGUSERMAXDRT:= FALSE;                                     <<03006>>07760000
    TOOBIGDRT := FALSE;                                        <<03006>>07762000
    CPUBIGDRT := FALSE;                                        <<03006>>07764000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              07766000
           BEGIN                                                        07768000
           DRTN := DVRTAB(LDEV*DVRSIZE);                                07770000
          IF DRTN<>0 AND DVRTAB(LDEV*DVRSIZE+1).DSBIT=0 THEN   <<03006>>07772000
             BEGIN <<NON-DS DEVICE>>                                    07774000
              IF DRTN.DRTFIELD>CTAB0(DRTNUM)                   <<03006>>07776000
              THEN TOOBIGDRT := TRUE;                          <<03006>>07778000
              IF DRTN.DRTFIELD > MAXDRT  <<CAN'T SUPPORT >>    <<03006>>07780000
              THEN CPUBIGDRT := TRUE;                          <<03006>>07782000
              IF CTAB0(DRTNUM) > MAXDRT  <<POTENTIAL PROB>>    <<03006>>07784000
              THEN BIGUSERMAXDRT := TRUE;                      <<03006>>07786000
              @LDTENT := @LDT(LDEV*LDTSIZE);                            07788000
              TYPE := LDTENT(LDT2).TYP;                        <<03007>>07790000
              I := LDTENT(LDT3).OUTDEV;  <<OUTPUT DEVICE>>              07792000
     IF SERIESII'III THEN                                      <<02509>>07796000
   BEGIN                                                       <<TP.01>>07798000
              IF DRTN=CONSOLEDRTUNIT AND LDTENT(LDT2).TYP      <<03544>>07800000
                  =TERMDEVTYPE THEN                            <<03544>>07802000
                  CONSOLELDEV := LDEV;                         <<03544>>07804000
              IF DRTN=TAPEDRTUNIT AND LDTENT(LDT2).TYP=TAPETYPE         07806000
                THEN TAPELDEV := LDEV;                                  07808000
   END                                                         <<TP.01>>07810000
ELSE                                                           <<TP.01>>07812000
   IF POSTSERIES3 THEN                                         <<01402>>07814000
      BEGIN                                                    <<TP.01>>07816000
      IF DRTN=TPCONSDRTUNIT AND LDTENT(LDT2).TYP               <<03544>>07818000
         = TERMDEVTYPE THEN                                    <<03544>>07820000
         CONSOLELDEV:=LDEV;                                    <<TP.01>>07822000
      END                                                      <<TP.01>>07824000
   ELSE                                                        <<TP.01>>07826000
      MESSAGE(171);                                            <<TP.01>>07828000
              IF LOGICAL(LPDT(LPDTSIZE*LDEV+LPDT1).AJOBS) AND I=0 THEN  07830000
                BEGIN  <<OUTPUT DEVICE DOESN'T EXIST>>                  07832000
                  TOS := 0;                                             07834000
                  TOS := LDEV;                                          07836000
                  TOS := 10;                                            07838000
                  MOVE BINBUF := ERRMESS0,(21),2;                       07840000
                  MOVE * := ERRMESS1,(15),2;                            07842000
                  LEN1 := ASCII(*,*,*);                                 07844000
                  PRINT(INBUF,-36-LEN1,0);                              07846000
                  ERRORS := TRUE;                                       07848000
                END;                                                    07850000
              IF LOGICAL(LDTENT(LDT3).OUTCL) THEN                       07852000
                BEGIN   <<OUTPUT DEVICE IS CLASS INDEX>>                07854000
                  IF I=0 THEN                                           07856000
                    BEGIN  <<CLASS DOESN'T EXIST>>                      07858000
                      TOS := 0;                                         07860000
                      TOS := LDEV;                                      07862000
                      TOS := 10;                                        07864000
                      MOVE BINBUF := ERRMESS7,(24),2;                   07866000
                      LEN1 := ASCII(*,*,*);                             07868000
                      MOVE BINBUF(LEN1+24) := ERRMESS8,(17);            07870000
                      PRINT(INBUF,-41-LEN1,0);                          07872000
                      ERRORS := TRUE;                                   07874000
                    END                                                 07876000
                  ELSE                                                  07878000
                  BEGIN <<ILLEGAL CLASS AS OUTPUT DEVICE>>              07880000
                   INDEX := 10;                                         07882000
                   J := 0;                                              07884000
                   WHILE (J:=J+1)<I DO                                  07886000
                     BEGIN                                              07888000
                      TOS:=DVCLTAB(INDEX);                              07890000
                      ASSEMBLE(DUP,NOT);                                07892000
                      IF TOS THEN TOS := TOS + 1;                       07894000
                      INDEX := TOS + INDEX +11;                         07896000
                     END;                                               07898000
                  I:=LDT(INTEGER(DVCLTAB(INDEX+1))*LDTSIZE              07900000
                                +LDT2).TYP;                             07902000
                  IF (0<=I<=15) OR (24<=I<=31) THEN                     07904000
                    BEGIN                                               07906000
                     MOVE BINBUF := ERRMES10,(13),2;                    07908000
                     MOVE * := DVCLTAB(INDEX-10),(10),2;                07910000
                     MOVE * := ERRMESS9,(25);                           07912000
                     PRINT(INBUF,-48,0);                                07914000
                     ERRORS:=TRUE;                                      07916000
                    END;                                                07918000
                 END;                                                   07920000
                END                                                     07922000
              ELSE IF I <> 0 THEN                                       07924000
              IF DVRTAB(I*DVRSIZE).DRTFIELD=0 THEN             <<03006>>07926000
                BEGIN   << OUTPUT DEVICE DOESN'T EXIST>>                07928000
                  TOS := 0;                                             07930000
                  TOS := I;                                             07932000
                  TOS := 10;                                            07934000
                  MOVE BINBUF := ERRMESS1,(15),2;                       07936000
                  LEN1 := ASCII(*,*,*);   <<CONVERT DEVICE #>>          07938000
                  MOVE BINBUF(LEN1+15) := ERRMESS2,(15);                07940000
                  PRINT(INBUF, -30-LEN1,0);                             07942000
                  ERRORS := TRUE;                                       07944000
                END                                                     07946000
              ELSE                                                      07948000
              BEGIN <<ILLEGAL OUTPUT DEVICE>>                           07950000
               INDEX := LDT(I*LDTSIZE+LDT2).TYP;                        07952000
               IF (0<=INDEX<=15) OR (24<=INDEX<=31) THEN                07954000
                 BEGIN                                                  07956000
                  TOS := 0;                                             07958000
                  TOS := I;                                             07960000
                  TOS := 10;                                            07962000
                  MOVE BINBUF := ERRMESS1,(15),2;                       07964000
                  LEN1 := ASCII(*,*,*);                                 07966000
                  MOVE BINBUF(LEN1+15) := ERRMESS9,(25);                07968000
                  PRINT(INBUF,-40-LEN1,0);                              07970000
                  ERRORS := TRUE;                                       07972000
                 END;                                                   07974000
              END;                                                      07976000
              INDEX := LDEV;                                            07978000
              WHILE (INDEX:=INDEX+1) <= HLDEV DO                        07980000
              IF DVRTAB(INDEX*DVRSIZE)=DRTN THEN               <<03007>>07984000
                BEGIN     << TWO DEVICES ON SAME DRT,UNIT >>   <<03007>>07986000
                TYPE2 := LDT(INDEX*LDTSIZE+LDT2).TYP;          <<03007>>07988000
                                                               <<03007>>07990000
                        << NOT BOTH CS DEVICES >>              <<03007>>07992000
                IF NOT ( CSDEV17<= TYPE <= CSDEV19 LAND        <<03007>>07994000
                         CSDEV17<= TYPE2<= CSDEV19)            <<03007>>07996000
                                                               <<03007>>07998000
                AND                                            <<03007>>08000000
                        << NOT BOTH TERMINALS ON 33 >>         <<03007>>08002000
                NOT ( POSTSERIES3 LAND TYPE=TERMDEVTYPE        <<03007>>08004000
                      LAND TYPE2=TERMDEVTYPE)                  <<03007>>08006000
                                                               <<03007>>08008000
                AND                                            <<03007>>08010000
                        << NOT BOTH DISCS >>                   <<03007>>08012000
                NOT ( TYPE&LSR(3)   = DIRACCESS LAND           <<03007>>08014000
                      TYPE2&LSR(3)  = DIRACCESS)               <<03007>>08016000
                                                               <<03007>>08018000
                THEN                                           <<03007>>08020000
                  BEGIN                                        <<03007>>08022000
                  << PRINT MESSAGE FOR MORE THAN ONE DEVICE >> <<03007>>08024000
                  << ON THE SAME DRT AND UNIT               >> <<03007>>08026000
                  MOVE BINBUF := ERRMESS3,(5);                 <<03007>>08028000
                           << CONVERT FIRST LDEV # >>          <<03007>>08030000
                  LEN1 := ASCII( LDEV,10,BINBUF(5))+5;         <<03007>>08032000
                  MOVE BINBUF(LEN1) := ERRMESS3(4),(10);       <<03007>>08034000
                           << CONVERT 2ND LDEV # >>            <<03007>>08036000
                  LEN2 := ASCII( INDEX,10,BINBUF(LEN1+10))     <<03007>>08038000
                                                 + LEN1 + 10;  <<03007>>08040000
                  MOVE BINBUF(LEN2) := ERRMESS3(13),(21);      <<03007>>08042000
                  PRINT( INBUF, -LEN2-21, 0);                  <<03007>>08044000
                  ERRORS := TRUE;                              <<03007>>08046000
                  END;                                         <<03007>>08048000
                END;                                                    08050000
            END;                                                        08052000
           END;                                                         08054000
          INDEX := 10;                                                  08056000
          I := 0;                                                       08058000
          WHILE (I:=I+1) <= LDT(DCNUM) DO                               08060000
            BEGIN    <<SEARCH DEVICE CLASS TABLE>>                      08062000
              IF DVCLTAB(INDEX-10)="DISC    " THEN DISCFOUND := TRUE;   08064000
              N := DVCLTAB(INDEX);                                      08066000
              TOS := DVCLTAB(X:=X-1); <<CLASS ACCESS & TERMACC BIT>>    08068000
              TOS := TOS LAND %77; <<CLEAR TERMACC BIT>>                08070000
              DUPLICATE;                                                08072000
              DVCLTAB(X) := TOS;                                        08074000
              ACCTYPE:=S0; <<SAVE CLASS ACCESS TYPE>>          <<00072>>08076000
              IF S0=SDISC THEN TOS:=TOS&LSR(3);<<SERIAL DISCS>><<00.SD>>08078000
              <<FIT IN CLASS TYPE "DIRECT ACCESS">>            <<00.SD>>08080000
              K := TOS&LSR(3);                                          08082000
              ALLSAME := TRUE;                                          08084000
              DTYP := LDT(DVCLTAB(INDEX+1)*LDTSIZE+LDT2).TYP;  <<03544>>08086000
              J := 0;                                                   08088000
              IF K=DIRACCESS OR K=CONINOUT THEN                         08090000
                BEGIN                                                   08092000
              WHILE (J:=J+1) <= N DO                                    08094000
              IF LDT(INTEGER(DVCLTAB(INDEX+J))*LDTSIZE+LDT2).RANGE      08096000
                <> K THEN                                               08098000
                BEGIN  <<TYPE RANGES DIFFERENT>>                        08100000
                  MOVE BINBUF := ERRMESS5,(42),2;                       08102000
                  MOVE * := DVCLTAB(INDEX-10),(8);<<MOVE CLASS NAME>>   08104000
                  PRINT(INBUF,-50,0);                                   08106000
                  ERRORS := TRUE;                                       08108000
                  GOTO NEXTINDEX;                                       08110000
                END                                                     08112000
              ELSE                                                      08114000
                BEGIN                                          <<00072>>08116000
                IF DTYP <> LDT(DVCLTAB(INDEX+J)*LDTSIZE        <<03544>>08118000
                    +LDT2).TYP THEN ALLSAME:=FALSE;                     08120000
                IF ACCTYPE=SDISC OR ACCTYPE=FDISC THEN         <<01115>>08122000
                   BEGIN                                       <<00072>>08124000
                   TYPE := LDT(DVCLTAB(INDEX+J)*               <<03544>>08126000
                   LDTSIZE+LDT2).TYP;                          <<00072>>08128000
                   SUBTYP := LPDT(DVCLTAB(INDEX+J)*            <<03544>>08130000
                   LPDTSIZE+LPDT1).SUBTYPE;                    <<00072>>08132000
                   IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN         <<03544>>08136000
                      GOTO CLCOMER;                            <<03544>>08138000
                   END;                                        <<00072>>08140000
                END;                                           <<00072>>08142000
                END                                                     08144000
              ELSE                                                      08146000
                WHILE (J:=J+1)<=N DO                                    08148000
                  BEGIN                                                 08150000
                  LDEVRANGE:=LDT(INTEGER(DVCLTAB(INDEX+J))*             08152000
                           LDTSIZE+LDT2).RANGE;                         08154000
                  IF LDEVRANGE=DIRACCESS THEN                           08156000
   CLCOMER:         BEGIN   <<TYPE COMBINATION ERROR IN CLASS>>         08158000
                    MOVE BINBUF := ERRMES11,(35),2;                     08160000
                    MOVE *:=DVCLTAB(INDEX-10),(8);                      08162000
                    PRINT(INBUF,-43,0);                                 08164000
                    ERRORS := TRUE;                                     08166000
                    GO NEXTINDEX;                                       08168000
                    END;                                                08170000
                  IF (K=SERINPUT)                                       08172000
                     AND (LDEVRANGE=SEROUTPUT)                          08174000
                     OR (K=SEROUTPUT)                                   08176000
                     AND (LDEVRANGE=SERINPUT)                           08178000
                     OR (K=NCONINOUT)                                   08180000
                     AND (LDEVRANGE<>NCONINOUT)                         08182000
                     AND (LDEVRANGE<>CONINOUT)                          08184000
                  THEN GO CLCOMER;                                      08186000
                  IF DTYP <> LDT(DVCLTAB(INDEX+J)*LDTSIZE      <<03544>>08188000
                       +LDT2).TYP THEN ALLSAME:=FALSE;                  08190000
                  END;                                                  08192000
                IF INTEGER(DVCLTAB(INDEX-1))<>K&LSL(3) AND     <<00072>>08194000
                NOT ALLSAME AND ACCTYPE<>SDISC                 <<01115>>08196000
                AND ACCTYPE <> FDISC THEN                      <<01115>>08198000
                   GOTO CLCOMER;                               <<00072>>08200000
                TOS := DVCLTAB(X); <<CLASS ACCESS TYPE & TERMACC BIT>>  08202000
                IF S0= TERMDEVTYPE AND ALLSAME THEN                     08204000
                  BEGIN <<ALL DEVICES IN CLASS ARE TERMINALS>>          08206000
                  TOS := TOS + %100; <<SET TERMACC BIT>>                08208000
                  DVCLTAB(X) := TOS; <<STORE IN CLASS TABLE>>           08210000
                  END                                                   08212000
                ELSE DEL;                                               08214000
  NEXTINDEX:  TOS := DVCLTAB(INDEX);                                    08216000
              ASSEMBLE(DUP,NOT);                                        08218000
              IF TOS THEN TOS:=TOS+1;                                   08220000
              INDEX := TOS+INDEX+11;  <<POINT TO NEXT CLASS>>           08222000
            END;                                                        08224000
          IF TOOBIGDRT OR BIGUSERMAXDRT THEN                   <<03006>>08226000
            BEGIN                                                       08228000
              TOS := 0;                                                 08230000
              TOS := CTAB0(DRTNUM);                                     08232000
              TOS := 10;                                                08234000
              MOVE BINBUF := ERRMESS6,(38),2;                  <<03006>>08236000
              LEN1 := ASCII(*,*,*);                                     08238000
              PRINT(INBUF,-38-LEN1,0);                         <<03006>>08240000
              IF TOOBIGDRT                                     <<03006>>08242000
              THEN ERRORS:= TRUE;  <<CTAB0(DRTNUM) TOO SMALL>> <<03006>>08244000
            END;                                                        08246000
          IF CPUBIGDRT OR BIGUSERMAXDRT                        <<03006>>08248000
          THEN BEGIN                                           <<03006>>08250000
            MOVE BINBUF := ERRMESS12,(46),2;                   <<03006>>08252000
            TOS := TOS +ASCII(MAXDRT,10,BPS0);                 <<03006>>08254000
            LEN1:= TOS-@BINBUF;                                <<03006>>08256000
            PRINT(INBUF,-LEN1,0);                              <<03006>>08258000
            WARNING:=TRUE;                                     <<03006>>08260000
           END;                                                <<03006>>08262000
                                                               <<03006>>08264000
          IF TOOBIGDRT OR CPUBIGDRT                            <<03006>>08266000
          THEN BEGIN                                           <<03006>>08268000
            IF CTAB0(DRTNUM) <= MAXDRT                         <<03006>>08270000
            THEN DRTCUTOFF := CTAB0(DRTNUM)                    <<03006>>08272000
            ELSE DRTCUTOFF := MAXDRT;                          <<03006>>08274000
                                                               <<03006>>08276000
            MOVE BINBUF:=ERRMESS13,(46);                       <<03006>>08278000
            PRINT(INBUF,-46,0);                                <<03006>>08280000
                                                               <<03006>>08282000
            LDEV := 0;                                         <<03006>>08284000
            WHILE (LDEV:= LDEV+1) <= HLDEV DO                  <<03006>>08286000
            BEGIN                                              <<03006>>08288000
              DRTN := DVRTAB(LDEV*DVRSIZE);                    <<03006>>08290000
              IF DRTN <> 0 AND                                 <<03006>>08292000
                 DVRTAB(LDEV*DVRSIZE+1).DSBIT=0                <<03006>>08294000
              THEN IF DRTN.DRTFIELD > DRTCUTOFF                <<03006>>08296000
                   THEN BEGIN                                  <<03006>>08298000
                      MOVE BINBUF:="  LDEV ",2;                <<03006>>08300000
                      TOS:=TOS+ASCII(LDEV,10,BPS0);            <<03006>>08302000
                      MOVE *:="   DRT ",2;                     <<03006>>08304000
                      TOS:=TOS+ASCII(DRTN.DRTFIELD,10,BPS0);   <<03006>>08306000
                      LEN1:=TOS-@BINBUF;                       <<03006>>08308000
                      PRINT(INBUF,-LEN1,0);                    <<03006>>08310000
                   END;                                        <<03006>>08312000
            END; <<WHILE LDEV < HLDEV>>                        <<03006>>08314000
         END; <<IF TOOBIGDRT OR CPUBIGDRT>>                    <<03006>>08316000
                                                               <<03006>>08318000
          IF CONSOLELDEV=0 THEN                                         08320000
            BEGIN                                                       08322000
              MESSAGE(21); <<SYSTEM CONSOLE MUST BE IN DRT 7 UNIT 0>>   08324000
              ERRORS := TRUE;                                           08326000
            END;                                                        08328000
        IF SERIESII'III THEN                                   <<02509>>08332000
          IF TAPELDEV=0 THEN                                            08334000
            BEGIN                                                       08336000
              MESSAGE(23);  <<SYSTEM TAPE MUST BE IN DRT 5 UNIT 0>>     08338000
              ERRORS := TRUE;                                           08340000
            END;                                                        08342000
          IF NOT NON'DS'LDEV(SYSDISC) OR                       <<03544>>08344000
            NOT SYSDISC'TYPE(LDT(SYSDISC*LDTSIZE+LDT2).TYP,    <<03544>>08346000
                LPDT(SYSDISC*LPDTSIZE+LPDT1).SUBTYPE) THEN     <<03544>>08348000
            BEGIN    << LDEV #1 IS NOT SYSTEM DISC >>          <<03544>>08350000
              MESSAGE(22); <<SYSTEM DISC MUST BE LOGICAL DEVICE 1>>     08352000
              ERRORS := TRUE;                                           08354000
            END;                                                        08356000
          IF DVRTAB(DVRSIZE).UNITFIELD<>0 THEN                 <<03006>>08358000
            BEGIN                                                       08360000
              MESSAGE(91);  <<SYSTEM DISC MUST BE UNIT 0>>              08362000
              ERRORS := TRUE;                                           08364000
            END;                                                        08366000
          IF NOT DISCFOUND THEN                                         08368000
            BEGIN  <<NO DEVICE IN CLASS DISC>>                          08370000
              MESSAGE(86);                                              08372000
              ERRORS := TRUE;                                           08374000
            END;                                                        08376000
          IF ERRORS  <<USER SPECIFIED TOO LOW A MAXDRT>>       <<03006>>08378000
          THEN WARNING := FALSE   <<MUST BE CORRECTED>>        <<03006>>08380000
          ELSE IF WARNING        <<OPTIONAL CORRECTION>>       <<03006>>08382000
               THEN IF YESANSWER(3)   <<IO CONFIG CHANGES?>>   <<03006>>08384000
                    THEN IO'CONFIG'CH  <<CHOOSES TO CORRECT>>  <<03006>>08386000
                    ELSE WARNING:=FALSE;  <<DECLINES OFFER>>   <<03006>>08388000
                                                               <<03006>>08390000
    END UNTIL NOT WARNING; <<EXIT IF OK, ERROR, OR USER>>      <<03006>>08392000
                           <<DECLINES OPPORTUNITY TO>>         <<03006>>08394000
                           <<CORRECT DRT PROBLEM, IE. IS>>     <<03006>>08396000
                           <<CONFIGURING FOR ANOTHER CPU>>     <<03006>>08398000
          CHECKDEV := NOT ERRORS;                              <<01073>>08400000
      END <<CHECKDEV>> ;                                                08402000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>08404000
                                                                        08406000
          <<--------------------------------                            08408000
            GET ID AND COMPONENT SEQUENCES                              08410000
          -------------------------------->>                            08412000
                                                                        08414000
  INTEGER PROCEDURE GETSEQ(ERRLABEL,ADDR);                              08416000
    VALUE ERRLABEL;                                                     08418000
    INTEGER ERRLABEL;                                                   08420000
    BYTE ARRAY ADDR;                                                    08422000
      COMMENT--                                                <<+0.06>>08424000
      VALUE RETURNED IN GETSEQ:                                <<+0.06>>08426000
           (0:8)-ZERO                                          <<+0.06>>08428000
           (8:2)-INPUT TYPE                                    <<+0.06>>08430000
           (10:6)-LENGTH                                       <<+0.06>>08432000
      END OF COMMENT;                                          <<+0.06>>08434000
      BEGIN                                                             08436000
        INTEGER TYPE,LEN,I,J,INDEX;                                     08438000
        LOGICAL TEMP,FINISHED;                                          08440000
        EQUATE QUOT=%42,<<">>                                           08442000
               CR  =%15,<<CARRIAGE RETURN>>                             08444000
               MAXSEQLEN=16,<<MAX LENGTH IN BYTES>>                     08446000
               ATYP=0,  <<INPUT TYPE ASCII >>                           08448000
               ETYP=1,  <<INPUT TYPE EBCDIC>>                           08450000
               OTYP=2,  <<INPUT TYPE OCTAL >>                           08452000
               HTYP=3;  <<INPUT TYPE HEX   >>                           08454000
        BYTE POINTER PNTR;                                              08456000
          SCAN BPINBUF WHILE BLANK,1;                                   08458000
          IF CARRY THEN RETURN; <<NO INPUT>>                            08460000
          IF BPS0="A" OR BPS0=QUOT THEN TYPE:=ATYP                      08462000
          ELSE IF BPS0="E" THEN TYPE:=ETYP                              08464000
               ELSE IF BPS0="O" THEN TYPE:=OTYP                         08466000
                    ELSE IF BPS0="H" THEN TYPE:=HTYP                    08468000
                         ELSE BEGIN                                     08470000
  ERROR:                      MESSAGE(1);                               08472000
                              RETURNP := ERRLABEL;                      08474000
                              ASSEMBLE(EXIT 3);                         08476000
                              END;                                      08478000
          IF TYPE=ATYP OR TYPE=ETYP THEN                                08480000
            BEGIN  <<STRING ASCII OR EBCDIC>>                           08482000
            IF BPS0="A" OR BPS0="E" THEN TOS:=TOS+1;                    08484000
            IF BPS0<>QUOT THEN GOTO ERROR;                              08486000
            @PNTR := TOS+1;  <<POINT TO FIRST CHARACTER>>               08488000
            LEN := -1;  <<INDEX TO ADR(ALSO COUNTER>>                   08490000
  GETCHAR:  FINISHED := FALSE;                                          08492000
            WHILE NOT FINISHED DO                                       08494000
              BEGIN <<GET A CHARACTER>>                                 08496000
              IF PNTR=CR THEN GOTO ERROR;                               08498000
              IF PNTR=QUOT THEN FINISHED:=TRUE;                         08500000
              LEN := LEN+1;                                             08502000
              ADDR(LEN) := PNTR;                                        08504000
              @PNTR := @PNTR+1;                                         08506000
              END;                                                      08508000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           08510000
            IF PNTR=QUOT THEN                                           08512000
              BEGIN <<DOUBLE QUOTES>>                                   08514000
              @PNTR := @PNTR+1; <<A QUOT IS IN SEQUENCE>>               08516000
              GOTO GETCHAR;                                             08518000
              END;                                                      08520000
            SCAN PNTR WHILE BLANK;                                      08522000
            IF NOCARRY THEN GOTO ERROR;                                 08524000
            I := -1;                                                    08526000
            WHILE(I:=I+1)<LEN DO                                        08528000
              IF NOT(%40<=INTEGER(ADDR(I))<=%176) THEN                  08530000
                  TYPE := OTYP;                                         08532000
            IF TYPE=ETYP THEN CONVERT(1,ADDR,ADDR,LEN);        <<+0.06>>08534000
            <<ASCII TO EBCDIC>>                                <<+0.06>>08536000
            END                                                         08538000
          ELSE                                                          08540000
            BEGIN  <<OCTAL OR HEX>>                                     08542000
            FINISHED := FALSE;                                          08544000
            TOS := TOS+1;                                               08546000
            IF BPS0<>"(" THEN GOTO ERROR;                               08548000
            TOS := TOS+1;                                               08550000
            LEN := 0;                                                   08552000
  NEXTNUM:  SCAN * WHILE BLANK,1;<<FIND FIRST DIGIT>>                   08554000
            IF CARRY THEN GOTO ERROR;                                   08556000
            IF BPS0=SPECIAL THEN GOTO ERROR;                            08558000
            ASSEMBLE(DUP,DDUP);                                         08560000
            MOVE *:=* WHILE AN,0;                                       08562000
            SCAN * WHILE BLANK,1;                                       08564000
            IF BPS0<>"," THEN FINISHED:=TRUE;                           08566000
            TEMP := TOS+1;                                              08568000
            ASSEMBLE(XCH,SUB);<<COMPUTE LENGTH>>                        08570000
            IF TYPE=OTYP AND S0>3 OR TYPE=HTYP AND S0>2                 08572000
               THEN GOTO ERROR; <<TOO MANY DIGITS>>                     08574000
            J := TOS;   <<# OF DIGITS>>                                 08576000
            @PNTR := TOS;<<START FIRST DIGIT IN THIS NUM>>              08578000
            IF TYPE=OTYP THEN                                           08580000
              BEGIN <<OCTAL>>                                           08582000
              I := -1;                                                  08584000
              WHILE(I:=I+1)<J DO                                        08586000
                IF PNTR(I)>%67 THEN GOTO ERROR;<<NOT OCTAL>>            08588000
              PNTR(-1):="%";                                            08590000
              ADDR(LEN) := BINARY(PNTR(-1),J+1);                        08592000
              END                                                       08594000
            ELSE                                                        08596000
              BEGIN <<HEX>>                                             08598000
              I := J;                                                   08600000
              WHILE(I:=I-1)>=0 DO                                       08602000
                BEGIN                                                   08604000
                X := PNTR(I);                                           08606000
                IF ("0"<=X<="9") THEN TOS:=X-%60                        08608000
                ELSE IF ("A"<=X<="F") THEN TOS:=X-%67                   08610000
                     ELSE GOTO ERROR;                                   08612000
                END;                                                    08614000
              IF J=2 THEN                                               08616000
                BEGIN <<TWO DIGITS IN THIS NUMBER>>                     08618000
                TOS := TOS*%20;                                         08620000
                TOS := TOS+TOS; <<ADD TOP TWO WORDS>>                   08622000
                END;                                                    08624000
              ADDR(LEN):=TOS;                                           08626000
              END;                                                      08628000
            LEN := LEN+1;                                               08630000
            IF NOT FINISHED THEN                                        08632000
              BEGIN                                                     08634000
              TOS := TEMP;                                              08636000
              GOTO NEXTNUM;                                             08638000
              END;                                                      08640000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           08642000
            TOS := TEMP-1;                                              08644000
            IF BPS0<>")" THEN GOTO ERROR;                               08646000
            TOS := TOS+1;                                               08648000
            SCAN * WHILE BLANK;                                         08650000
            IF NOCARRY THEN GOTO ERROR;                                 08652000
            END;                                                        08654000
        GETSEQ := TYPE&LSL(6)+LEN;                                      08656000
        END <<GETSEQ>>;                                                 08658000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>08660000
                                                                        08662000
           <<-------------                                              08664000
             FIND VOLUME                                                08666000
           ------------->>                                              08668000
  INTEGER PROCEDURE FINDVOL(NAME);                                      08670000
    BYTE ARRAY NAME;          <<VOLUME NAME>>                           08672000
    OPTION PRIVILEGED,UNCALLABLE;                                       08674000
      BEGIN                                                             08676000
        INTEGER I:=0;                                          <<01549>>08678000
          WHILE (I:=I+1) <= HVOL DO                                     08680000
            BEGIN                                                       08682000
              TOS := @VTAB(I*VTABSIZE)&LSL(1);   <<PTR TO NAME>>        08684000
              IF *=NAME,(8) THEN                                        08686000
                BEGIN   <<MATCH>>                                       08688000
                  FINDVOL := X;                                         08690000
                  CC := CCE;                                            08692000
                  RETURN;                                               08694000
                END;                                                    08696000
            END;                                                        08698000
          CC := CCG;   <<NOT FOUND>>                                    08700000
      END <<FINDVOL>>;                                                  08702000
INTEGER PROCEDURE GETVOL(LDEV);                                <<01549>>08704000
  VALUE LDEV;                                                  <<01549>>08706000
  INTEGER LDEV;                                                <<01549>>08708000
  COMMENT: CONVERT LDEV TO SYSTEM DOMAIN VOLUME NUMBER.        <<01549>>08710000
  ;                                                            <<01549>>08712000
  BEGIN                                                        <<01549>>08714000
  INTEGER I := 0;                                              <<01549>>08716000
  CC := CCE;                                                   <<01549>>08718000
  IF LDEV > 0 THEN                                             <<01549>>08720000
    WHILE (I:=I+1) <= HVOL DO                                  <<01549>>08722000
      IF VTAB(I*VTABSIZE+VTAB12).VTABLDEV=LDEV THEN            <<01549>>08724000
        BEGIN  << FOUND IT >>                                  <<01549>>08726000
        GETVOL := I;                                           <<01549>>08728000
        RETURN;                                                <<01549>>08730000
        END;                                                   <<01549>>08732000
  CC := CCL;                                                   <<01549>>08734000
  END; << GETVOL >>                                            <<01549>>08736000
INTEGER PROCEDURE GETLDEV(VOLUME);                             <<01549>>08738000
  VALUE VOLUME;                                                <<01549>>08740000
  INTEGER VOLUME;                                              <<01549>>08742000
  BEGIN                                                        <<01549>>08744000
  COMMENT: CONVERT VOLUME NUMBER TO LDEV.                      <<01549>>08746000
  ;                                                            <<01549>>08748000
  IF VOLUME <= HVOL THEN                                       <<01549>>08750000
    BEGIN                                                      <<01549>>08752000
    GETLDEV := VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV;          <<01549>>08754000
    CC := CCE;                                                 <<01549>>08756000
    END                                                        <<01549>>08758000
  ELSE                                                         <<01549>>08760000
    CC := CCL;                                                 <<01549>>08762000
  END;  << GETLDEV >>                                          <<01549>>08764000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>08766000
                                                                        08768000
          <<-------------------                                         08770000
            LIST VOLUME TABLE                                           08772000
          ------------------->>                                         08774000
  PROCEDURE LISTVOL;                                                    08776000
    OPTION PRIVILEGED,UNCALLABLE;                                       08778000
        BEGIN                                                           08780000
          INTEGER I:=0,J;                                               08782000
          MOVE INBUF :=                                                 08784000
            "VOLUME #    NAME    LOG DEV # ";                           08786000
          FWRITE(LISTFNUM,INBUF,15,0);                                  08788000
  LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                         08790000
          WHILE (I:=I+1) <= HVOL DO                                     08792000
          IF VTAB(I*VTABSIZE)<>0 THEN                                   08794000
            BEGIN   <<LIVE ENTRY>>                                      08796000
              INBUF := "  ";                                            08798000
              MOVE INBUF(1) := INBUF,(12);                              08800000
              ASCII(I,10,BINBUF(3));                                    08802000
              MOVE INBUF(5) := VTAB(I*VTABSIZE),(4);                    08804000
              J := ASCII(VTAB(X:=X+12).(0:8),10,BINBUF(23));            08806000
              FWRITE(LISTFNUM,INBUF,-23-J,0);                           08808000
              IF <> THEN GOTO LISTERR;                                  08810000
            END;                                                        08812000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 08814000
          IF <> THEN GOTO LISTERR;                                      08816000
      END <<LISTVOL>> ;                                                 08818000
PROCEDURE LISTVM;                                              <<01549>>08820000
COMMENT:  PRINT LISTING OF THE VIRTUAL MEMORY ALLOCATION ON    <<01549>>08822000
THE SYSTEM VOLUMES.                                            <<01549>>08824000
;                                                              <<01549>>08826000
BEGIN                                                          <<01549>>08828000
DOUBLE  SECTORS;         << # SECTORS ALLOCATED >>             <<01549>>08830000
INTEGER LDEV,            << LDEV # OF CORRESPONDING VOLUME >>  <<01549>>08832000
        SECTORS1         = SECTORS,                            <<01549>>08834000
        SECTORS2         = SECTORS+1,                          <<01549>>08836000
        VOLUME := 0,     << VOLUME INDEX >>                    <<01549>>08838000
        J;               << LENGTH OF ASCII NUMBER >>          <<01549>>08840000
                                                               <<01549>>08842000
MOVE INBUF := "VOLUME NAME   LDEV #   VM ALLOCATION";          <<01549>>08844000
FWRITE(LISTFNUM, INBUF, 18, 0);                                <<01549>>08846000
IF <> THEN FERROR(LISTFNUM, LISTFILE);                         <<01549>>08848000
WHILE (VOLUME := VOLUME+1) <= HVOL DO                          <<01549>>08850000
  IF VTAB(VOLUME*VTABSIZE) <> 0 THEN                           <<01549>>08852000
    BEGIN                                                      <<01549>>08854000
    INBUF := "  ";                                             <<01549>>08856000
      MOVE INBUF(1) := INBUF,(INBUFLEN-1);  <<CLEAR OUT BUF>>  <<01570>>08858000
    MOVE INBUF(1) := VTAB(VOLUME*VTABSIZE), (4);  << VOL NAME>><<01549>>08860000
    LDEV := GETLDEV(VOLUME);                                   <<01549>>08862000
    ASCII(LDEV, 10, INBUF(7));                                 <<01549>>08864000
    SECTORS1 := VTAB(VOLUME*VTABSIZE+VTAB10);                  <<01549>>08866000
    SECTORS2 := VTAB(X:=X+1);                                  <<01549>>08868000
    J := DASCII( (SECTORS/1024D), 10, INBUF(12) );             <<01549>>08870000
    FWRITE(LISTFNUM, INBUF, -(J+24), %40);                     <<01549>>08872000
    IF <> THEN FERROR(LISTFNUM, LISTFILE);                     <<01549>>08874000
    END;                                                       <<01549>>08876000
FWRITE(LISTFNUM, INBUF, 0, %61);                               <<01549>>08878000
IF <> THEN FERROR(LISTFNUM, LISTFILE);                         <<01549>>08880000
END;  << LISTVM >>                                             <<01549>>08882000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>08884000
                                                                        08886000
          <<----------------------                                      08888000
            LIST LOGGING STATUS                                         08890000
          ---------------------->>                                      08892000
  PROCEDURE LISTLOG;                                                    08894000
    OPTION PRIVILEGED,UNCALLABLE;                                       08896000
      BEGIN                                                             08898000
        BYTE ARRAY EVENTS(*)=PB:=15,"LOGGING ENABLED",14,               08900000
          "JOB INITIATION",15,"JOB TERMINATION",19,"PROCESS ",          08902000
          "TERMINATION",10,"FILE CLOSE",15,"SYSTEM SHUTDOWN",10,        08904000
          "POWER FAIL",8,"SPOOLING",18,"LINE DISCONNECTION",10,         08906000
          "LINE CLOSE",9,"I/O ERROR",                          <<RH.PV>>08908000
          12,"VOLUME MOUNT",                                   <<RH.PV>>08910000
        16,"VOLUME SET MOUNT",11,"TAPE LABELS",7,"CONSOLE",    <<01762>>08912000
        18,"PROGRAM FILE EVENT",19,"CALL PROGRESS SGNLS",      <<04251>>08914000
        17,"DCE PROVIDED INFO";                                <<04251>>08916000
        INTEGER ARRAY HEAD(0:15)=PB:="TYPE         EVENT       STATUS ";08918000
        INTEGER I:=1;                                                   08920000
          MOVE INBUF := HEAD,(16);                                      08922000
          FWRITE(LISTFNUM,INBUF,-31,0);  <<PRINT HEADING>>              08924000
          IF <> THEN GOTO LISTERR;                                      08926000
          DO                                                            08928000
            BEGIN  <<LIST STATUS OF EACH LOGGING TYPE>>                 08930000
              INBUF := "  ";                                            08932000
              MOVE INBUF(1) := INBUF,(19);                              08934000
              ASCII(I,10,BINBUF(2));                                    08936000
              TOS := @BINBUF(6);                                        08938000
              X := -1;                                                  08940000
              TOS := 0;                                                 08942000
              TOS := @BS0+1;                                            08944000
              TOS := @EVENTS;                                           08946000
              WHILE (X:=X+1) < I DO                                     08948000
                BEGIN  <<FIND CORRECT MESSAGE>>                         08950000
                  TOS := TOS+S2;                                        08952000
                  MOVE * := * PB,(1),1;                                 08954000
                  ASSEMBLE(DECB);  <<POINT S-1 TO S-2;>>                08956000
                END;                                                    08958000
              ASSEMBLE(DELB,XCH; MVB PB,3);  <<MOVE MESSAGE TO BUFFER>> 08960000
              TOS := @BINBUF(27);                                       08962000
        TOS:= CTAB0(LOGBITS+I/16);         <<GET EVENT WORD>>  <<01762>>08964000
        X:= 15 - I MOD 16;                      <<EVENT BIT>>  <<01762>>08966000
              ASSEMBLE(TBC 0,X);                                        08968000
              DEL;                                                      08970000
              IF = THEN MOVE * := "OFF" ELSE MOVE * := "ON";            08972000
              FWRITE(LISTFNUM,INBUF,-30,0);                             08974000
  LISTERR:    IF <> THEN FERROR(LISTFNUM,LISTFILE);                     08976000
            END                                                         08978000
         UNTIL (I:=I+1)>LOGRMAX;                               <<00094>>08980000
<<>>                                                           <<KS.01>>08982000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 08984000
          IF <> THEN GOTO LISTERR;                                      08986000
      END <<LISTLOG>> ;                                                 08988000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>08990000
                                                                        08992000
          <<----------------                                            08994000
            LIST RIN TABLE                                              08996000
          ---------------->>                                            08998000
  PROCEDURE LISTRIN;                                                    09000000
    OPTION PRIVILEGED,UNCALLABLE;                                       09002000
      BEGIN                                                             09004000
        INTEGER I:=0;                                                   09006000
        INTEGER ARRAY HEAD(0:11)=PB:="RIN #  USERNAME.ACCTNAME";        09008000
          MOVE INBUF := HEAD,(12);                                      09010000
          FWRITE(LISTFNUM,INBUF,12,0);                                  09012000
  LISTERR:IF <> THEN FERROR(LISTFNUM,LISTFILE);                         09014000
          WHILE (I:=I+1)<=RINS DO                                       09016000
          IF RIN(I&LSL(1)).(0:2)=2 THEN                                 09018000
            BEGIN  <<A GLOBAL RIN>>                                     09020000
              INBUF := "  ";                                            09022000
              MOVE INBUF(1) := INBUF,(11);                              09024000
              ASCII(I,10,BINBUF(1)); <<RIN #>>                          09026000
              TOS := @BINBUF(7);                                        09028000
              TOS := @RIN(RIN(I&LSL(1)).(2:14))&LSL(1)+8;      <<03704>>09030000
              MOVE * := *,(8),1;  <<USERNAME>>                          09032000
              BPS1 := ".";                                              09034000
              ASSEMBLE(INCB);                                           09036000
              MOVE * := *,(8);                                          09038000
              FWRITE(LISTFNUM,INBUF,12,0);                              09040000
              IF <> THEN GOTO LISTERR;                                  09042000
            END;                                                        09044000
          FWRITE(LISTFNUM,INBUF,0,%61);                                 09046000
          IF <> THEN GOTO LISTERR;                                      09048000
      END <<LISTRIN>> ;                                                 09050000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>09052000
          <<-------------------                                         09054000
            COMPACT RIN TABLE                                           09056000
          ------------------->>                                         09058000
  PROCEDURE COMPACTRIN;                                                 09060000
    OPTION PRIVILEGED,UNCALLABLE;                                       09062000
      BEGIN                                                             09064000
        INTEGER I,J,CURFREE,CURRENT;                                    09066000
          IF GRINS=0 THEN                                               09068000
            BEGIN  <<NO GLOBAL RINS>>                                   09070000
              MINGRIN := 0;                                             09072000
              MINRIN := 5;                                              09074000
              RIN(RINS&LSL(1)+2) := 0;                                  09076000
              MOVE RIN(X:=X+1) := RIN(X:=X-1),(3);                      09078000
              RETURN;                                                   09080000
            END;                                                        09082000
          CURRENT := CURFREE := RINS&LSL(1)+6;                          09084000
          I := -1;                                                      09086000
          WHILE (I:=I+1)<GRINS DO                                       09088000
            BEGIN  <<SEARCHED FOR REFERENCED GLOBAL POSITION>>          09090000
              J := 0;                                                   09092000
              WHILE (J:=J+1) <= RINS DO                                 09094000
              IF RIN(J&LSL(1)).(0:2)=2 AND RIN(X).(2:14)=CURRENT THEN   09096000
                BEGIN  <<FOUND IT>>                                     09098000
                  RIN(X).(2:14) := CURFREE;                             09100000
                  MOVE RIN(CURFREE) := RIN(CURRENT),(12);               09102000
                  CURFREE := CURFREE+12;                                09104000
                  GOTO OUT;                                             09106000
                END;                                                    09108000
  OUT:        CURRENT := CURRENT+12;                                    09110000
            END;                                                        09112000
          RIN(RINS&LSL(1)+2) := CURFREE;                                09114000
          MINGRIN := I := (CURFREE-X-4)/12; <<MIN # OF GLOBALS>>        09116000
          RIN (X:=X+1) := GRINS;                                        09118000
          RIN(X:=X+1) := GRINS-MINGRIN;                                 09120000
          RIN(X:=X+1) := 0;                                             09122000
          IF I=GRINS THEN                                      <<00252>>09124000
            BEGIN    <<NO FREE ENTRY>>                         <<00252>>09126000
              RIN(RINS&LSL(1)+2):=0; <<CLEAR NEXT FREE>>       <<00252>>09128000
              GO TO NOFREE;                                    <<00252>>09130000
            END;                                               <<00252>>09132000
          X := CURFREE;  <<FIRST FREE ENTRY>>                           09134000
          WHILE (I:=I+1) < GRINS DO                                     09136000
            BEGIN  <<LINK UP FREE LIST>>                                09138000
              RIN(X) := X+12;                                           09140000
              RIN(X:=X+1) := 0;                                         09142000
              MOVE RIN(X:=X+1) := RIN(X:=X-1),(10);                     09144000
              X := X+11;                                                09146000
            END;                                                        09148000
          RIN(X) := 0;                                                  09150000
          MOVE RIN(X:=X+1) := RIN(X:=X-1),(11);                         09152000
  NOFREE: MINRIN := RINS+1;                                             09154000
          WHILE (MINRIN:=MINRIN-1) > 5 DO                               09156000
          IF RIN(MINRIN&LSL(1)).(0:2)=2 THEN GOTO DONE;                 09158000
  DONE:                                                                 09160000
      END <<COMPACTRIN>> ;                                              09162000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>09164000
          <<------------------------>>                         <<03544>>09166000
          << MOVE FROM DATA SEGMENT >>                         <<03544>>09168000
          <<------------------------>>                         <<03544>>09170000
PROCEDURE MOVEFDS( TARGET, DSTN, OFFSET, NUMWORDS);            <<03544>>09172000
VALUE DSTN, OFFSET, NUMWORDS;                                  <<03544>>09174000
ARRAY TARGET;      << TARGET ARRAY FOR TRANSFER >>             <<03544>>09176000
INTEGER DSTN,      << SOURCE DATA SEGMENT NO. >>               <<03544>>09178000
        OFFSET,    << STARTING OFFSET INTO DATA SEGMENT >>     <<03544>>09180000
        NUMWORDS;  << NUMBER OF WORDS TO TRANSFER >>           <<03544>>09182000
COMMENT                                                        <<03544>>09184000
THIS PROCEDURE MOVES THE SPECIFIED NO. OF WORDS FROM           <<03544>>09186000
A DATA SEGMENT INTO A DB-RELATIVE ARRAY.                       <<03544>>09188000
;                                                              <<03544>>09190000
BEGIN                                                          <<03544>>09192000
TOS := @TARGET;  << PUSH TARGET ADDRESS >>                     <<03544>>09194000
TOS := DSTN;     << PUSH DATA SEGMENT NO. >>                   <<03544>>09196000
TOS := OFFSET;   << PUSH SEGMENT OFFSET >>                     <<03544>>09198000
TOS := NUMWORDS; << PUSH NO. OF WORDS TO MOVE >>               <<03544>>09200000
ASSEMBLE( MFDS 4);   << MOVE THE WORDS >>                      <<03544>>09202000
END;   << MOVEFDS >>                                           <<03544>>09204000
          <<------------------------                                    09206000
            MOVE TABLES IN DL AREA                                      09208000
          ------------------------>>                                    09210000
  PROCEDURE MOVEDLTABLES;                                               09212000
    OPTION PRIVILEGED,UNCALLABLE;                                       09214000
    COMMENT                                                             09216000
      EXPANDS AND CONTRACTS TABLES IN THE DL AREA, USING FOLLOWING      09218000
    GLOBALS:                                                            09220000
        DLLEN - CURRENT DL AREA SIZE (NEGATIVE WORDS)                   09222000
        TABLEPTRS - ARRAY OF POINTERS TO THE TABLES                     09224000
        TABLEINCRS - ARRAY CONTAINING NUMBER OF WORDS EACH TABLE IS TO  09226000
                     BE INCREMENTED OR DECREMENTED;                     09228000
      BEGIN                                                             09230000
        INTEGER ARRAY OFFSETS(0:EXPTABLES-1)=Q;    <<OFFSET FOR EACH    09232000
                                                     EXPANDABLE TABLE>> 09234000
        INTEGER I,J,       <<LOOP CONTROL>>                             09236000
                NWORDS,    <<NUMBER OF WORDS FOR CURRENT OFFSET>>       09238000
                LASTMOVED, <<INDEX OF LAST TABLE MOVED>>                09240000
                NEWSIZE;   <<NEW SIZE OF DL AREA>>                      09242000
        SUBROUTINE EXPAND;                                              09244000
        COMMENT                                                         09246000
          EXPANDS A PORTION OF THE DL AREA BY NWORDS WORDS AND ZEROES   09248000
        THE RESULTING HOLE. IF NECESSARY, CALLS DLSIZE TO GET MORE      09250000
        SPACE. ALSO UPDATES POINTERS TO THOSE TABLES MOVED;             09252000
        BEGIN                                                           09254000
          IF NWORDS=0 THEN RETURN;                                      09256000
          IF (J:=LASTMOVED+1)=0 AND (NEWSIZE:=TABLEPTRS-NWORDS)<DLLEN   09258000
          THEN                                                          09260000
            BEGIN <<NOT ENOUGH ROOM IN DL AREA (FIRST TIME CALLED)>>    09262000
              DLLEN := DLSIZE(NEWSIZE);                                 09264000
              IF <> THEN                                                09266000
                BEGIN                                                   09268000
                  MESSAGE(85);  <<UNABLE TO OBTAIN STACK SPACE>>        09270000
                  QUIT(0);                                              09272000
                END;                                                    09274000
            END;                                                        09276000
          TOS := TABLEPTRS(J);                                          09278000
          TOS := S0-NWORDS;   <<DESTINATION FOR MOVE>>                  09280000
          ASSEMBLE(XCH,DUP);                                            09282000
          TOS := TABLEPTRS(I);                                          09284000
          ASSEMBLE(SUB,NEG; MOVE 2); <<MOVE PORTION OF TABLE>>          09286000
          PS0 := 0;                                                     09288000
          ASSEMBLE(DUP,INCB);                                           09290000
          TOS := NWORDS-1;                                              09292000
          ASSEMBLE(MOVE 3);  <<ZERO EXPANDED AREA>>                     09294000
        <<UPDATE POINTERS TO MOVED TABLES>>                             09296000
          DO TABLEPTRS(X) := TABLEPTRS(J)-NWORDS UNTIL (J:=J+1)=I;      09298000
        END <<EXPAND>> ;                                                09300000
        SUBROUTINE CONTRACT;                                            09302000
        COMMENT                                                         09304000
          CONTRACTS A PORTION OF THE DL AREA BY -NWORDS WORDS. IF THIS  09306000
        ROUTINE IS CALLED TO MOVE THE UPPER (DL) END OF THE TABLE AND   09308000
        THE CONTRACTION RESULTS IN THE TABLE BEING MORE THAN 128 WORDS  09310000
        SMALLER THAN THE CURRENT VALUE OF DL, DLSIZE IS CALLED TO RETURN09312000
        THE EXTRA SPACE. ALSO, POINTERS TO ANY AFFECTED TABLES ARE      09314000
        UPDATED ON EACH CALL;                                           09316000
        BEGIN                                                           09318000
          IF NWORDS=0 THEN RETURN;                                      09320000
          TOS := TABLEPTRS(LASTMOVED)-1;  <<DESTINATION PTR>>           09322000
          TOS := S0+NWORDS;  <<SOURCE FOR MOVE>>                        09324000
          TOS := -S0+TABLEPTRS(I+1)-1;  <<NEGATIVE WORD COUNT>>         09326000
          ASSEMBLE (MOVE 3);  <<MOVE TABLES>>                           09328000
          DO TABLEPTRS(X) := TABLEPTRS(X)-NWORDS                        09330000
          UNTIL (X:=X+1)=LASTMOVED;  <<UPDATE PTRS TO MOVED TABLES>>    09332000
          IF I<0 AND TABLEPTRS>=DLLEN+128 THEN                          09334000
            BEGIN <<RETURN SOME SPACE>>                                 09336000
              DLLEN := DLSIZE(TABLEPTRS);                               09338000
              IF <> THEN                                                09340000
                BEGIN                                                   09342000
                  MESSAGE(85);  <<UNABLE TO OBTAIN STACK SPACE>>        09344000
                  QUIT(0);                                              09346000
                END;                                                    09348000
            END;                                                        09350000
        END <<CONTRACT>> ;                                              09352000
          @BLINBUF := WORDADDRESS(BLINBUF);<<CONV TO WORD PTR>><<03704>>09354000
          @DVCLTAB := WORDADDRESS(DVCLTAB);<<CONV TO WORD PTR>><<03704>>09356000
          OFFSETS := 0;                                                 09358000
          MOVE OFFSETS(1) := OFFSETS,(EXPTABLES-1);                     09360000
          I := 0;                                                       09362000
          DO IF (NWORDS:=TABLEINCRS(I)) <> 0 THEN                       09364000
            BEGIN                                                       09366000
              X := 0;                                                   09368000
              DO OFFSETS(X) := OFFSETS(X)+NWORDS UNTIL (X:=X+1)>I;      09370000
              TABLEINCRS(I) := 0;                                       09372000
            END                                                         09374000
          UNTIL (I:=I+1) = EXPTABLES;                                   09376000
          NWORDS := OFFSETS;                                            09378000
          IF < THEN                                                     09380000
            BEGIN <<CONTRACTING TABLE>>                                 09382000
              LASTMOVED := EXPTABLES;                                   09384000
              NWORDS := OFFSETS(EXPTABLES-1);                           09386000
              I := X-1;                                                 09388000
              DO IF OFFSETS(I) <> NWORDS THEN                           09390000
                BEGIN <<NEXT PORTION OF TABLE TO BE CONTRACTED MORE,    09392000
                        SO MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T09394000
                        BEEN MOVED YET>>                                09396000
                  CONTRACT;                                             09398000
                  LASTMOVED := I+1;                                     09400000
                  NWORDS := OFFSETS(I);                                 09402000
                END                                                     09404000
              UNTIL (I:=I-1)<0;                                         09406000
              CONTRACT;   <<FINISH MOVING REST OF TABLES>>              09408000
            END                                                         09410000
          ELSE                                                          09412000
            BEGIN  <<EXPANDING TABLE>>                                  09414000
              LASTMOVED := -1; <<INDEX TO LAST TABLE MOVED>>            09416000
              I := 1;                                                   09418000
              DO IF OFFSETS(I) <> NWORDS THEN                           09420000
                BEGIN <<NEXT PORTION TO BE MOVED A DIFFERENT AMOUNT, SO 09422000
                        MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T   09424000
                        BEEN MOVED YET>>                                09426000
                  EXPAND;                                               09428000
                  LASTMOVED := I-1;                                     09430000
                  NWORDS := OFFSETS(I);                                 09432000
                END                                                     09434000
              UNTIL (I:=I+1)=EXPTABLES;                                 09436000
              EXPAND; <<FINISH MOVING REST OF TABLES>>                  09438000
            END;                                                        09440000
          @BLINBUF := @BLINBUF&LSL(1); <<RETURN TO BYTE PTR>>  <<03704>>09442000
          @DVCLTAB := @DVCLTAB&LSL(1); <<CONVERT TO BYTE PTR>> <<03704>>09444000
          @TEMPCLASS:=@TCLASS&LSL(1);                          <<03704>>09446000
      END <<MOVEDLTABLES>> ;                                            09448000
$PAGE "TAPE DUMP PROCEDURES"                                            09450000
INTEGER PROCEDURE FLBLCHECKSUM( FLBLBUF);                      <<03604>>09452000
   LOGICAL ARRAY FLBLBUF;                                      <<03604>>09454000
BEGIN                                                          <<03604>>09456000
   << COMPUTE NEW CHECKSUM >>                                  <<03604>>09458000
   X := 127;                                                   <<03604>>09460000
   TOS := -1;                                                  <<03604>>09462000
   DO BEGIN                                                    <<03604>>09464000
      IF X <> FLCHECKSUMX AND X <> FLMISCX AND                 <<03604>>09466000
         X <> FLCLIDX THEN                                     <<03604>>09468000
         TOS := TOS XOR FLBLBUF(X);                            <<03604>>09470000
      X := X-1;                                                <<03604>>09472000
      END UNTIL <;                                             <<03604>>09474000
   FLBLCHECKSUM := TOS;                                        <<03604>>09476000
END;                                                           <<03604>>09478000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>09480000
                                                                        09482000
   PROCEDURE MASSAGEININ(LDEV,EOF,DISKADR);                             09484000
     VALUE LDEV,EOF,DISKADR;                                            09486000
     INTEGER LDEV;                                                      09488000
     DOUBLE EOF,DISKADR;                                                09490000
       BEGIN                                                            09492000
       INTEGER DISKADR1=DISKADR,                                        09494000
                DISKADR2=DISKADR+1,                                     09496000
                NUMFULL,                                                09498000
                NUMEXTRA,                                               09500000
                ININSIZE,                                      <<03604>>09502000
                LSTT,                                                   09504000
                ISTT;                                                   09506000
      EQUATE MAXININSIZE = 4480;  << SIZE OF LBUF >>           <<01997>>09508000
      INTEGER ARRAY STT(0:383),                                <<01997>>09510000
                    BUFFER(*) = LBUF; <<BUFFER FOR ININ FILE>> <<01997>>09512000
      DOUBLE ARRAY DBUFR(*)=LBUF;                              <<01997>>09514000
      INTEGER POINTER CODE,PROG,OSTT,BUFR;                              09516000
      EQUATE OBS  = 73,    <<OUTER BLOCK LENGTH>>                       09518000
             LENT = 70,    <<LAST ENTRY INDEX FOR TABLE IN OB>>         09520000
             RECL = 128;   <<RECORD LENGTH>>                            09522000
      INTEGER I,J;                                                      09524000
                                                                        09526000
  COMMENT                                                               09528000
                                                                        09530000
    THIS PROCEDURE REFORMATS THE NEW ININ FILE & WRITE IT TO TAPE.      09532000
    REFORMATTING IS DONE BY REASSIGNING THE STT NUMBERS ASSIGNED        09534000
    BY THE SEGMENTER. THE DUMMY OUTER BLOCK SPACE WILL BE REALEASED     09536000
    BY MOVING THE PROGRAM CODE OVER IT.  THE OUTER BLOCK IS ASSUMED     09538000
    TO BE THE FIRST THING IN THE FILE & FILE ASSUMED TO BE 1 EXTENT.    09540000
                                                                        09542000
    N.B. ININ MAY HAVE ONLY 1 INTERNAL PROCEDURE.                       09544000
                                                                        09546000
    THERE WILL BE AN AREA OF GARBAGE BETWEEN THE CODE AND STT           09548000
    AS THE SEGMENT LENGTH WILL BE LEFT UNCHANGED. A PROCEDURE'S         09550000
    ADDRESS IN THE SEGMENT IS TO FOUND BY SUBTRACTING THE               09552000
    OUTER BLOCK LENGTH FROM THE ADDRESS FOUND ON THE PMAP.              09554000
                                                                        09556000
    ;                                                                   09558000
                                                                        09560000
      SUBROUTINE IOERRCHECK(B,A);                                       09562000
        VALUE B,A;                                                      09564000
        INTEGER B,A;                                                    09566000
          BEGIN                                                         09568000
          TOS := B.(8:8);                                               09570000
          IF S0<> 1 THEN                                                09572000
            BEGIN                                                       09574000
            TOS := -TOS;                                                09576000
            FERROR(*,FULLNAME);                                         09578000
            END;                                                        09580000
          DEL;                                                          09582000
      END <<IOERRCHECK>>;                                               09584000
                                                                        09586000
          IF FLNUMEXTS>0 THEN                                           09588000
            BEGIN <<EXPECT 1 EXTENT>>                                   09590000
            MESSAGE(119);                                               09592000
            PURGETEMPSL;                                                09594000
            END;                                                        09596000
          @PROG := @BUFFER+FLSECTOFF&LSL(7);                            09598000
          @CODE := @PROG+RECL;                                          09600000
          @BUFR := @BUFFER;                                             09602000
          TOS := INTEGER(EOF)+FLSECTOFF;                                09604000
          ININSIZE := S0&LSL(7);                               <<03604>>09606000
          IF S0&LSL(7) > MAXININSIZE THEN                      <<01997>>09608000
             BEGIN                                             <<01997>>09610000
             MESSAGE(197); << MAX ININ SIZE EXCEEDED >>        <<01997>>09612000
             PURGETEMPSL;                                      <<01997>>09614000
             END;                                              <<01997>>09616000
          TOS := 8;                                                     09618000
          ASSEMBLE(DIV);                                                09620000
          NUMEXTRA := TOS&LSL(7);                                       09622000
          NUMFULL := TOS;                                               09624000
          J := -1;                                                      09626000
          WHILE(J:=J+1)<NUMFULL DO                                      09628000
            BEGIN                                                       09630000
            TOS := ATTACHIO(LDEV,0,0,@BUFR,0,1024,DISKADR1,DISKADR2,1); 09632000
            IOERRCHECK(*,*);                                            09634000
            DISKADR := DISKADR+8D;                                      09636000
            @BUFR := @BUFR+1024;                                        09638000
            END;                                                        09640000
          IF NUMEXTRA>0 THEN                                            09642000
            BEGIN                                                       09644000
            TOS := ATTACHIO(LDEV,0,0,@BUFR,0,NUMEXTRA,DISKADR1,         09646000
                                             DISKADR2,1);               09648000
            IOERRCHECK(*,*);                                            09650000
            END;                                                        09652000
                                                                        09654000
          <<BUILD THE STT REMAPPING ARRAY>>                             09656000
                                                                        09658000
          STT := 0;                                                     09660000
          MOVE STT(1) := STT,(383);                            <<01997>>09662000
          FOR I:=0 STEP 2 UNTIL LENT DO                                 09664000
            STT(CODE(I+1).(8:8)) := CODE(I);                            09666000
                                                                        09668000
          <<ADD ENTRIES FROM EXTERNAL LIST AND FIXUP LIST>>             09670000
                                                                        09672000
          I := 37;                                                      09674000
          J := PROG(13)*RECL;  <<START OF EXTERNAL LIST>>               09676000
          WHILE PROG(J)<>0 DO                                           09678000
            BEGIN                                                       09680000
            J := J+PROG(J).(4:4)&LSR(1)+2; <<STEP TO STT# IN ENTRY>>    09682000
            STT(PROG(J).(0:8)) := (I:=I+1);  <<SET TABLE>>              09684000
            PROG(J).(0:8) := I;   <<SE NEW STT>>                        09686000
            J := J+2;  <<STEP OVER JUNK TO NEXT ENTRY>>                 09688000
            END;                                                        09690000
          LSTT := I;     <<STT LENGTH FOR NEW ININ>>                    09692000
                                                                        09694000
          <<CHANGE STT#'S IN PCAL'S AND LLBL'S>>                        09696000
                                                                        09698000
          FOR I:=OBS UNTIL PROG(%35).(1:15)-1 DO                        09700000
            IF %33401<=CODE(I)<=%33777 OR %31001<=CODE(I)<=%31377 THEN  09702000
              BEGIN                                                     09704000
              TOS := STT(CODE(I).(8:8));                                09706000
              IF = THEN                                                 09708000
                BEGIN                                                   09710000
                DEL;                                                    09712000
                TOS := 37;                                              09714000
                ISTT := X;                                              09716000
                END;                                                    09718000
              CODE(I) := CODE(I).(0:8)&LSL(8)+TOS;                      09720000
              END;                                                      09722000
                                                                        09724000
          <<BUILD THE NEW STT IN STT ARRAY>>                            09726000
                                                                        09728000
          @OSTT := @CODE(I-1);                                          09730000
          FOR I:=0 STEP 2 UNTIL LENT DO                                 09732000
            STT(CODE(I)) := OSTT(-CODE(I+1).(8:8))-OBS;                 09734000
          STT(0) := LSTT+%40000;                                        09736000
          FOR I:=38 UNTIL LSTT DO STT(I) := -1;                         09738000
          STT(37) := OSTT(-ISTT)-OBS;  <<SET INTERNAL STT VALUE>>       09740000
                                                                        09742000
          <<MOVE CODE BLOCK AND ADD NEW STT>>                           09744000
                                                                        09746000
          MOVE CODE:=CODE(OBS),(PROG(%35).(1:15)-OBS);                  09748000
          FOR I:=0 UNTIL LSTT DO                                        09750000
            OSTT(-I) := STT(I);                                         09752000
                                                                        09754000
          <<SET LABEL AND WRITE OUT TO TAPE>>                           09756000
                                                                        09758000
          MOVE BUFFER := "ININ    ";                                    09760000
          MOVE BUFFER(4) := "PUB     ";                                 09762000
          MOVE BUFFER(8) := "SYS     ";                                 09764000
          MOVE BUFFER(12) := "MANAGER ";                                09766000
          BUFFER(21) := %4000;  <<L:ANY/X:NOBODY>>                      09768000
          BUFFER(20) := %20202; <<R,A,W:ANY>>                           09770000
          BUFFER(22) := 1;      <<SECURE>>                              09772000
          BUFFER(36) := 1;      <<FOPTIONS>>                            09774000
          DBUFR(21)  := EOF;                                            09776000
          BUFFER(FLCHECKSUMX) := FLBLCHECKSUM( BUFFER);        <<03604>>09780000
          WRITETAPE( BUFFER, ININSIZE, 0);                     <<03604>>09782000
      END <<MASAGEININ>>;                                               09784000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>09786000
                                                               <<00072>>09788000
PROCEDURE NEXTREEL;                                            <<00072>>09790000
BEGIN                                                          <<00072>>09792000
INTEGER ARRAY HEADER (*) = PB:="SYSDUMP/INITIAL DISC",30(0);   <<04659>>09794000
INTEGER ARRAY BUF(0:3);                                        <<00072>>09796000
INTEGER ARRAY BUFF(0:39);                                      <<00072>>09798000
INTEGER LENGTH;                                                <<00072>>09800000
BYTE ARRAY BBUF(*)=BUF;                                        <<00072>>09802000
EQUATE CR=%15,                                                 <<00072>>09804000
       LF=%12;                                                 <<00072>>09806000
                                                               <<00072>>09808000
MOVE BUFF:=HEADER,(40);                                        <<00072>>09810000
BUFF(10):=REELNUM;                                             <<00072>>09812000
BUFF(11):=DATE;                                                <<00072>>09814000
BUFF(12):=TIME1;                                               <<00072>>09816000
BUFF(13):=TIME2;                                               <<00072>>09818000
FWRITE(TAPEFNUM,BUFF,40,0);                                    <<00072>>09820000
IF > THEN FERROR(TAPEFNUM,TAPEFILE);                           <<00493>>09822000
IF < THEN                                                      <<00493>>09824000
  BEGIN                                                        <<00493>>09826000
  FCHECK(TAPEFNUM,ERRORCODE);                                  <<00493>>09828000
  IF ERRORCODE<>EOTCODE THEN                                   <<00493>>09830000
    FERROR(TAPEFNUM,TAPEFILE);                                 <<00493>>09832000
  END;                                                         <<00493>>09834000
FCONTROL(TAPEFNUM,6,I);                                        <<00493>>09836000
FCONTROL(TAPEFNUM,6,I);                                        <<00493>>09838000
FCONTROL(TAPEFNUM,9,I);                                        <<00493>>09840000
MESSAGE(172); <<MOUNT NEXT REEL>>                              <<00072>>09842000
REELNUM:=REELNUM+1;                                            <<00072>>09844000
BUFF(10):=REELNUM;                                             <<00072>>09846000
LENGTH:=ASCII(REELNUM,10,BBUF);                                <<00072>>09848000
BBUF(LENGTH):=CR;                                              <<00072>>09850000
BBUF(LENGTH+1):=LF;                                            <<00072>>09852000
PRINT(BUF,-LENGTH,0);                                          <<00072>>09854000
FWRITE(TAPEFNUM,BUFF,40,0);                                    <<00072>>09856000
IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                          <<00072>>09858000
END;                                                           <<00072>>09860000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>09862000
                                                               <<00072>>09864000
                                                                        09866000
          <<-------------------                                         09868000
            DUMP FILE TO TAPE                                           09870000
          ------------------->>                                         09872000
  PROCEDURE FDUMP(FILENAME);                                            09874000
  BYTE ARRAY FILENAME;                                                  09876000
    OPTION PRIVILEGED,UNCALLABLE;                                       09878000
      BEGIN                                                             09880000
        DOUBLE DISCADR,EOF,WORDS;                              <<03604>>09882000
        BYTE VOLUME = DISCADR;                                 <<03604>>09884000
        INTEGER I,J,LDEV,EXTSIZE,NX,LEN,                       <<03604>>09886000
                FILENUM, K:=0,                                          09888000
                  DISCADR1=DISCADR,DISCADR2=DISCADR+1;         <<03604>>09890000
        LOGICAL SECTORS;                                       <<03604>>09892000
        LOGICAL CHANGE := FALSE;                                        09894000
        DOUBLE POINTER DPS0=S-0, DPS1=S-1;                     <<00928>>09896000
        EQUATE NEXEC=7;  <<# OF EXECUTABLE FILES>>             <<04659>>09898000
        BYTE ARRAY                                             <<04659>>09900000
           EXECS  (*) = PB :=     <<executable system files>>  <<04659>>09902000
              "SYSDUMP ", "SEGPROC ", "SEGDVR  ",              <<04659>>09904000
              "LOAD    ", "PVINIT  ", "MAKECAT ", "STORE   ";  <<04659>>09906000
        SUBROUTINE IOERRCHECK(B,A);                                     09908000
        VALUE B,A;                                                      09910000
        INTEGER B,A;                                                    09912000
         BEGIN                                                          09914000
          TOS := B.(8:8);                                               09916000
          IF S0 <> 1 THEN                                               09918000
            BEGIN   <<I/O ERROR>>                                       09920000
              TOS := -TOS;                                              09922000
              FERROR(*,FULLNAME);                                       09924000
            END;                                                        09926000
          DEL;                                                          09928000
        END <<IOERRCHECK>> ;                                            09930000
        SUBROUTINE SETLAB;                                              09932000
        BEGIN                                                           09934000
          MOVE BLBUF := FILENAME,(8);                                   09936000
          MOVE LBUF(4) :=  "PUB     ";                                  09938000
          MOVE LBUF(8) :=  "SYS     ";                                  09940000
          MOVE LBUF(12) := "MANAGER ";                                  09942000
          DO IF FILENAME=EXECS(K*8),(8) THEN                            09944000
            BEGIN  <<EXECUTABLE>>                                       09946000
              TOS := %4040; <<L,X:ANY>>                                 09948000
              GOTO SETSEC;                                              09950000
            END                                                         09952000
          UNTIL (K:=K+1) = NEXEC;                                       09954000
          TOS := %4000; <<L:ANY/X:NOBODY>>                              09956000
  SETSEC: LBUF(21) := TOS;  <<SECURITY>>                                09958000
          LBUF(20) := %20202;  <<R,A,W:ANY>>                            09960000
          LBUF(22) := 1;  <<SECURE>>                                    09962000
          LBUF(36) := 1;   <<FOPTIONS>>                                 09964000
          DLBUF(21) := EOF;                                             09966000
          LBUF(FLCHECKSUMX) := FLBLCHECKSUM( LBUF);            <<03604>>09968000
        END <<SETLAB>> ;                                                09970000
          CHANGE := SEARCH'SYSFILE( FILENAME);                 <<02516>>09974000
          IF FULLNAME="SL.PUB.SYS " OR                         <<04252>>09976000
             FULLNAME="TEMPSL.PUB.SYS " THEN                   <<04252>>09978000
         FILENUM:=FOPEN(FULLNAME,%(2)10000000011,%(2)11110000) <<04252>>09980000
          ELSE                                                 <<04252>>09982000
         FILENUM:=FOPEN(FULLNAME,%(2)10000000011,%(2)11010000);<<04252>>09984000
          IF <> THEN                                                    09986000
            BEGIN   <<OPEN ERROR>>                                      09988000
              FCHECK(FILENUM,I);                                        09990000
              IF NOT (50<=I<=53) THEN <<ERROR OTHER THAN NOT FOUND>>    09992000
           IF FULLNAME <> "MPECHECK.PUB.SYS" THEN              <<00598>>09994000
  FERR:         FERROR(FILENUM,FULLNAME);                               09996000
              TOS := @BPNOTDUMP;  <<FILES NOT DUMPED PTR>>              09998000
              TOS := S0+1;                                              10000000
              TOS := @FULLNAME;                                         10002000
  NEXTCHAR:   MOVE * := * WHILE AN,0;                                   10004000
              IF BPS0 = "." THEN                                        10006000
                BEGIN   <<PART OF NAME>>                                10008000
                  MOVE * := *,(1),1;                                    10010000
                  GOTO NEXTCHAR;                                        10012000
                END;                                                    10014000
              DEL;                                                      10016000
              IF CHANGE THEN                                            10018000
                BEGIN   <<INCLUDE OLD NAME ALSO>>                       10020000
                  MOVE * := " (",2;                                     10022000
                  MOVE * := FILENAME WHILE AN,1;  <<OLD NAME>>          10024000
                  BPS0 := ")";                                          10026000
                  TOS := TOS+1;                                         10028000
                END;                                                    10030000
              ASSEMBLE(SUB,NEG);   <<LENGTH OF ENTRY>>                  10032000
              BPNOTDUMP := S0;                                          10034000
              @BPNOTDUMP := TOS+@BPNOTDUMP;                             10036000
              RETURN;                                                   10038000
            END;                                                        10040000
          IF FULLNAME="SL.PUB.SYS " OR                         <<04252>>10042000
             FULLNAME="TEMPSL.PUB.SYS " THEN                   <<04252>>10044000
          BEGIN                                                <<04252>>10046000
            TOS := FILENUM;                                    <<04252>>10048000
            IF SIRS THEN TOS:=0 ELSE TOS := -1;                <<04252>>10050000
            FLOCK(*,*);                                        <<04252>>10052000
            IF < THEN GO FERR;                                 <<04252>>10054000
            IF > THEN FERROR(1024,FULLNAME);  <<BUSY>>         <<04252>>10056000
          END;                                                 <<04252>>10058000
          FGETINFO(FILENUM,,,,,,LDEV,,,,EOF,,,,,EXTSIZE,,,,    <<03604>>10060000
               DISCADR);                                       <<03604>>10062000
          IF <> THEN GOTO FERR;                                         10064000
          VOLUME := 0; << ZERO LDN >>                          <<03604>>10066000
          TOS := ATTACHIO(LDEV,0,0,@FLAB,0,128,DISCADR1,       <<03604>>10068000
                   DISCADR2,1);                                <<03604>>10070000
          IOERRCHECK(*,*);                                              10072000
                                                               <<00928>>10074000
          << ADD FILE SPACE TO TOTAL SYSTEM FILE SPACE >>      <<00928>>10076000
          TOS := @FLEXTMAP;                                    <<00928>>10078000
          X := FLNUMEXTS;                                      <<00928>>10080000
          TOS := 0;                                            <<00928>>10082000
          DO BEGIN                                             <<00928>>10084000
             IF DPS1(X) <> 0D THEN TOS := TOS+1;               <<00928>>10086000
             X := X-1;                                         <<00928>>10088000
             END UNTIL <;                                      <<00928>>10090000
          NX := TOS;                                           <<00928>>10092000
          TOS := IF DPS0(FLNUMEXTS) = 0D THEN                  <<00928>>10094000
             LOGICAL(NX) ** LOGICAL(EXTSIZE)                   <<00928>>10096000
          ELSE                                                 <<00928>>10098000
             << LAST EXTENT MAYBE SHORTER >>                   <<00928>>10100000
             (LOGICAL(NX)-1)**LOGICAL(EXTSIZE)+DOUBLE(FLLASTEXTSIZE);   10102000
          SYSTEMFILESPACE := SYSTEMFILESPACE+TOS;              <<00928>>10104000
                                                               <<00928>>10106000
          IF CHANGE AND FILENAME="ININ    " THEN                        10108000
            BEGIN                                                       10110000
            MASSAGEININ(LDEV,EOF,DISCADR);                     <<03604>>10112000
            GO EXIT;                                                    10114000
            END;                                                        10116000
            << CONVERT VOLUME #'S IN EXTENT MAP TO LDEV #'S >> <<03623>>10120000
          VTABTOLDEV(FLEXTMAP,FLEXTMAP,FLNUMEXTS+1,FLMVTABX);  <<03623>>10122000
                                                               <<03623>>10124000
          I := 0;                                              <<03604>>10126000
          DO BEGIN                                             <<03604>>10128000
             SECTORS := IF I = FLNUMEXTS THEN                  <<03604>>10130000
                FLLASTEXTSIZE ELSE EXTSIZE;                    <<03604>>10132000
             DISCADR := FLABDBL( FLEXT0+I);                    <<03604>>10134000
             IF <> THEN                                        <<03604>>10136000
                BEGIN                                          <<03604>>10138000
                LDEV := VOLUME;                                <<03623>>10140000
                VOLUME := 0;                                   <<03604>>10144000
                WORDS := SECTORS ** 128;                       <<03604>>10146000
                J := 0;                                        <<03604>>10148000
                WHILE WORDS <> 0D DO                           <<03604>>10150000
                   BEGIN                                       <<03604>>10152000
                   LEN := IF WORDS > DOUBLE(TAPERECSIZE)       <<03604>>10154000
                      THEN TAPERECSIZE ELSE LOGICAL(WORDS);    <<03604>>10156000
                   TOS := ATTACHIO( LDEV,0,0,@LBUF,0,LEN,      <<03604>>10158000
                      DISCADR1,DISCADR2,1);                    <<03604>>10160000
                   IOERRCHECK(*,*);                            <<03604>>10162000
                   IF I = 0 AND J = 0 THEN SETLAB;             <<03604>>10164000
                   FWRITE( TAPEFNUM, LBUF, LEN, 0);            <<03604>>10166000
                   IF <> THEN                                  <<03604>>10168000
                      BEGIN                                    <<03604>>10170000
                      FCHECK( TAPEFNUM, ERRORCODE);            <<03604>>10172000
                      IF ERRORCODE = EOTCODE AND FLOPPY THEN   <<03609>>10174000
                         BEGIN                                 <<03604>>10176000
                         NEXTREEL;                             <<03604>>10178000
                         END                                   <<03604>>10180000
                      ELSE                                     <<03604>>10182000
                         FERROR( TAPEFNUM, TAPEFILE);          <<03604>>10184000
                      END;                                     <<03604>>10186000
                   J := J+1;                                   <<03604>>10188000
                   DISCADR := DISCADR+DOUBLE(LEN/128);         <<03604>>10190000
                   WORDS := WORDS-DOUBLE(LEN);                 <<03604>>10192000
                   END;                                        <<03604>>10194000
                END;                                           <<03604>>10196000
             END UNTIL (I:=I+1) > FLNUMEXTS;                   <<03604>>10198000
                                                               <<03604>>10200000
EXIT:                                                          <<03604>>10202000
   FCLOSE( FILENUM, 0, 0);                                     <<03604>>10204000
   IF <> THEN FERROR( FILENAME, FULLNAME);                     <<03604>>10206000
END; << FDUMP >>                                               <<03604>>10208000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>10214000
                                                               <<00072>>10216000
                                                                        10218000
          <<-----------------------                                     10220000
            WRITE SEGMENT TO TAPE                                       10222000
          ----------------------->>                                     10224000
PROCEDURE SEGTOTAPE( RECNO, WORDS, CONTIG);                    <<03604>>10228000
   VALUE RECNO, WORDS, CONTIG;                                 <<03604>>10230000
   INTEGER RECNO, WORDS;                                       <<03604>>10232000
   LOGICAL CONTIG;                                             <<03604>>10234000
   OPTION PRIVILEGED, UNCALLABLE;                              <<03604>>10236000
BEGIN                                                          <<03604>>10238000
   INTEGER                                                     <<03604>>10240000
      LEN,                                                     <<03604>>10242000
      J := 0;                                                  <<03604>>10244000
                                                               <<03604>>10246000
   FPOINT( INITFNUM, DOUBLE(RECNO));                           <<03604>>10248000
   IF <> THEN FERROR( INITFNUM, INITFILE);                     <<03604>>10250000
                                                               <<03604>>10252000
   WHILE WORDS <> 0 DO                                         <<03604>>10254000
      BEGIN                                                    <<03604>>10256000
      LEN := IF WORDS > TAPERECSIZE THEN TAPERECSIZE           <<03604>>10258000
         ELSE WORDS;                                           <<03604>>10260000
      FREAD( INITFNUM, LBUF, LEN);                             <<03604>>10262000
      IF <> THEN FERROR( INITFNUM, INITFILE);                  <<03604>>10264000
      FWRITE( TAPEFNUM, LBUF, LEN, IF CONTIG AND J = 0 THEN    <<03604>>10266000
         %1001 ELSE 0);                                        <<03604>>10268000
      IF <> THEN FERROR( TAPEFNUM, TAPEFILE);                  <<03604>>10270000
      J := J+1;                                                <<03604>>10272000
      WORDS := WORDS-LEN;                                      <<03604>>10274000
      END;                                                     <<03604>>10276000
                                                               <<03604>>10278000
   IF CONTIG AND J <> 0 THEN                                   <<03604>>10280000
      BEGIN << CLOSE CONTIGUOUS BLOCK >>                       <<03604>>10282000
      FWRITE( TAPEFNUM, LBUF, 0, %2001);                       <<03604>>10284000
      IF <> THEN FERROR( TAPEFNUM, TAPEFILE);                  <<03604>>10286000
      END;                                                     <<03604>>10288000
END; << SEGTOTAPE >>                                           <<03604>>10290000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>10292000
INTEGER PROCEDURE CHECKSUM(TARGET,TARGETLEN,OLDCHECKSUM);      <<00150>>10294000
VALUE TARGETLEN,OLDCHECKSUM;                                   <<00150>>10296000
ARRAY TARGET;                                                  <<00150>>10298000
INTEGER TARGETLEN;                                             <<00150>>10300000
LOGICAL OLDCHECKSUM;                                           <<00150>>10302000
COMMENT:                                                       <<00150>>10304000
   USING THE VALUE OF OLDCHECKSUM AS A BASE, THE CHECKSUM      <<00150>>10306000
   OF THE TARGET ARRAY IS CALCULATED AND RETURNED AS THE       <<00150>>10308000
   VALUE OF THE PROCEDURE.                                     <<00150>>10310000
END OF COMMENT;                                                <<00150>>10312000
                                                               <<00150>>10314000
BEGIN                                                          <<00150>>10316000
INTEGER I;                                                     <<00150>>10318000
I:=0;                                                          <<00150>>10320000
DO                                                             <<00150>>10322000
   OLDCHECKSUM:=OLDCHECKSUM+TARGET(I)                          <<00150>>10324000
UNTIL (I:=I+1)=TARGETLEN;                                      <<00150>>10326000
CHECKSUM:=OLDCHECKSUM;                                         <<00150>>10328000
END;  <<CHECKSUM>>                                             <<00150>>10330000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>10334000
PROCEDURE BUILD'SIO( TAPE'FMT'TAB, CMD'TAB);                   <<02509>>10338000
   INTEGER ARRAY TAPE'FMT'TAB, CMD'TAB;                        <<02509>>10340000
BEGIN                                                          <<02509>>10342000
   ENTRY                                                       <<02509>>10344000
      BUILD'SIO'SKIP;                                          <<02509>>10346000
   EQUATE                                                      <<02509>>10348000
      BASE1 = %1400,                                           <<02509>>10350000
      BASE2 = %2000;                                           <<02509>>10352000
   DEFINE                                                      <<02509>>10354000
      ENTRY'SIZE = TAPE'FMT'TAB.(0:8)#,                        <<02509>>10356000
      ENTRIES = TAPE'FMT'TAB.(8:8)#,                           <<02509>>10358000
      LENGTH = PNTR#,                                          <<02509>>10360000
      COREADR1 = PNTR(1)#,                                     <<02509>>10362000
      COREADR2 = PNTR(2)#;                                     <<02509>>10364000
   DEFINE                                                      <<02509>>10366000
      FNUM                = CMD'TAB#,                          <<02509>>10368000
      NEXT'REC            = CMD'TAB(1)#,                       <<02509>>10370000
      REC'BEFORE'INITIAL  = CMD'TAB(2)#,                       <<02509>>10372000
      NRENT'AFTER'WCS     = CMD'TAB(3)#,                       <<02509>>10374000
      NRENT'BEFORE'WCS    = CMD'TAB(4)#,                       <<02509>>10376000
      AMIGO'REC'1         = CMD'TAB(5)#,                       <<02509>>10378000
      AMIGO'REC'2         = CMD'TAB(6)#,                       <<02509>>10380000
      WCS'REC'BEFORE'INIT = CMD'TAB(7)#,                       <<02509>>10382000
      SIO'REC'BEFORE'INIT = CMD'TAB(8)#,                       <<02509>>10384000
      AMIGO'REC'BEFORE'INIT = CMD'TAB(9)#,                     <<02509>>10386000
      BEG'OF'STACK        = 40#,                               <<02509>>10388000
      REC                 = CTPNTR#,                           <<02509>>10390000
      LEN                 = CTPNTR(1)#;                        <<02509>>10392000
   INTEGER                                                     <<02509>>10394000
      I := 0,                                                  <<02509>>10396000
      OLDBANK := 0,                                            <<02509>>10398000
      NR'RECS := 0,                                            <<02509>>10400000
      J,                                                       <<02509>>10402000
      SIZE;                                                    <<02509>>10404000
   INTEGER POINTER                                             <<02509>>10406000
      PNTR,                                                    <<02509>>10408000
      CTPNTR;                                                  <<02509>>10410000
   SUBROUTINE SAVE'IT(B'WCS,LEN');                             <<02509>>10412000
      VALUE B'WCS,LEN';                                        <<02509>>10414000
      LOGICAL B'WCS;                                           <<02509>>10416000
      INTEGER LEN';                                            <<02509>>10418000
   BEGIN                                                       <<02509>>10420000
      FWRITEDIR( FNUM,LBUF,LEN',DOUBLE(NEXT'REC));             <<02509>>10422000
      IF <> THEN QUIT(3);                                      <<02509>>10424000
      REC := NEXT'REC;                                         <<02509>>10426000
      LEN := LEN';                                             <<02509>>10428000
      IF B'WCS THEN                                            <<02509>>10430000
         NRENT'BEFORE'WCS := NRENT'BEFORE'WCS+1                <<02509>>10432000
      ELSE                                                     <<02509>>10434000
         NRENT'AFTER'WCS := NRENT'AFTER'WCS+1;                 <<02509>>10436000
      @CTPNTR := @CTPNTR(2);                                   <<02509>>10438000
      NEXT'REC := NEXT'REC+(LEN'+127)/128;                     <<02509>>10440000
   END;                                                        <<02509>>10442000
   SUBROUTINE SKIP;                                            <<02509>>10444000
   BEGIN                                                       <<02509>>10446000
      LBUF(I) := %40000;                                       <<02509>>10448000
      LBUF(I:=I+1) := 7;                                       <<02509>>10450000
      I := I+1;                                                <<02509>>10452000
   END;                                                        <<02509>>10454000
                                                               <<02509>>10456000
   SUBROUTINE READ(BANK,ADDRESS,LENGTH,JMP'TARGET);            <<02509>>10458000
      VALUE BANK,ADDRESS,LENGTH,JMP'TARGET;                    <<02509>>10460000
      INTEGER BANK,ADDRESS,LENGTH,JMP'TARGET;                  <<02509>>10462000
   BEGIN                                                       <<02509>>10464000
      IF BANK <> OLDBANK THEN                                  <<02509>>10466000
         BEGIN                                                 <<02509>>10468000
         LBUF(I) := %14000;   << SIO SET BANK >>               <<02509>>10470000
         LBUF(I:=I+1) := OLDBANK := BANK; << NEW BANK >>       <<02509>>10472000
         I:=I+1;                                               <<02509>>10474000
         END;                                                  <<02509>>10476000
      WHILE LENGTH > 0 DO                                      <<02509>>10478000
         BEGIN                                                 <<02509>>10480000
         LBUF(I) := %40000;    << SIO CONTROL >>               <<02509>>10482000
         LBUF(X:=X+1) := 6;    << READ        >>               <<02509>>10484000
         SIZE := IF LENGTH > TAPERECSIZE THEN TAPERECSIZE      <<03604>>10486000
            ELSE LENGTH;                                       <<03604>>10488000
         TOS := -SIZE;                                         <<02509>>10490000
         ASSEMBLE( TRBC 0 ); << CONVERT TO SIO READ INSTRUCTION<<02509>>10492000
         LBUF(X:=X+1) := TOS;                                  <<02509>>10494000
         LBUF(X:=X+1) := ADDRESS;                              <<02509>>10496000
         I := X+1;                                             <<02509>>10498000
         LENGTH := LENGTH-SIZE;                                <<02509>>10500000
         ADDRESS := ADDRESS+SIZE;                              <<02509>>10502000
         NR'RECS := NR'RECS+1;                                 <<02509>>10504000
         END;                                                  <<02509>>10506000
      IF JMP'TARGET <> 0 THEN                                  <<02509>>10508000
         BEGIN                                                 <<02509>>10510000
         LBUF(I) := 0;                << SIO JUMP >>           <<02509>>10512000
         LBUF(I:=I+1) := JMP'TARGET;  << JUMP TARGET >>        <<02509>>10514000
         I:=I+1;                                               <<02509>>10516000
         END;                                                  <<02509>>10518000
   END;                                                        <<02509>>10520000
   @CTPNTR := @CMD'TAB(BEG'OF'STACK+NRENT'AFTER'WCS*2);        <<02509>>10522000
   TOS := REC'BEFORE'INITIAL;                                  <<02509>>10524000
   WHILE <> DO                                                 <<02509>>10526000
      BEGIN                                                    <<02509>>10528000
      SKIP;                                                    <<02509>>10530000
      TOS:=TOS-1;         << SKIP COUNTER >>                   <<02509>>10532000
      END;                                                     <<02509>>10534000
   @PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                         <<02509>>10536000
   WHILE @PNTR <= @TAPE'FMT'TAB(ENTRIES*ENTRY'SIZE) DO         <<02509>>10538000
      BEGIN                                                    <<02509>>10540000
      READ(COREADR1,COREADR2,LENGTH,0);                        <<02509>>10542000
      @PNTR := @PNTR(ENTRY'SIZE);                              <<02509>>10544000
      END;                                                     <<02509>>10546000
   LBUF(I) := %34000;     << SIO END,I >>                      <<02509>>10548000
   LBUF(I:=I+1) := 0;                                          <<02509>>10550000
   J := I+1;                                                   <<02509>>10552000
   SAVE'IT(FALSE,J);                                           <<02509>>10554000
   ZEROBUF(LBUF,32);     << ZERO LBUF >>                       <<02509>>10556000
   NR'RECS := 1;                                               <<02509>>10558000
   I := 0;                                                     <<02509>>10560000
   READ(0,BASE2,J,BASE2);                                      <<02509>>10562000
   SAVE'IT(FALSE,32);                                          <<02509>>10564000
   REC'BEFORE'INITIAL := SIO'REC'BEFORE'INITIAL :=             <<02509>>10566000
      REC'BEFORE'INITIAL+NR'RECS;                              <<02509>>10568000
   RETURN;                                                     <<02509>>10570000
                                                               <<02509>>10572000
BUILD'SIO'SKIP:                                                <<02509>>10574000
   @CTPNTR := @CMD'TAB(BEG'OF'STACK                            <<02509>>10576000
      +(NRENT'BEFORE'WCS+NRENT'AFTER'WCS)*2);                  <<02509>>10578000
   TOS := REC'BEFORE'INITIAL-SIO'REC'BEFORE'INITIAL;           <<02509>>10580000
   WHILE <> DO                                                 <<02509>>10582000
      BEGIN                                                    <<02509>>10584000
      SKIP;                                                    <<02509>>10586000
      TOS := TOS-1;                                            <<02509>>10588000
      END;                                                     <<02509>>10590000
   READ(0,BASE1,32,BASE1);                                     <<02509>>10592000
   SAVE'IT(TRUE,I);                                            <<02509>>10594000
   J := I;                                                     <<02509>>10596000
   I := 0;                                                     <<02509>>10598000
   ZEROBUF(LBUF,32);     << ZERO LBUF >>                       <<02509>>10600000
   READ(0,BASE2,J,BASE2);                                      <<02509>>10602000
   SAVE'IT(TRUE,32);                                           <<02509>>10604000
   REC'BEFORE'INITIAL := REC'BEFORE'INITIAL+NR'RECS;           <<02509>>10606000
END;                                                           <<02509>>10608000
PROCEDURE BUILD'AMIGO( TAPE'FMT'TAB, CMD'TAB);                 <<02509>>10610000
   INTEGER ARRAY TAPE'FMT'TAB, CMD'TAB;                        <<02509>>10612000
BEGIN                                                          <<02509>>10614000
   ENTRY                                                       <<02509>>10616000
      BUILD'AMIGO'SKIP;                                        <<02509>>10618000
   DEFINE                                                      <<02509>>10620000
      ENTRY'SIZE = TAPE'FMT'TAB.(0:8)#,                        <<02509>>10622000
      ENTRIES    = TAPE'FMT'TAB.(8:8)#,                        <<02509>>10624000
      LENGTH     = PNTR#,                                      <<02509>>10626000
      COREADR1   = PNTR(1)#,                                   <<02509>>10628000
      COREADR2   = PNTR(2)#;                                   <<02509>>10630000
   DEFINE                                                      <<02509>>10632000
      FNUM                = CMD'TAB#,                          <<02509>>10634000
      NEXT'REC            = CMD'TAB(1)#,                       <<02509>>10636000
      REC'BEFORE'INITIAL  = CMD'TAB(2)#,                       <<02509>>10638000
      NRENT'AFTER'WCS     = CMD'TAB(3)#,                       <<02509>>10640000
      NRENT'BEFORE'WCS    = CMD'TAB(4)#,                       <<02509>>10642000
      AMIGO'REC'1         = CMD'TAB(5)#,                       <<02509>>10644000
      AMIGO'REC'2         = CMD'TAB(6)#,                       <<02509>>10646000
      WCS'REC'BEFORE'INIT = CMD'TAB(7)#,                       <<02509>>10648000
      SIO'REC'BEFORE'INIT = CMD'TAB(8)#,                       <<02509>>10650000
      AMIGO'REC'BEFORE'INIT = CMD'TAB(9)#,                     <<02509>>10652000
      BEG'OF'STACK        = 40#,                               <<02509>>10654000
      REC                 = CTPNTR#,                           <<02509>>10656000
      LEN                 = CTPNTR(1)#;                        <<02509>>10658000
   DEFINE                                                      <<02509>>10660000
      NR'SKIPS'TO'WCS     = LBUF(95)#,                         <<02509>>10662000
      NR'SKIPS'TO'CS80    = LBUF(96)#;                         <<02509>>10664000
   INTEGER                                                     <<02509>>10666000
      NR'RECS := 0,                                            <<02509>>10668000
      CPSIZE,                                                  <<02509>>10670000
      BASE,                                                    <<02509>>10672000
      SIZE;                                                    <<02509>>10674000
   INTEGER POINTER                                             <<02509>>10676000
      PNTR,                                                    <<02509>>10678000
      CTPNTR,                                                  <<02509>>10680000
      CPPNTR;                                                  <<02509>>10682000
   EQUATE                                                      <<02509>>10684000
      BASE1         = %7100, << MICROCODE STARTING ADDRESS >>  <<02509>>10686000
      BASE2         = %1000,                                   <<02509>>10688000
      BASE3         = %2000;                                   <<02509>>10690000
   EQUATE                                                      <<02509>>10692000
      CPRD'LEN          = %44,                                 <<02509>>10694000
      CPRD'CMD'X        =   4,                                 <<02509>>10696000
      CPRD'DSJ'ERR1'X   = %12,                                 <<02509>>10698000
      CPRD'CNT'X        = %14,                                 <<02509>>10700000
      CPRD'BANK'X       = %16,                                 <<02509>>10702000
      CPRD'ADR'X        = %17,                                 <<02509>>10704000
      CPRD'END'X        = %30,                                 <<02509>>10706000
      CPRD'XFER'X       = %35,                                 <<02509>>10708000
      CPRD'DSJ'TARGET'X =  -2,                                 <<02509>>10710000
      CPRD'DSJ'ERR2'X   = %43,                                 <<02509>>10712000
      CPSK'LEN          = %17,                                 <<02509>>10714000
      CPSK'CNT'X        =   1,                                 <<02509>>10716000
      CPSK'CMD'X        =  %4,                                 <<02509>>10718000
      CPSK'DSJ'ERR'X    = %14,                                 <<02509>>10720000
      CPEND'LEN         =   3,                                 <<02509>>10722000
      CPBASE'STAT'X     = %11,                                 <<02509>>10724000
      CPBASE'STD'LEN    = %14,                                 <<02509>>10726000
      CPBASE'FST'LEN    = %20,                                 <<02509>>10728000
      CPBASE'ENTRY      =   1,                                 <<02509>>10730000
      CPBASE'XFER'BUF   =   0,                                 <<02509>>10732000
      CPBASE'STAT'BUF   =   1,                                 <<02509>>10734000
      CPBASE'SKIPCMD'X  =   4,                                 <<02509>>10736000
      CPBASE'READCMD'X  =   3,                                 <<02509>>10738000
      CPBASE'ENDCMD'X   =   3,                                 <<02509>>10740000
      CPSTAT'ENTRY      =   5;                                 <<02509>>10742000
   <<     NOTE:   A "*" BESIDES A NUMBER INDICATES     >>      <<02509>>10744000
   <<     A LOCATION WITHIN THE CHANNEL PROGRAM        >>      <<02509>>10746000
   <<     THAT NEEDS TO BE UPDATED.                    >>      <<02509>>10748000
   ARRAY CHAN'PGM'BASE(*) = PB :=                              <<02509>>10750000
     <<  0 >>         0, << CHECKSUM / TRANSFER BUFFER >>      <<02509>>10752000
                                                               <<02509>>10754000
     <<  1 >>         0, << JMP CMD  / STATUS BUFFER   >>      <<02509>>10756000
     <<  2 >>         9, << TARGET   / STATUS BUFFER   >>      <<02509>>10758000
                                                               <<02509>>10760000
     <<  3 >>[8/8,8/19], << READ CMD / END CMD         >>      <<02509>>10762000
     <<  4 >> [8/9,8/9], << SKIP CMD / SKIP CMD        >>      <<02509>>10764000
                                                               <<02509>>10766000
     <<  5 >>     %1401, << READ STATUS                >>      <<02509>>10768000
     <<  6 >>         3, << THREE BYTES OF STATUS      >>      <<02509>>10770000
     <<  7 >>         0, << THE STATUS BUFFER ABOVE    >>      <<02509>>10772000
     << 10 >>     %2000, << WILL CONTAIN THE ERROR     >>      <<02509>>10774000
     << 11*>>         0, << STATUS RETURNED BY THE MT  >>      <<02509>>10776000
                                                               <<02509>>10778000
     << 12 >>      %600, << INT/HALT - BAD NEWS HALT   >>      <<02509>>10780000
     << 13 >>         2, << ERROR - CAUSE SYSTEM HALT! >>      <<02509>>10782000
                                                               <<02509>>10784000
     << 14 >>     %2401, << DSJ                        >>      <<02509>>10786000
     << 15 >>         0, << FINISH UP MICROCODE CL.    >>      <<02509>>10788000
     << 16 >>         0, << A-OK JUMP                  >>      <<02509>>10790000
     << 17 >>       -11; << ERROR JUMP                 >>      <<02509>>10792000
   ARRAY CHAN'PGM'READ(*) = PB :=                              <<02509>>10794000
     <<  0 >>     %2001, << SEND READ COMMAND          >>      <<02509>>10796000
     <<  1 >>         1, << ONE BYTE                   >>      <<02509>>10798000
     <<  2 >>         0,                                       <<02509>>10800000
     <<  2 >>     %2000, << START LEFT BYTE            >>      <<02509>>10802000
     <<  4*>>         0, << READ  COMMAND ADDRESS      >>      <<02509>>10804000
                                                               <<02509>>10806000
     <<  5 >>     %1000, << WAIT                       >>      <<02509>>10808000
     <<  6 >>         0,                                       <<02509>>10810000
                                                               <<02509>>10812000
     <<  7 >>     %2401, << DSJ                        >>      <<02509>>10814000
     << 10 >>         0,                                       <<02509>>10816000
     << 11 >>         0, << A-OK JUMP                  >>      <<02509>>10818000
     << 12*>>         0, << ERROR JUMP                 >>      <<02509>>10820000
                                                               <<02509>>10822000
     << 13 >>     %1400, << READ A RECORD              >>      <<02509>>10824000
     << 14*>>         0, << BYTE COUNT                 >>      <<02509>>10826000
     << 15 >>     %2100,                                       <<02509>>10828000
     << 16*>>   %100000, << BANK                       >>      <<02509>>10830000
     << 17*>>         0, << ADDRESSS                   >>      <<02509>>10832000
                                                               <<02509>>10834000
     << 20 >>         0, << JUMP                       >>      <<02509>>10836000
     << 21 >>         2, << COMPLETE TARGET            >>      <<02509>>10838000
                                                               <<02509>>10840000
     << 22 >>         0, << JUMP                       >>      <<02509>>10842000
     << 23 >>       -15, << NEXT BURST                 >>      <<02509>>10844000
                                                               <<02509>>10846000
     << 24 >>     %2007, << SEND END COMMAND           >>      <<02509>>10848000
     << 25 >>         1, << ONE BYTE                   >>      <<02509>>10850000
     << 26 >>         0,                                       <<02509>>10852000
     << 27 >>    %42000, << START RIGHT BYTE           >>      <<02509>>10854000
     << 30*>>         0, << END COMMAND ADDRESS        >>      <<02509>>10856000
                                                               <<02509>>10858000
     << 31 >>     %1402, << READ TRANSFER COUNT        >>      <<02509>>10860000
     << 32 >>         2, << TWO BYTES                  >>      <<02509>>10862000
     << 33 >>         0,                                       <<02509>>10864000
     << 34 >>     %2000,                                       <<02509>>10866000
     << 35*>>         0, << ADDRESS OF XFER BUFFER     >>      <<02509>>10868000
                                                               <<02509>>10870000
     << 36 >>     %1000, << WAIT                       >>      <<02509>>10872000
     << 37 >>         0,                                       <<02509>>10874000
                                                               <<02509>>10876000
     << 40 >>     %2401, << DSJ                        >>      <<02509>>10878000
     << 41 >>         0,                                       <<02509>>10880000
     << 42*>>         0, << A-OK JUMP                  >>      <<02509>>10882000
     << 43*>>         0; << ERROR JUMP                 >>      <<02509>>10884000
   ARRAY CHAN'PGM'SKIP(*) = PB :=                              <<02509>>10886000
     <<  0 >>     %2001, << FORWARD SPACE RECORD CMD   >>      <<02509>>10888000
     <<  1*>>         0, << NR. SKIPS TO BE PERFORMED  >>      <<02509>>10890000
     <<  2 >>         1, << ONE BYTE BURST             >>      <<02509>>10892000
     <<  3 >>   %104000, << SINGLE ADDRESS OPTION      >>      <<02509>>10894000
     <<  4*>>         0, << ADDRESS OF SKIP COMMAND    >>      <<02509>>10896000
                                                               <<02509>>10898000
     <<  5 >>     %7407, << WRITE RELATIVE MEMORY      >>      <<02509>>10900000
     <<  6 >>         0, << ZERO JUMP NEXT BURST       >>      <<02509>>10902000
                                                               <<02509>>10904000
     <<  7 >>     %1000, << WAIT                       >>      <<02509>>10906000
     << 10 >>         0,                                       <<02509>>10908000
                                                               <<02509>>10910000
     << 11 >>     %2401, << DSJ                        >>      <<02509>>10912000
     << 12 >>         0,                                       <<02509>>10914000
     << 13 >>         0, << A-OK JUMP                  >>      <<02509>>10916000
     << 14*>>         0, << ERROR JUMP                 >>      <<02509>>10918000
                                                               <<02509>>10920000
     << 15 >>         0, << JUMP                       >>      <<02509>>10922000
     << 16 >>       -15; << TO WRITE NEXT BURST        >>      <<02509>>10924000
   ARRAY CHAN'PGM'END(*) = PB :=                               <<02509>>10926000
     <<  0 >>      %600, << INT/HALT                   >>      <<02509>>10928000
     <<  1 >>         0, << GOOD CODE                  >>      <<02509>>10930000
                                                               <<02509>>10932000
     <<  2 >>        -1; << TERMINATOR                 >>      <<02509>>10934000
   SUBROUTINE SAVE'IT(B'WCS,LEN');                             <<02509>>10936000
      VALUE B'WCS,LEN';                                        <<02509>>10938000
      LOGICAL B'WCS;                                           <<02509>>10940000
      INTEGER LEN';                                            <<02509>>10942000
   BEGIN                                                       <<02509>>10944000
      FWRITEDIR( FNUM,LBUF,LEN',DOUBLE(NEXT'REC));             <<02509>>10946000
      IF <> THEN QUIT(3);                                      <<02509>>10948000
      REC := NEXT'REC;                                         <<02509>>10950000
      LEN := LEN';                                             <<02509>>10952000
      IF B'WCS THEN                                            <<02509>>10954000
         NRENT'BEFORE'WCS := NRENT'BEFORE'WCS+1                <<02509>>10956000
      ELSE                                                     <<02509>>10958000
         NRENT'AFTER'WCS := NRENT'AFTER'WCS+1;                 <<02509>>10960000
      @CTPNTR := @CTPNTR(2);                                   <<02509>>10962000
      NEXT'REC := NEXT'REC+(LEN'+127)/128;                     <<02509>>10964000
   END;                                                        <<02509>>10966000
   SUBROUTINE SKIP( CNT);                                      <<02509>>10968000
      VALUE CNT;                                               <<02509>>10970000
      INTEGER CNT;                                             <<02509>>10972000
   BEGIN                                                       <<02509>>10974000
      MOVE CPPNTR := CHAN'PGM'SKIP,(CPSK'LEN);                 <<02509>>10976000
      CPPNTR(CPSK'CNT'X) := CNT;                               <<02509>>10978000
      CPPNTR(CPSK'CMD'X) := BASE+CPBASE'SKIPCMD'X;             <<02509>>10980000
      CPPNTR(CPSK'DSJ'ERR'X) := @LBUF(CPSTAT'ENTRY)            <<02509>>10982000
         -@CPPNTR(CPSK'DSJ'ERR'X+1);                           <<02509>>10984000
      @CPPNTR := @CPPNTR+CPSK'LEN;                             <<02509>>10986000
   END;                                                        <<02509>>10988000
                                                               <<02509>>10990000
   SUBROUTINE READ( BANK, ADDRESS, LENGTH, JMP'TARGET);        <<02509>>10992000
      VALUE BANK, ADDRESS, LENGTH, JMP'TARGET;                 <<02509>>10994000
      INTEGER BANK, ADDRESS, LENGTH, JMP'TARGET;               <<02509>>10996000
   BEGIN                                                       <<02509>>10998000
      WHILE LENGTH > 0 DO                                      <<02509>>11000000
         BEGIN                                                 <<02509>>11002000
         MOVE CPPNTR := CHAN'PGM'READ,(CPRD'LEN);              <<02509>>11004000
         SIZE := IF LENGTH > TAPERECSIZE THEN TAPERECSIZE      <<03604>>11006000
            ELSE LENGTH;                                       <<03604>>11008000
         CPPNTR(CPRD'CMD'X) := BASE+CPBASE'READCMD'X;          <<02509>>11010000
         CPPNTR(CPRD'DSJ'ERR1'X) := @LBUF(CPSTAT'ENTRY)        <<02509>>11012000
            -@CPPNTR(CPRD'DSJ'ERR1'X+1);                       <<02509>>11014000
         CPPNTR(CPRD'CNT'X) := SIZE&LSL(1);                    <<02509>>11016000
         CPPNTR(CPRD'BANK'X).(8:8) := BANK;                    <<02509>>11018000
         CPPNTR(CPRD'ADR'X) := ADDRESS;                        <<02509>>11020000
         CPPNTR(CPRD'END'X) := BASE+CPBASE'ENDCMD'X;           <<02509>>11022000
         CPPNTR(CPRD'XFER'X) := BASE+CPBASE'XFER'BUF;          <<02509>>11024000
         CPPNTR(CPRD'DSJ'ERR2'X) := @LBUF(CPSTAT'ENTRY)        <<02509>>11026000
            -@CPPNTR(CPRD'DSJ'ERR2'X+1);                       <<02509>>11028000
         @CPPNTR := @CPPNTR+CPRD'LEN;                          <<02509>>11030000
         LENGTH := LENGTH-SIZE;                                <<02509>>11032000
         ADDRESS := ADDRESS+SIZE;                              <<02509>>11034000
         NR'RECS := NR'RECS+1;                                 <<02509>>11036000
         END;                                                  <<02509>>11038000
      IF JMP'TARGET <> 0 THEN                                  <<02509>>11040000
         CPPNTR(CPRD'DSJ'TARGET'X) := JMP'TARGET               <<02509>>11042000
         -(@CPPNTR(CPRD'DSJ'TARGET'X+2)-@LBUF+BASE);           <<02509>>11044000
   END;                                                        <<02509>>11046000
   @CTPNTR := @CMD'TAB(BEG'OF'STACK+NRENT'AFTER'WCS*2);        <<02509>>11048000
   BASE := BASE3;                                              <<02509>>11050000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'STD'LEN),2;              <<02509>>11052000
   @CPPNTR := TOS;                                             <<02509>>11054000
   LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;                <<02509>>11056000
                                                               <<02509>>11058000
   TOS := REC'BEFORE'INITIAL;                                  <<02509>>11060000
   IF <> THEN SKIP(*);                                         <<02509>>11062000
   @PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                         <<02509>>11064000
   WHILE @PNTR <= @TAPE'FMT'TAB(ENTRIES*ENTRY'SIZE) DO         <<02509>>11066000
      BEGIN                                                    <<02509>>11068000
      READ( COREADR1,COREADR2,LENGTH,0);                       <<02509>>11070000
      @PNTR := @PNTR(ENTRY'SIZE);                              <<02509>>11072000
      END;                                                     <<02509>>11074000
   MOVE CPPNTR := CHAN'PGM'END,(CPEND'LEN),2;                  <<02509>>11076000
   @CPPNTR := TOS;                                             <<02509>>11078000
   CPSIZE := @CPPNTR-@LBUF;                                    <<02509>>11080000
   SAVE'IT(FALSE,CPSIZE);                                      <<02509>>11082000
                                                               <<02509>>11084000
                                                               <<02509>>11086000
   NR'RECS := 1;                                               <<02509>>11088000
   BASE := BASE2;                                              <<02509>>11090000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'STD'LEN),2;              <<02509>>11092000
   @CPPNTR := TOS;                                             <<02509>>11094000
   LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;                <<02509>>11096000
   READ(0,BASE3,CPSIZE,BASE3+CPBASE'ENTRY);                    <<02509>>11098000
   CPSIZE := @CPPNTR-@LBUF;                                    <<02509>>11100000
   SAVE'IT(FALSE,CPSIZE);                                      <<02509>>11102000
                                                               <<02509>>11104000
                                                               <<02509>>11106000
   BASE := BASE1;                                              <<02509>>11108000
   ZEROBUF(LBUF,128);      << ZERO LBUF >>                     <<02509>>11110000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'FST'LEN),2;              <<02509>>11112000
   @CPPNTR := TOS;                                             <<02509>>11114000
   LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;                <<02509>>11116000
   READ(0,BASE2,CPSIZE,BASE2+CPBASE'ENTRY);                    <<02509>>11118000
   LBUF := CHECKSUM(LBUF,128,SEED);                            <<02509>>11120000
   AMIGO'REC'2 := NEXT'REC;                                    <<02509>>11122000
   SAVE'IT(FALSE,128);                                         <<02509>>11124000
   REC'BEFORE'INITIAL := AMIGO'REC'BEFORE'INITIAL :=           <<02509>>11126000
      REC'BEFORE'INITIAL+NR'RECS;                              <<02509>>11128000
   RETURN;                                                     <<02509>>11130000
                                                               <<02509>>11132000
                                                               <<02509>>11134000
BUILD'AMIGO'SKIP:                                              <<02509>>11136000
   @CTPNTR := @CMD'TAB(BEG'OF'STACK                            <<02509>>11138000
      +(NRENT'BEFORE'WCS+NRENT'AFTER'WCS)*2);                  <<02509>>11140000
   BASE := BASE2;                                              <<02509>>11142000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'STD'LEN),2;              <<02509>>11144000
   @CPPNTR := TOS;                                             <<02509>>11146000
   LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;                <<02509>>11148000
                                                               <<02509>>11150000
   TOS := REC'BEFORE'INITIAL-AMIGO'REC'BEFORE'INITIAL;         <<02509>>11152000
   IF <> THEN SKIP(*);                                         <<02509>>11154000
   READ(0,BASE1,128,BASE1+CPBASE'ENTRY);                       <<02509>>11156000
   CPSIZE := @CPPNTR-@LBUF;                                    <<02509>>11158000
   SAVE'IT(TRUE,CPSIZE);                                       <<02509>>11160000
                                                               <<02509>>11162000
                                                               <<02509>>11164000
   BASE := BASE1;                                              <<02509>>11166000
   ZEROBUF(LBUF,128);      << ZERO LBUF >>                     <<02509>>11168000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'FST'LEN),2;              <<02509>>11170000
   @CPPNTR := TOS;                                             <<02509>>11172000
   LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;                <<02509>>11174000
   READ(0,BASE2,CPSIZE,BASE2+CPBASE'ENTRY);                    <<02509>>11176000
   AMIGO'REC'1 := NEXT'REC;                                    <<02509>>11178000
   REC'BEFORE'INITIAL := REC'BEFORE'INITIAL+NR'RECS;           <<02509>>11180000
   NR'SKIPS'TO'WCS := REC'BEFORE'INITIAL-WCS'REC'BEFORE'INIT-1;<<02509>>11182000
   LBUF := CHECKSUM(LBUF,128,SEED);                            <<02509>>11184000
   SAVE'IT(TRUE,128);                                          <<02509>>11186000
                                                               <<02509>>11188000
END;                                                           <<02509>>11190000
PROCEDURE BUILD'AMIGO'SDISC( TAPE'FMT'TAB);                    <<02509>>11192000
   INTEGER ARRAY TAPE'FMT'TAB;                                 <<02509>>11194000
BEGIN                                                          <<02509>>11196000
   EQUATE                                                      <<02509>>11198000
      BASE1         =  %7100,                                  <<02509>>11200000
      BASE2         =  %2000;                                  <<02509>>11202000
   DEFINE                                                      <<02509>>11204000
      ENTRY'SIZE    =  TAPE'FMT'TAB.(0:8)#,                    <<02509>>11206000
      ENTRIES       =  TAPE'FMT'TAB.(8:8)#,                    <<02509>>11208000
      LENGTH        =  PNTR#,                                  <<02509>>11210000
      COREADR1      =  PNTR(1)#,                               <<02509>>11212000
      COREADR2      =  PNTR(2)#,                               <<02509>>11214000
      DISCADR1      =  PNTR(3)#,                               <<02509>>11216000
      DISCADR2      =  PNTR(4)#;                               <<02509>>11218000
   INTEGER                                                     <<02509>>11220000
      CPSIZE,                                                  <<02509>>11222000
      BASE,                                                    <<02509>>11224000
      SIZE,                                                    <<02509>>11226000
      SECT'CYL,                                                <<03604>>11228000
      NRSECTS,                                                 <<02509>>11230000
      MAXREAD,                                                 <<02509>>11232000
      REM;                                                     <<02509>>11234000
   DOUBLE ARRAY DISCADDRESS(0:0)=Q;                            <<02509>>11236000
   INTEGER POINTER                                             <<02509>>11238000
      PNTR,                                                    <<02509>>11240000
      CPPNTR,                                                  <<02509>>11242000
      ADRPNTR;                                                 <<02509>>11244000
   EQUATE                                                      <<02509>>11246000
      CPBASE'LEN             = %22,                            <<02509>>11248000
      CPBASE'STATBUF         =   1,                            <<02509>>11250000
      CPBASE'JMP'X           =   2,                            <<02509>>11252000
      CPBASE'FILEMASK'X      =   3,                            <<02509>>11254000
      CPBASE'READCMD'X       =   4,                            <<02509>>11256000
      CPBASE'STATCMD'X       =   5,                            <<02509>>11258000
      CPSTAT'ENTRY           =   6,                            <<02509>>11260000
      CPSTAT'CMD'X           = %12,                            <<02509>>11262000
      CPSTAT'ADR'X           = %17,                            <<02509>>11264000
      CPRD'LEN               = %40,                            <<03604>>11266000
      CPRD'SKCMD'X           =   4,                            <<03604>>11268000
      CPRD'JMP'FLOP          = %10,                            <<03604>>11270000
      CPRD'FILEMASK'X        = %15,                            <<03604>>11272000
      CPRD'CMD'X             = %24,                            <<03604>>11274000
      CPRD'CNT'X             = %26,                            <<03604>>11276000
      CPRD'BANK'X            = %30,                            <<03604>>11278000
      CPRD'ADR'X             = %31,                            <<03604>>11280000
      CPRD'DSJ'ERR'X         = %37,                            <<03604>>11282000
      CPEND'LEN              =   3;                            <<02509>>11284000
   <<     NOTE:   A "*" BESIDES A NUMBER INDICATES     >>      <<02509>>11286000
   <<     A LOCATION WITHIN THE CHANNEL PROGRAM        >>      <<02509>>11288000
   <<     THAT NEEDS TO BE UPDATED.                    >>      <<02509>>11290000
   ARRAY CHAN'PGM'BASE(*) = PB :=                              <<02509>>11292000
     <<  0 >>         0, << CHECKSUM                         >><<02509>>11294000
                                                               <<02509>>11296000
     <<  1 >>         0, << JUMP CMD  / STATUS BUFFER        >><<02509>>11298000
     <<  2*>>        15, << TARGET    / STATUS BUFFER        >><<02509>>11300000
                                                               <<02509>>11302000
     <<  3*>>         0, << FILEMASK                         >><<02509>>11304000
     <<  4 >>     %2400, << READ DATA COMMAND                >><<02509>>11306000
     <<  5 >>     %1400, << REQUEST STATUS COMMAND           >><<02509>>11308000
                                                               <<02509>>11310000
     <<  6 >>     %2010, << SEND READ STATUS CMD             >><<02509>>11312000
     <<  7 >>         2, << TWO BYTES                        >><<02509>>11314000
     << 10 >>         0,                                       <<02509>>11316000
     << 11 >>     %2000, << START LEFT BYTE                  >><<02509>>11318000
     << 12*>>         0, << STATUS COMMAND ADDRESS           >><<02509>>11320000
                                                               <<02509>>11322000
     << 13 >>     %1410, << READ STATUS                      >><<02509>>11324000
     << 14 >>         4, << FOUR BYTES OF STATUS             >><<02509>>11326000
     << 15 >>         0,                                       <<02509>>11328000
     << 16 >>     %2000, << WILL CONTAIN THE ERROR           >><<02509>>11330000
     << 17*>>         0, << STATUS RETURNED BY THE DISC      >><<02509>>11332000
                                                               <<02509>>11334000
     << 20 >>      %600, << INT/HALT - BAD NEWS HALT         >><<02509>>11336000
     << 21 >>         2; << ERROR - CAUSE SYSTEM HALT!       >><<02509>>11338000
   ARRAY CHAN'PGM'READ(*) = PB :=                              <<02509>>11340000
     <<  0 >>     %2010, << SEEK COMMAND                     >><<02509>>11342000
     <<  1 >>         6, << SIX BYTES                        >><<02509>>11344000
     <<  2 >>         0,                                       <<02509>>11346000
     <<  3 >>     %2000, << START LEFT BYTE                  >><<02509>>11348000
     <<  4*>>         0, << ADDRESS OF SEEK COMMAND          >><<02509>>11350000
                                                               <<02509>>11352000
     <<  5 >>     %1000, << WAIT                             >><<02509>>11354000
     <<  6 >>         0,                                       <<02509>>11356000
                                                               <<03604>>11358000
     <<  7 >>         0, << JUMP OVER SET FILEMASK IF FLOPPY >><<03604>>11360000
     << 10*>>         0, << 0 - 7905/06/20/25, 7 - FLOPPY    >><<03604>>11362000
                                                               <<03604>>11364000
     << 11 >>     %2010, << WRITE FILE MASK                  >><<03604>>11366000
     << 12 >>         2, << TWO BYTES                        >><<03604>>11368000
     << 13 >>         0,                                       <<03604>>11370000
     << 14 >>     %2000, << START LEFT BYTE                  >><<03604>>11372000
     << 15*>>         0, << ADDRESS OF FILEMASK              >><<03604>>11374000
                                                               <<03604>>11376000
     << 16 >>     %1000, << WAIT                             >><<03604>>11378000
     << 17 >>         0,                                       <<03604>>11380000
                                                               <<03604>>11382000
     << 20 >>     %2010, << SEND READ COMMAND                >><<03604>>11384000
     << 21 >>         2, << TWO BYTES                        >><<03604>>11386000
     << 22 >>         0,                                       <<03604>>11388000
     << 23 >>     %2000, << START LEFT BYTE                  >><<03604>>11390000
     << 24*>>         0, << ADDRESS OF READ COMMAND          >><<03604>>11392000
                                                               <<03604>>11394000
     << 25 >>     %1400, << READ DATA                        >><<03604>>11396000
     << 26*>>         0, << BYTE COUNT                       >><<03604>>11398000
     << 27 >>         0,                                       <<03604>>11400000
     << 30*>>         0, << BANK                             >><<03604>>11402000
     << 31*>>         0, << ADDRESS                          >><<03604>>11404000
                                                               <<03604>>11406000
     << 32 >>     %1000, << WAIT                             >><<03604>>11408000
     << 33 >>         0,                                       <<03604>>11410000
                                                               <<03604>>11412000
     << 34 >>     %2401, << DSJ                              >><<03604>>11414000
     << 35 >>         0,                                       <<03604>>11416000
     << 36 >>         0, << A-OK JUMP                        >><<03604>>11418000
     << 37*>>         0; << ERROR JUMP                       >><<03604>>11420000
   ARRAY CHAN'PGM'END(*) = PB :=                               <<02509>>11422000
     <<  0 >>      %600, << INT/HALT                         >><<02509>>11424000
     <<  1 >>         0, << GOOD CODE                        >><<02509>>11426000
                                                               <<02509>>11428000
     <<  2 >>        -1; << TERMINATOR                       >><<02509>>11430000
   SUBROUTINE READ(BANK,ADDRESS,DISCADR,SIZE);                 <<02509>>11432000
      VALUE BANK,ADDRESS,DISCADR,SIZE;                         <<02509>>11434000
      INTEGER BANK,ADDRESS,SIZE;                               <<02509>>11436000
      DOUBLE DISCADR;                                          <<02509>>11438000
   BEGIN                                                       <<02509>>11440000
      WHILE SIZE > 0 DO                                        <<02509>>11442000
         BEGIN                                                 <<02509>>11444000
         NRSECTS := (SIZE+127)/128;                            <<02509>>11446000
         TOS := DISCADR;                                       <<02509>>11448000
         TOS := SECT'CYL;                                      <<03604>>11450000
         ASSEMBLE( LDIV, DELB );                               <<02509>>11452000
         REM := TOS;                                           <<02509>>11454000
         MAXREAD := IF NRSECTS > SECT'CYL-REM THEN             <<03604>>11456000
            (SECT'CYL-REM)*128 ELSE SIZE;                      <<03604>>11458000
         MOVE CPPNTR := CHAN'PGM'READ,(CPRD'LEN);              <<02509>>11460000
         CPPNTR(CPRD'SKCMD'X) := BASE+@ADRPNTR-@LBUF;          <<02509>>11462000
         IF FLOPPY THEN                                        <<03604>>11464000
            CPPNTR(CPRD'JMP'FLOP) := 7                         <<03604>>11466000
         ELSE                                                  <<03604>>11468000
            CPPNTR(CPRD'FILEMASK'X) := BASE+CPBASE'FILEMASK'X; <<03604>>11470000
         CPPNTR(CPRD'CMD'X) := BASE+CPBASE'READCMD'X;          <<02509>>11472000
         CPPNTR(CPRD'CNT'X) := MAXREAD&LSL(1);                 <<02509>>11474000
         CPPNTR(CPRD'BANK'X).(8:8) := BANK;                    <<02509>>11476000
         CPPNTR(CPRD'ADR'X) := ADDRESS;                        <<02509>>11478000
         CPPNTR(CPRD'DSJ'ERR'X) := @LBUF(CPSTAT'ENTRY)-        <<02509>>11480000
            @CPPNTR(CPRD'DSJ'ERR'X+1);                         <<02509>>11482000
         @CPPNTR := @CPPNTR+CPRD'LEN;                          <<02509>>11484000
         ADRPNTR := %1000;                                     <<02509>>11486000
         TOS := L'PADR(DISCADR);                               <<02509>>11488000
         ADRPNTR(2) := TOS;                                    <<02509>>11490000
         ADRPNTR(1) := TOS;                                    <<02509>>11492000
         @ADRPNTR := @ADRPNTR+3;                               <<02509>>11494000
         DISCADR := DISCADR+D'L((MAXREAD+127)/128));           <<02509>>11496000
         ADDRESS := ADDRESS+MAXREAD;                           <<02509>>11498000
         SIZE := SIZE-MAXREAD;                                 <<02509>>11500000
         END;                                                  <<02509>>11502000
   END;                                                        <<02509>>11504000
   BASE := BASE2;                                              <<02509>>11506000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                  <<02509>>11508000
   @ADRPNTR := TOS;                                            <<02509>>11510000
   @CPPNTR := @LBUF(512);                                      <<02509>>11512000
   SECT'CYL := IF FLOPPY THEN FLOP'SEC'CYL                     <<03604>>11514000
      ELSE SEC'CYL(STYPE);                                     <<03604>>11516000
   IF NOT FLOPPY THEN                                          <<03604>>11518000
      LBUF(CPBASE'FILEMASK'X) := FILEMASK(STYPE);              <<03604>>11520000
   LBUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                <<02509>>11522000
   LBUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                  <<02509>>11524000
                                                               <<02509>>11526000
   @PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                         <<02509>>11528000
   WHILE @PNTR <= @TAPE'FMT'TAB(ENTRIES*ENTRY'SIZE) DO         <<02509>>11530000
      BEGIN                                                    <<02509>>11532000
      MOVE DISCADDRESS := DISCADR1,(2);                        <<02509>>11534000
      READ(COREADR1,COREADR2,DISCADDRESS,LENGTH);              <<02509>>11536000
      @PNTR := @PNTR(ENTRY'SIZE);                              <<02509>>11538000
      END;                                                     <<02509>>11540000
   MOVE CPPNTR := CHAN'PGM'END,(CPEND'LEN),2;                  <<02509>>11542000
   @CPPNTR := TOS;                                             <<02509>>11544000
   MOVE ADRPNTR := LBUF(512),(@CPPNTR-@LBUF(512)),2;           <<02509>>11546000
   @CPPNTR := TOS;                                             <<02509>>11548000
   CPSIZE := @CPPNTR-@LBUF;                                    <<02509>>11550000
   << COMPUTE JUMP TARGET >>                                   <<02509>>11552000
   LBUF(CPBASE'JMP'X) := @ADRPNTR-@LBUF(CPBASE'JMP'X+1);       <<02509>>11554000
   WRITETAPE(LBUF,CPSIZE,1);                                   <<02509>>11556000
   BLOCKN := BLOCKN+1;                                         <<02509>>11558000
   TEMP := FINDSDISCGAP(SDISCLDEV,BLOCKN,DISCADDRESS);         <<02509>>11560000
   IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);                <<02509>>11562000
                                                               <<02509>>11564000
   BASE := BASE1;                                              <<02509>>11566000
   ZEROBUF(LBUF,128);                                          <<02509>>11568000
   MOVE LBUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                  <<02509>>11570000
   @ADRPNTR := TOS;                                            <<02509>>11572000
   @CPPNTR := @ADRPNTR+9;                                      <<02509>>11574000
   LBUF(CPBASE'JMP'X) := @CPPNTR-@LBUF(CPBASE'JMP'X+1);        <<02509>>11576000
   IF NOT FLOPPY THEN                                          <<03604>>11578000
      LBUF(CPBASE'FILEMASK'X) := FILEMASK(STYPE);              <<03604>>11580000
   LBUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                <<02509>>11582000
   LBUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                  <<02509>>11584000
   READ(0,BASE2,DISCADDRESS,CPSIZE);                           <<02509>>11586000
   << COMPUTE ABSOLUTE JUMP TARGET >>                          <<02509>>11588000
   CPPNTR := 0;  << JUMP >>                                    <<02509>>11590000
   CPPNTR(1) := BASE2+1-(@CPPNTR(2)-@LBUF+BASE);               <<02509>>11592000
   LBUF := CHECKSUM(LBUF,128,SEED);                            <<02509>>11594000
   TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,11,128,0,2,%41);        <<02509>>11596000
   IOERRCHECK(*,*);                                            <<02509>>11598000
END;                                                           <<02509>>11600000
PROCEDURE BUILD'SIO'SDISC( TAPE'FMT'TAB);                      <<02509>>11602000
   INTEGER ARRAY TAPE'FMT'TAB;                                 <<02509>>11604000
BEGIN                                                          <<02509>>11606000
   EQUATE                                                      <<02509>>11608000
      BASE1         =  %1400,                                  <<02509>>11610000
      BASE2         =  %1000,                                  <<02509>>11612000
      BASE3         =  %2000;                                  <<02509>>11614000
   DEFINE                                                      <<02509>>11616000
      ENTRY'SIZE    =  TAPE'FMT'TAB.(0:8)#,                    <<02509>>11618000
      ENTRIES       =  TAPE'FMT'TAB.(8:8)#,                    <<02509>>11620000
      LENGTH        =  PNTR#,                                  <<02509>>11622000
      COREADR1      =  PNTR(1)#,                               <<02509>>11624000
      COREADR2      =  PNTR(2)#,                               <<02509>>11626000
      DISCADR1      =  PNTR(3)#,                               <<02509>>11628000
      DISCADR2      =  PNTR(4)#;                               <<02509>>11630000
   INTEGER                                                     <<02509>>11632000
      SIOSIZE,                                                 <<02509>>11634000
      SIOENTRY,                                                <<02509>>11636000
      BASE,                                                    <<02509>>11638000
      SIZE,                                                    <<02509>>11640000
      NRSECTS,                                                 <<02509>>11642000
      MAXREAD,                                                 <<02509>>11644000
      REM,                                                     <<02509>>11646000
      LEN;                                                     <<02509>>11648000
   DOUBLE ARRAY DISCADDRESS(0:0)=Q;                            <<02509>>11650000
   INTEGER POINTER                                             <<02509>>11652000
      PNTR,                                                    <<02509>>11654000
      SIOPNTR,                                                 <<02509>>11656000
      ADRPNTR;                                                 <<02509>>11658000
   EQUATE                                                      <<02509>>11660000
      SPRD'LEN      =  %20,                                    <<02509>>11662000
      SPEND'LEN     =    2;                                    <<02509>>11664000
   ARRAY SIO'PGM'READ(*) = PB :=                               <<02509>>11666000
     <<  0 >>  %14000,      << SET BANK TO 0               >>  <<02509>>11668000
     <<  1 >>       0,                                         <<02509>>11670000
                                                               <<02509>>11672000
     <<  2 >>  %40000,      << SEND SEEK COMMAND           >>  <<02509>>11674000
     <<  3 >>   %1200,                                         <<02509>>11676000
                                                               <<02509>>11678000
     <<  4 >>  %67776,      << SEND SEEK ADDRESS           >>  <<02509>>11680000
     <<  5*>>       0,                                         <<02509>>11682000
                                                               <<02509>>11684000
     <<  6 >>  %40000,      << SET FILEMASK                >>  <<02509>>11686000
     <<  7*>>       0,                                         <<02509>>11688000
                                                               <<02509>>11690000
     << 10 >>  %40000,      << SEND ADDRESS RECORD COMMAND >>  <<02509>>11692000
     << 11 >>   %6000,                                         <<02509>>11694000
                                                               <<02509>>11696000
     << 12 >>  %67776,      << SEND ADDRESS                >>  <<02509>>11698000
     << 13*>>       0,                                         <<02509>>11700000
                                                               <<02509>>11702000
     << 14 >>  %40000,      << SEND READ COMMAND           >>  <<02509>>11704000
     << 15 >>   %2400,                                         <<02509>>11706000
                                                               <<02509>>11708000
     << 16 >>  %14000,      << SET BANK, OF DATA           >>  <<02509>>11710000
     << 17*>>       0;                                         <<02509>>11712000
   ARRAY SIO'PGM'END(*) = PB :=                                <<02509>>11714000
     <<  0 >>  %34000,      << END WITH INTERRUPT          >>  <<02509>>11716000
     <<  1 >>       0;                                         <<02509>>11718000
   SUBROUTINE SIOREAD( ADDRESS, WORDS);                        <<02509>>11720000
      VALUE WORDS;                                             <<02509>>11722000
      INTEGER ADDRESS, WORDS;                                  <<02509>>11724000
   BEGIN                                                       <<02509>>11726000
      WHILE WORDS > 0 DO                                       <<02509>>11728000
         BEGIN                                                 <<02509>>11730000
         LEN := IF WORDS > 4096 THEN 4096 ELSE WORDS;          <<02509>>11732000
         SIOPNTR := -LEN;                                      <<02509>>11734000
         SIOPNTR(1) := ADDRESS;                                <<02509>>11736000
         @SIOPNTR := @SIOPNTR+2;                               <<02509>>11738000
         ADDRESS := ADDRESS+LEN;                               <<02509>>11740000
         WORDS := WORDS-LEN;                                   <<02509>>11742000
         END;                                                  <<02509>>11744000
      SIOPNTR(-2).(0:1) := 0; << STOP CHAIN >>                 <<02509>>11746000
   END;                                                        <<02509>>11748000
   SUBROUTINE READ(BANK,ADDRESS,DISCADR,SIZE);                 <<02509>>11750000
      VALUE BANK,ADDRESS,DISCADR,SIZE;                         <<02509>>11752000
      INTEGER BANK,ADDRESS,SIZE;                               <<02509>>11754000
      DOUBLE DISCADR;                                          <<02509>>11756000
   BEGIN                                                       <<02509>>11758000
      WHILE SIZE > 0 DO                                        <<02509>>11760000
         BEGIN                                                 <<02509>>11762000
         NRSECTS := (SIZE+127)/128;                            <<02509>>11764000
         TOS := DISCADR;                                       <<02509>>11766000
         TOS := SEC'CYL( STYPE);                               <<02509>>11768000
         ASSEMBLE( LDIV, DELB );                               <<02509>>11770000
         REM := TOS;                                           <<02509>>11772000
         MAXREAD := IF NRSECTS > SEC'CYL(STYPE)-REM THEN       <<02509>>11774000
            (SEC'CYL(STYPE)-REM)*128 ELSE SIZE;                <<02509>>11776000
         MOVE SIOPNTR := SIO'PGM'READ,(SPRD'LEN);              <<02509>>11778000
         SIOPNTR(5) := SIOPNTR(11) := @ADRPNTR-@LBUF+BASE;     <<02509>>11780000
         SIOPNTR(7) := FILEMASK( STYPE);                       <<02509>>11782000
         SIOPNTR(15) := BANK;                                  <<02509>>11784000
         @SIOPNTR := @SIOPNTR+SPRD'LEN;                        <<02509>>11786000
         SIOREAD( ADDRESS, MAXREAD);                           <<02509>>11788000
         TOS := L'PADR( DISCADR);                              <<02509>>11790000
         ADRPNTR(1) := TOS;                                    <<02509>>11792000
         ADRPNTR := TOS;                                       <<02509>>11794000
         @ADRPNTR := @ADRPNTR+2;                               <<02509>>11796000
         DISCADR := DISCADR+DOUBLE((MAXREAD+127)/128);         <<02509>>11798000
         SIZE := SIZE-MAXREAD;                                 <<02509>>11800000
         END;                                                  <<02509>>11802000
   END;                                                        <<02509>>11804000
   BASE := BASE3;                                              <<02509>>11806000
   @ADRPNTR := @LBUF;                                          <<02509>>11808000
   @SIOPNTR := @LBUF(512);                                     <<02509>>11810000
   @PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                         <<02509>>11812000
   WHILE @PNTR <= @TAPE'FMT'TAB(ENTRIES*ENTRY'SIZE) DO         <<02509>>11814000
      BEGIN                                                    <<02509>>11816000
      MOVE DISCADDRESS := DISCADR1,(2);                        <<02509>>11818000
      READ(COREADR1,COREADR2,DISCADDRESS,LENGTH);              <<02509>>11820000
      @PNTR := @PNTR(ENTRY'SIZE);                              <<02509>>11822000
      END;                                                     <<02509>>11824000
   MOVE SIOPNTR := SIO'PGM'END,(SPEND'LEN),2;                  <<02509>>11826000
   @SIOPNTR := TOS;                                            <<02509>>11828000
   MOVE ADRPNTR := LBUF(512),(@SIOPNTR-@LBUF(512)),2;          <<02509>>11830000
   @SIOPNTR := TOS;                                            <<02509>>11832000
   SIOSIZE := @SIOPNTR-@LBUF;                                  <<02509>>11834000
   SIOENTRY := @ADRPNTR-@LBUF+BASE;                            <<02509>>11836000
   WRITETAPE(LBUF,SIOSIZE,1);                                  <<02509>>11838000
   BLOCKN := BLOCKN+1;                                         <<02509>>11840000
   TEMP := FINDSDISCGAP(SDISCLDEV,BLOCKN,DISCADDRESS);         <<02509>>11842000
   IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);                <<02509>>11844000
                                                               <<02509>>11846000
   BASE := BASE2;                                              <<02509>>11848000
   @ADRPNTR := @LBUF;                                          <<02509>>11850000
   @SIOPNTR := @LBUF(512);                                     <<02509>>11852000
   READ(0,BASE3,DISCADDRESS,SIOSIZE);                          <<02509>>11854000
   SIOPNTR := 0;  << SIO JUMP >>                               <<02509>>11856000
   SIOPNTR(1) := SIOENTRY; << JUMP TARGET >>                   <<02509>>11858000
   @SIOPNTR := @SIOPNTR+2;                                     <<02509>>11860000
   MOVE ADRPNTR := LBUF(512),(@SIOPNTR-@LBUF(512)),2;          <<02509>>11862000
   @SIOPNTR := TOS;                                            <<02509>>11864000
   SIOSIZE := @SIOPNTR-@LBUF;                                  <<02509>>11866000
   SIOENTRY := @ADRPNTR-@LBUF+BASE;                            <<02509>>11868000
   TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,11,SIOSIZE,0,3,%41);    <<02509>>11870000
   IOERRCHECK(*,*);                                            <<02509>>11872000
                                                               <<02509>>11874000
   BASE := BASE1;                                              <<02509>>11876000
   TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,0,128,0,0,%41);         <<02509>>11878000
   IOERRCHECK(*,*);                                            <<02509>>11880000
   << CREATE COLD LOAD READ PROGRAM >>                         <<02509>>11882000
   LBUF := %40000;     << READ FROM SECTOR 3 >>                <<02509>>11884000
   LBUF(1) := 3;                                               <<02509>>11886000
   LBUF(2) := LOGICAL(-SIOSIZE) LAND %77777;                   <<02509>>11888000
   LBUF(3) := BASE2;                                           <<02509>>11890000
   LBUF(4) := 0;          << SIO JUMP >>                       <<02509>>11892000
   LBUF(5) := SIOENTRY;   << JUMP TARGET >>                    <<02509>>11894000
   TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,11,128,0,0,%41);        <<02509>>11896000
   IOERRCHECK(*,*);                                            <<02509>>11898000
END;                                                           <<02509>>11900000
$CONTROL SEGMENT=DUMPTAPE                                      <<03544>>11902000
        <<---------------------------------->>                 <<03544>>11904000
        << BUILD CS'80 BOOT CHANNEL PROGRAM >>                 <<03544>>11906000
        <<---------------------------------->>                 <<03544>>11908000
PROCEDURE BUILD'CS80'SDISC( TAPE'FMT'TAB);                     <<03544>>11910000
INTEGER ARRAY TAPE'FMT'TAB;                                    <<03544>>11912000
BEGIN                                                          <<03544>>11914000
EQUATE                                                         <<03544>>11916000
   BASE1         =  %7100,                                     <<03544>>11918000
   BASE2         =  %2000;                                     <<03544>>11920000
DEFINE                                                         <<03544>>11922000
   ENTRY'SIZE    =  TAPE'FMT'TAB.(0:8)#,                       <<03544>>11924000
   ENTRIES       =  TAPE'FMT'TAB.(8:8)#,                       <<03544>>11926000
   LENGTH        =  PNTR#,     << TAPE'FMT'TAB DEFINITION: >>  <<03544>>11928000
   COREADR1      =  PNTR(1)#,  << 5-WORD ENTRIES CONTAIN   >>  <<03544>>11930000
   COREADR2      =  PNTR(2)#,  << LENGTH OF TABLE (WORDS), >>  <<03544>>11932000
   DISCADR1      =  PNTR(3)#,  << DOUBLE-WORD CORE ADDRESS, >> <<03544>>11934000
   DISCADR2      =  PNTR(4)#;  << AND DOUBLE-WORD DISC ADDR >> <<03544>>11936000
INTEGER                                                        <<03544>>11938000
   CPSIZE,                                                     <<03544>>11940000
   BASE,                                                       <<03544>>11942000
   SIZE,                                                       <<03544>>11944000
   MSGLEN;                                                     <<03544>>11946000
DOUBLE ARRAY DISCADDRESS(0:0)=Q;                               <<03544>>11948000
INTEGER POINTER                                                <<03544>>11950000
   PNTR,                                                       <<03544>>11952000
   CPPNTR;                                                     <<03544>>11954000
BYTE POINTER                                                   <<03544>>11956000
   ADRPNTR,                                                    <<03544>>11958000
   APNTR;                                                      <<03544>>11960000
DEFINE                                                         <<03544>>11962000
   MEMX                   = (8:8)#;                            <<03544>>11964000
EQUATE                                                         <<03544>>11966000
   CDB'READ               =   0,                               <<03544>>11968000
   CDB'REQ'STATUS         = %15,                               <<03544>>11970000
   CDB'SET'SNGL'VEC       = %20,                               <<03544>>11972000
   CDB'SET'LENGTH         = %30,                               <<03544>>11974000
   CDB'SET'UNIT           = %40,                               <<03544>>11976000
   CDB'NO'OP              = %64,                               <<03544>>11978000
   CDB'SET'VOL            =%100,                               <<03544>>11980000
   MAXMSG                 = 768;                               <<03544>>11982000
EQUATE                                                         <<03544>>11984000
   CPBASE'LEN             = %41,                               <<03544>>11986000
   CPBASE'JMP'X           =   2,                               <<03544>>11988000
   CPBASE'STATCMD'X       =   3,                               <<03544>>11990000
   CPBASE'STATBUF         =   4,                               <<03544>>11992000
   CPSTAT'ENTRY           = %16,                               <<03544>>11994000
   CPSTAT'CMD'X           = %22,                               <<03544>>11996000
   CPSTAT'ADR'X           = %31,                               <<03544>>11998000
   CPRD'LEN               = %23,                               <<03544>>12000000
   CPRD'MSGLEN'X          =   1,                               <<03544>>12002000
   CPRD'MSGADR'X          =   4,                               <<03544>>12004000
   CPRD'CNT'X             = %10,                               <<03544>>12006000
   CPRD'BANK'X            = %12,                               <<03544>>12008000
   CPRD'ADR'X             = %13,                               <<03544>>12010000
   CPRD'DSJ'ERR1'X        = %21,                               <<03544>>12012000
   CPRD'DSJ'ERR2'X        = %22,                               <<03544>>12014000
   CPRD'DSJ'NEXT          = %23,                               <<03544>>12016000
   CPEND'LEN              =   3;                               <<03544>>12018000
<<     NOTE:   A "*" BESIDES A NUMBER INDICATES     >>         <<03544>>12020000
<<     A LOCATION WITHIN THE CHANNEL PROGRAM        >>         <<03544>>12022000
<<     THAT NEEDS TO BE UPDATED.                    >>         <<03544>>12024000
ARRAY CHAN'PGM'BASE(*) = PB :=                                 <<03544>>12026000
  <<  0*>>         0, << CHECKSUM                         >>   <<03544>>12028000
                                                               <<03544>>12030000
  <<  1 >>         0, << JUMP COMMAND                     >>   <<03544>>12032000
  <<  2*>>       %36, << JUMP TARGET                      >>   <<03544>>12034000
                                                               <<03544>>12036000
  <<  3 >>       %15, << STATUS REQUEST COMMAND           >>   <<03544>>12038000
                                                               <<03544>>12040000
  <<  4 >> 0,0,0,0,0, << STATUS BUFFER - ERROR STATUS     >>   <<03544>>12042000
  << 11 >> 0,0,0,0,0, << WILL BE RETURNED HERE!           >>   <<03544>>12044000
                                                               <<03544>>12046000
  << 16 >>     %2005, << SEND READ STATUS COMMAND         >>   <<03544>>12048000
  << 17 >>         1,                                          <<03544>>12050000
  << 20 >>         0,                                          <<03544>>12052000
  << 21 >>    %42000,                                          <<03544>>12054000
  << 22*>>         0,                                          <<03544>>12056000
                                                               <<03544>>12058000
  << 23 >>     %1000, << WAIT                             >>   <<03544>>12060000
  << 24 >>         0,                                          <<03544>>12062000
                                                               <<03544>>12064000
  << 25 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03544>>12066000
  << 26 >>        20, << #STATUS BYTES TO READ            >>   <<03544>>12068000
  << 27 >>         0, << BURST                            >>   <<03544>>12070000
  << 30 >>     %2000, << DATA BANK                        >>   <<03544>>12072000
  << 31*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03544>>12074000
                                                               <<03544>>12076000
  << 32 >>     %1000, << WAIT                             >>   <<03544>>12078000
  << 33 >>         0,                                          <<03544>>12080000
                                                               <<03544>>12082000
  << 34 >>     %2400, << REPORTING MSG SECONDARY          >>   <<03544>>12084000
  << 35 >>         0,                                          <<03544>>12086000
  << 36 >>         0,                                          <<03544>>12088000
                                                               <<03544>>12090000
  << 37 >>      %600, << INT/HALT - BAD NEWS HALT         >>   <<03544>>12092000
  << 40 >>         1; << ERROR - CAUSE SYSTEM HALT!       >>   <<03544>>12094000
ARRAY CHAN'PGM'READ(*) = PB :=                                 <<03544>>12096000
  <<  0 >>     %2005, << COMMAND MSG SECONDARY            >>   <<03544>>12098000
  <<  1*>>         0, << COMMAND MSG BUFFER LENGTH        >>   <<03544>>12100000
  <<  2 >>         0, << BURST                            >>   <<03544>>12102000
  <<  3 >>     %2000, << COMMAND BUFFER BANK              >>   <<03544>>12104000
  <<  4*>>         0, << COMMAND BUFFER ABSOLUTE ADDRESS  >>   <<03544>>12106000
                                                               <<03544>>12108000
  <<  5 >>     %1000, << WAIT                             >>   <<03544>>12110000
  <<  6 >>         0,                                          <<03544>>12112000
                                                               <<03544>>12114000
  <<  7 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03544>>12116000
  << 10*>>         0, << NUMBER OF DATA BYTES TO READ     >>   <<03544>>12118000
  << 11 >>         0, << BURST                            >>   <<03544>>12120000
  << 12*>>         0, << DATA BANK                        >>   <<03544>>12122000
  << 13*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03544>>12124000
                                                               <<03544>>12126000
  << 14 >>     %1000, << WAIT                             >>   <<03544>>12128000
  << 15 >>         0,                                          <<03544>>12130000
                                                               <<03544>>12132000
  << 16 >>     %2402, << DSJ - REPORTING PHASE            >>   <<03544>>12134000
  << 17 >>         0,                                          <<03544>>12136000
  << 20 >>         0, << A-OK JUMP                        >>   <<03544>>12138000
  << 21*>>         0, << HARD ERROR JUMP                  >>   <<03544>>12140000
  << 22*>>         0; << POWER ON JUMP                    >>   <<03544>>12142000
ARRAY CHAN'PGM'END(*) = PB :=                                  <<03544>>12144000
  <<  0 >>      %600, << INT/HALT                         >>   <<03544>>12146000
  <<  1 >>         0, << GOOD NEWS HALT!                  >>   <<03544>>12148000
                                                               <<03544>>12150000
  <<  2 >>        -1; << TERMINATOR                       >>   <<03544>>12152000
                                                               <<03544>>12154000
SUBROUTINE READ( BANK, ADDRESS, DISCADR, SIZE);                <<03544>>12156000
VALUE BANK, ADDRESS, DISCADR, SIZE;                            <<03544>>12158000
INTEGER BANK, ADDRESS, SIZE;                                   <<03544>>12160000
DOUBLE DISCADR;                                                <<03544>>12162000
                                                               <<03544>>12164000
COMMENT                                                        <<03544>>12166000
BUILDS A CHANNEL PROGRAM TO DO ONE READ                        <<03544>>12168000
;                                                              <<03544>>12170000
                                                               <<03544>>12172000
BEGIN                                                          <<03544>>12174000
SIZE := SIZE&LSL(1);                                           <<03544>>12176000
@APNTR := @ADRPNTR; << SAVE START OF CMD BUFFER >>             <<03544>>12178000
                                                               <<03544>>12180000
<< BUILD CMD BUFFER >>                                         <<03544>>12182000
                                                               <<03544>>12184000
ADRPNTR := CDB'SET'SNGL'VEC;                                   <<03544>>12186000
ADRPNTR(1) := 0;                                               <<03544>>12188000
ADRPNTR(2) := 0;                                               <<03544>>12190000
TOS := @DISCADR&LSL(1);                                        <<03544>>12192000
MOVE ADRPNTR(3) := *,(4);                                      <<03544>>12194000
ADRPNTR(7) := CDB'SET'LENGTH;                                  <<03544>>12196000
ADRPNTR(8) := 0;                                               <<03544>>12198000
ADRPNTR(9) := 0;                                               <<03544>>12200000
TOS := @SIZE&LSL(1);                                           <<03544>>12202000
MOVE ADRPNTR(10) := *,(2);                                     <<03544>>12204000
ADRPNTR(12) := CDB'READ;                                       <<03544>>12206000
MSGLEN := 13;                                                  <<03544>>12208000
@ADRPNTR := @ADRPNTR(14);                                      <<03544>>12210000
                                                               <<03544>>12212000
<< BUILD CHANNEL PROGRAM >>                                    <<03544>>12214000
                                                               <<03544>>12216000
MOVE CPPNTR := CHAN'PGM'READ,(CPRD'LEN);                       <<03544>>12218000
CPPNTR(CPRD'MSGLEN'X) := MSGLEN;                               <<03544>>12220000
CPPNTR(CPRD'MSGADR'X) := BASE+WORDADDRESS(APNTR)-@LBUF;        <<03704>>12222000
CPPNTR(CPRD'CNT'X) := SIZE;                                    <<03544>>12224000
CPPNTR(CPRD'BANK'X).MEMX := BANK;                              <<03544>>12226000
CPPNTR(CPRD'ADR'X) := ADDRESS;                                 <<03544>>12228000
CPPNTR(CPRD'DSJ'ERR1'X) := CPPNTR(CPRD'DSJ'ERR2'X) :=          <<03544>>12230000
   @LBUF(CPSTAT'ENTRY) - @CPPNTR(CPRD'DSJ'NEXT);               <<03544>>12232000
@CPPNTR := @CPPNTR+CPRD'LEN;                                   <<03544>>12234000
END;   << READ >>                                              <<03544>>12236000
                                                               <<03544>>12238000
<< BUILD LARGE CHANNEL PROGRAM WITH MANY READS TO GO >>        <<03544>>12240000
<< AT ADDRESS %2000.                                 >>        <<03544>>12242000
                                                               <<03544>>12244000
BASE := BASE2;                                                 <<03544>>12246000
MOVE LBUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                     <<03544>>12248000
@ADRPNTR := TOS&LSL(1); << MAKE BYTE ADDRESS >>                <<03544>>12250000
@CPPNTR := @LBUF(MAXMSG);                                      <<03544>>12252000
LBUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                   <<03544>>12254000
LBUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                     <<03544>>12256000
                                                               <<03544>>12258000
<< BUILD ONE READ CHANNEL PROGRAM FOR EVERY ENTRY IN >>        <<03544>>12260000
<< TAPE'FMT'TABLE                                    >>        <<03544>>12262000
                                                               <<03544>>12264000
@PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                            <<03544>>12266000
WHILE @PNTR <= @TAPE'FMT'TAB(ENTRIES*ENTRY'SIZE) DO            <<03544>>12268000
   BEGIN                                                       <<03544>>12270000
   MOVE DISCADDRESS := DISCADR1,(2);                           <<03544>>12272000
   READ(COREADR1,COREADR2,DISCADDRESS,LENGTH);                 <<03544>>12274000
   @PNTR := @PNTR(ENTRY'SIZE);                                 <<03544>>12276000
   END;                                                        <<03544>>12278000
MOVE CPPNTR := CHAN'PGM'END,(CPEND'LEN),2;                     <<03544>>12280000
@CPPNTR := TOS;                                                <<03544>>12282000
@PNTR := WORDADDRESS(ADRPNTR);  << CHANGE TO WORD PNTR >>      <<03704>>12284000
CPSIZE := @CPPNTR-@LBUF;                                       <<03544>>12286000
<< COMPUTE JUMP TARGET >>                                      <<03544>>12288000
LBUF(CPBASE'JMP'X) := @LBUF(MAXMSG)-@LBUF(CPBASE'JMP'X+1);     <<03544>>12290000
WRITETAPE(LBUF,CPSIZE,1);     << WRITE OUT CHANNEL PROGRAM >>  <<03544>>12292000
BLOCKN := BLOCKN+1;                                            <<03544>>12294000
                                                               <<03544>>12296000
<< FIND OUT WHERE ON THE SERIAL DISC THE LARGE CHANNEL >>      <<03544>>12298000
<< PROGRAM WAS PUT                                     >>      <<03544>>12300000
                                                               <<03544>>12302000
TEMP := FINDSDISCGAP(SDISCLDEV,BLOCKN,DISCADDRESS);            <<03544>>12304000
IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);                   <<03544>>12306000
                                                               <<03544>>12308000
<< NOW BUILD THE SMALL CHANNEL PROGRAM, WHICH READS IN  >>     <<03544>>12310000
<< THE LARGER ONE, TO RUN AT %7100                      >>     <<03544>>12312000
                                                               <<03544>>12314000
BASE := BASE1;                                                 <<03544>>12316000
ZEROBUF(LBUF,128);                                             <<03544>>12318000
MOVE LBUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                     <<03544>>12320000
@ADRPNTR := S0&LSL(1); << MAKE BYTE ADDRESS >>                 <<03544>>12322000
@CPPNTR := TOS+27; << ROOM FOR THREE MSG READS >>              <<03544>>12324000
LBUF(CPBASE'JMP'X) := @CPPNTR-@LBUF(CPBASE'JMP'X+1);           <<03544>>12326000
LBUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                   <<03544>>12328000
LBUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                     <<03544>>12330000
READ(0,BASE2,DISCADDRESS,CPSIZE);                              <<03544>>12332000
<< COMPUTE ABSOLUTE JUMP TARGET >>                             <<03544>>12334000
CPPNTR := 0;  << JUMP >>                                       <<03544>>12336000
CPPNTR(1) := BASE2+1-(@CPPNTR(2)-@LBUF+BASE);                  <<03544>>12338000
LBUF := CHECKSUM(LBUF,128,SEED);                               <<03544>>12340000
                                                               <<03544>>12342000
<< WRITE THIS CHANNEL PROGRAM OUT TO SECTOR 2 >>               <<03544>>12344000
                                                               <<03544>>12346000
TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,11,128,0,2,%41);           <<03544>>12348000
IOERRCHECK(*,*);                                               <<03544>>12350000
END;   << BUILD'CS80'SDISC >>                                  <<03544>>12352000
                                                               <<03544>>12354000
INTEGER PROCEDURE COMPUTE'WCS'SIZE;                            <<03005>>12356000
BEGIN                                                          <<03005>>12358000
   EQUATE                                                      <<03005>>12360000
         << TAPE WCS TABLE FORMAT >>                           <<03005>>12362000
      NR'ENTRIES        = 32,                                  <<03005>>12364000
      ENTRY'SIZE        = 4,                                   <<03005>>12366000
      WCSTAB'SIZE       = NR'ENTRIES*ENTRY'SIZE,               <<03005>>12368000
         << TAPE WCS TABLE ENTRY FORMAT >>                     <<03005>>12370000
      RECS'TO'WCS       = 0,                                   <<03005>>12372000
      RECS'OF'WCS       = 1,                                   <<03005>>12374000
      RECS'AFTER'WCS    = 2,                                   <<03005>>12376000
      WCSRECSIZE        = 3,                                   <<03604>>12378000
         << ALLOCATION OF ENTRIES IN WCS TABLE >>              <<03005>>12380000
      ICF55'TAB'X       = 4;                                   <<03005>>12382000
   EQUATE                                                      <<03005>>12384000
         << ALLOCATION OF DISC WCS POINTER ENTRIES >>          <<03005>>12386000
      ICF55'WCS'DISC'X  = 0;                                   <<03005>>12388000
   DOUBLE ARRAY                                                <<03005>>12390000
      DISCWCSTAB(*)     = LBUF(%25);                           <<03005>>12392000
   INTEGER                                                     <<03005>>12394000
      FNUM,                                                    <<03005>>12396000
      ERRNR,                                                   <<03005>>12398000
      LEN,                                                     <<03005>>12400000
      REC,                                                     <<03005>>12402000
      TOTAL'WCS'RECS = COMPUTE'WCS'SIZE,                       <<03604>>12404000
      WCSTAPERECSIZE, << IML MICROCODE CAN ONLY HANDLE       >><<04130>>12406000
                      << RECORD SIZES OF 1024,2048,3072,4096 >><<04130>>12408000
      TEMP,                                                    <<03005>>12410000
      S0 = S-0,                                                <<03005>>12412000
      X = X;                                                   <<03005>>12414000
   DOUBLE                                                      <<03005>>12416000
      DISCADDRESS;                                             <<03005>>12418000
   ENTRY                                                       <<03005>>12420000
      DUMP'WCS;                                                <<03005>>12422000
   INTEGER POINTER                                             <<03005>>12424000
      WCSTABPNTR;                                              <<03005>>12426000
   BYTE ARRAY                                                  <<03005>>12428000
      FILENAME(0:8);                                           <<03005>>12430000
   INTEGER ARRAY REC0(*) = LBUF(4096);                         <<03604>>12432000
   INTEGER ARRAY WCSTAB(*) = STT;                              <<03005>>12434000
   INTEGER ARRAY WCSFNUM(*) = STT(WCSTAB'SIZE);                <<03005>>12436000
                                                               <<03005>>12438000
   <<    ICF/55 WCS CONSTANTS    >>                            <<03005>>12440000
                                                               <<03005>>12442000
   DOUBLE ARRAY DREC0(*) = REC0;                               <<03005>>12444000
   DEFINE                                                      <<03005>>12446000
      NR'WCS'LOCS       = DREC0(2)#,                           <<03005>>12448000
      NR'LUT'LOCS       = DREC0(3)#;                           <<03005>>12450000
   BYTE ARRAY ICF55WCSNAME(*)=PB := "SYSWCS64 ";               <<03061>>12452000
                                                               <<03005>>12454000
   SUBROUTINE DUMP'IT( WORDS);                                 <<03005>>12456000
      VALUE WORDS;                                             <<03005>>12458000
      DOUBLE WORDS;                                            <<03005>>12460000
   BEGIN                                                       <<03005>>12462000
   WHILE WORDS > 0D DO                                         <<03005>>12464000
      BEGIN                                                    <<03005>>12466000
      LEN := IF WORDS > DOUBLE(WCSTAPERECSIZE) THEN            <<04130>>12468000
             WCSTAPERECSIZE ELSE LOGICAL(WORDS);               <<04130>>12470000
      FREADDIR( FNUM,LBUF,LEN,DOUBLE(REC));                    <<03005>>12472000
      IF <> THEN FERROR( FNUM,FULLNAME);                       <<03005>>12474000
      WRITETAPE( LBUF,LEN,0);                                  <<03005>>12476000
      WORDS := WORDS-DOUBLE(LEN);                              <<03005>>12478000
      REC := REC+(LEN+127)/128;                                <<03005>>12480000
      END;                                                     <<03005>>12482000
   END;                                                        <<03005>>12484000
   SUBROUTINE UPDATE'SECT0( WCS'DISC'X);                       <<03005>>12486000
      VALUE WCS'DISC'X;                                        <<03005>>12488000
      INTEGER WCS'DISC'X;                                      <<03005>>12490000
   BEGIN                                                       <<03005>>12492000
   IF NOT MAGTAPE THEN                                         <<03005>>12494000
      BEGIN                                                    <<03005>>12496000
      BLOCKN := BLOCKN+1;                                      <<03005>>12498000
      TEMP := FINDSDISCGAP(SDISCLDEV,BLOCKN,DISCADDRESS);      <<03005>>12500000
      IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);             <<03005>>12502000
      TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,0,128,0,0,%41);      <<03005>>12504000
      IOERRCHECK(*,*);                                         <<03005>>12506000
      DISCWCSTAB(WCS'DISC'X) := L'PADR(DISCADDRESS);           <<03005>>12508000
      TOS := ATTACHIO(SDISCLDEV,0,0,@LBUF,11,128,0,0,%41);     <<03005>>12510000
      IOERRCHECK(*,*);                                         <<03005>>12512000
      END;                                                     <<03005>>12514000
   END;                                                        <<03005>>12516000
                                                               <<03005>>12518000
      << ROUND TAPERECSIZE TO 1024,2048,3072,4096 >>           <<04130>>12520000
   WCSTAPERECSIZE := LOGICAL(TAPERECSIZE) LAND %16000;         <<04130>>12522000
   WCSTAPERECSIZE := 1024; << TO BE DELETED - WHEN DCU FIXED >><<04331>>12524000
   ZEROBUF(WCSFNUM,NR'ENTRIES);                                <<03005>>12526000
   ZEROBUF(WCSTAB,WCSTAB'SIZE);                                <<03005>>12528000
                                                               <<03005>>12530000
   <<***************************************************>>     <<03005>>12532000
   <<    ICF/55 WCS SIZE                                >>     <<03005>>12534000
   <<***************************************************>>     <<03005>>12536000
                                                               <<03005>>12538000
   @WCSTABPNTR := @WCSTAB(ICF55'TAB'X*ENTRY'SIZE);             <<03005>>12540000
   MOVE FILENAME := ICF55WCSNAME,(9);                          <<03005>>12542000
   SEARCH'SYSFILE( FILENAME);                                  <<03005>>12544000
   FNUM := FOPEN( FULLNAME,3,%420);                            <<03005>>12546000
   IF <> THEN                                                  <<03005>>12548000
      BEGIN                                                    <<03005>>12550000
      FCHECK( FNUM, ERRNR);                                    <<03005>>12552000
      IF ERRNR <> 52 THEN FERROR( FNUM,FULLNAME);              <<03005>>12554000
      END                                                      <<03005>>12556000
   ELSE                                                        <<03005>>12558000
      BEGIN                                                    <<03005>>12560000
      FREAD( FNUM,REC0,128);                                   <<03005>>12562000
      IF < THEN FERROR( WCSFNUM, FULLNAME);                    <<03005>>12564000
      IF > THEN FCLOSE( FNUM, 0, 0)                            <<03005>>12566000
      ELSE                                                     <<03005>>12568000
         BEGIN                                                 <<03005>>12570000
         WCSTABPNTR(RECS'TO'WCS) := TOTAL'WCS'RECS;            <<03005>>12572000
         TOS := (NR'WCS'LOCS*4D+DOUBLE(WCSTAPERECSIZE)-1D)/    <<04130>>12574000
            DOUBLE(WCSTAPERECSIZE) + (NR'LUT'LOCS*2D+          <<04130>>12576000
            DOUBLE(WCSTAPERECSIZE)-1D)/DOUBLE(WCSTAPERECSIZE); <<04130>>12578000
         IF <> THEN TOS := TOS+1; << RECORD 0 >>               <<03604>>12580000
         WCSTABPNTR(RECS'OF'WCS) := S0;                        <<03005>>12582000
         WCSTABPNTR(WCSRECSIZE) := -WCSTAPERECSIZE;            <<04130>>12584000
         TOTAL'WCS'RECS := TOTAL'WCS'RECS+TOS;                 <<03005>>12586000
         DEL;                                                  <<03005>>12588000
         WCSFNUM(ICF55'TAB'X) := FNUM;                         <<03005>>12590000
         END;                                                  <<03005>>12592000
      END;                                                     <<03005>>12594000
                                                               <<03005>>12596000
   <<**************************************************>>      <<03005>>12598000
   <<    FILL IN RECORDS AFTER WCS IN WCS TABLE        >>      <<03005>>12600000
   <<**************************************************>>      <<03005>>12602000
                                                               <<03005>>12604000
   @WCSTABPNTR := @WCSTAB;                                     <<03005>>12606000
   WHILE @WCSTABPNTR <> @WCSTAB(WCSTAB'SIZE) DO                <<03005>>12608000
      BEGIN                                                    <<03005>>12610000
      WCSTABPNTR(RECS'AFTER'WCS) := TOTAL'WCS'RECS             <<03005>>12612000
         -WCSTABPNTR(RECS'TO'WCS)-WCSTABPNTR(RECS'OF'WCS);     <<03005>>12614000
      @WCSTABPNTR := @WCSTABPNTR(ENTRY'SIZE);                  <<03005>>12616000
      END;                                                     <<03005>>12618000
                                                               <<03005>>12620000
   << ADD IN LENGTH OF WCS TABLE >>                            <<03005>>12622000
                                                               <<03005>>12624000
   TOTAL'WCS'RECS := TOTAL'WCS'RECS+1;                         <<03005>>12626000
                                                               <<03005>>12628000
   RETURN;                                                     <<03005>>12632000
                                                               <<03005>>12634000
DUMP'WCS:   << WCS DUMP ENTRY POINT >>                         <<03005>>12636000
                                                               <<03005>>12638000
      << ROUND TAPERECSIZE TO 1024,2048,3072,4096 >>           <<04130>>12640000
   WCSTAPERECSIZE := LOGICAL(TAPERECSIZE) LAND %16000;         <<04130>>12642000
   WCSTAPERECSIZE := 1024; << TO BE DELETED - WHEN DCU FIXED >><<04331>>12644000
   <<***************************************************>>     <<03005>>12646000
   <<   WRITE WCS FILES TO TAPE/SERIAL DISC             >>     <<03005>>12648000
   <<***************************************************>>     <<03005>>12650000
                                                               <<03005>>12652000
   IF MAGTAPE THEN                                             <<03005>>12654000
      BEGIN                                                    <<03005>>12656000
      FWRITE(TAPEFNUM,WCSTAB,WCSTAB'SIZE,0); << WCS TABLE >>   <<03005>>12658000
      IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                    <<03005>>12660000
      END;                                                     <<03005>>12662000
                                                               <<03005>>12664000
   <<***************************************************>>     <<03005>>12666000
   <<   DUMP ICF/55 WCS TO TAPE/SERIAL DISC             >>     <<03005>>12668000
   <<***************************************************>>     <<03005>>12670000
                                                               <<03005>>12672000
   MOVE FILENAME := ICF55WCSNAME,(9);                          <<03005>>12674000
   SEARCH'SYSFILE( FILENAME);                                  <<03005>>12676000
   FNUM := WCSFNUM(ICF55'TAB'X);                               <<03005>>12678000
   IF FNUM <> 0 THEN                                           <<03005>>12680000
      BEGIN                                                    <<03005>>12682000
      FREADDIR(FNUM,REC0,128,0D);                              <<03005>>12684000
      IF <> THEN FERROR( FNUM, FULLNAME);                      <<03005>>12686000
      FWRITE(TAPEFNUM,REC0,128,%1001);  << RECORD 0 >>         <<03005>>12688000
      IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                    <<03005>>12690000
      REC := 1;                                                <<03005>>12692000
      DUMP'IT( NR'WCS'LOCS&DLSL(2));    << WCS >>              <<03005>>12694000
      DUMP'IT( NR'LUT'LOCS&DLSL(1));    << LUT >>              <<03005>>12696000
      FWRITE(TAPEFNUM,REC0,0,%2001);    << END CONTIG BLK >>   <<03005>>12698000
      IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                    <<03005>>12700000
      FCLOSE(FNUM,0,0);                                        <<03005>>12702000
      UPDATE'SECT0( ICF55'WCS'DISC'X);                         <<03005>>12704000
      END;                                                     <<03005>>12706000
END;                                                           <<03005>>12710000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>12712000
DOUBLE PROCEDURE L'PADR(DISCADDRESS);                          <<00.SD>>12714000
VALUE DISCADDRESS;                                             <<00.SD>>12716000
DOUBLE DISCADDRESS;                                            <<00.SD>>12718000
BEGIN                                                          <<03544>>12720000
EQUATE DISC2'SECTORS'TRACK = 30;                               <<03544>>12722000
                                                               <<03544>>12724000
IF OUTDEVTYPE = DISC0 OR OUTDEVTYPE = DISC2 THEN               <<03544>>12726000
  BEGIN                                                        <<03544>>12728000
                                                               <<03544>>12730000
  TOS:=DISCADDRESS;                                            <<00.SD>>12732000
  TOS:=IF FLOPPY THEN FLOP'SEC'CYL ELSE                        <<00072>>12734000
  SEC'CYL(STYPE);                                              <<00072>>12736000
  ASSEMBLE(LDIV);                                              <<00.SD>>12738000
  IF OVERFLOW THEN                                             <<00.SD>>12740000
    BEGIN                                                      <<00.SD>>12742000
    MESSAGE(170); <<BAD DISC ADDRESS>>                         <<00.SD>>12744000
    PURGETEMPSL;                                               <<00.SD>>12746000
    END;                                                       <<00.SD>>12748000
  TOS:=IF FLOPPY THEN DISC2'SECTORS'TRACK ELSE                 <<00072>>12750000
  SECTHD(STYPE);                                               <<00488>>12752000
  ASSEMBLE(DIV,XCH);                                           <<00.SD>>12754000
  TOS:=TOS&LSL(8)+TOS;<<DOESN'T SUPPORT 7905/6(F)>>            <<00072>>12756000
  L'PADR:=TOS;                                                 <<00.SD>>12758000
  END                                                          <<03544>>12760000
                                                               <<03544>>12762000
ELSE         << CS'80 AND ANY OTHER TYPES >>                   <<03544>>12764000
  L'PADR := DISCADDRESS;   << PASS BACK THE LOGICAL ADDRESS >> <<03544>>12766000
END;   << L'PADR >>                                            <<03544>>12768000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>12770000
                                                                        12772000
          <<---------------------------                                 12774000
            WRITE CORE BUFFER TO TAPE                                   12776000
          --------------------------->>                                 12778000
PROCEDURE WRITETAPE( BUF, WORDS, CONTIG);                      <<03604>>12782000
   VALUE WORDS, CONTIG;                                        <<03604>>12784000
   INTEGER ARRAY BUF;                                          <<03604>>12786000
   INTEGER WORDS;                                              <<03604>>12788000
   LOGICAL CONTIG;                                             <<03604>>12790000
BEGIN COMMENT                                                  <<03604>>12792000
     Writes the array "BUF" to tape blocked                    <<03604>>12794000
     according to "TAPERECSIZE";                               <<03604>>12796000
                                                               <<03604>>12798000
   INTEGER                                                     <<03604>>12800000
      J := 0,                                                  <<03604>>12802000
      LEN;                                                     <<03604>>12804000
                                                               <<03604>>12806000
   WHILE WORDS <> 0 DO                                         <<03604>>12808000
      BEGIN                                                    <<03604>>12810000
      LEN := IF WORDS > TAPERECSIZE THEN TAPERECSIZE           <<03604>>12812000
         ELSE WORDS;                                           <<03604>>12814000
      FWRITE( TAPEFNUM,BUF,LEN,IF J=0 AND CONTIG THEN          <<03604>>12816000
              %1001 ELSE 0);                                   <<03604>>12818000
      IF <> THEN FERROR( TAPEFNUM, TAPEFILE);                  <<03604>>12820000
      J:=J+1;                                                  <<03604>>12822000
      @BUF := @BUF(LEN);                                       <<03604>>12824000
      WORDS := WORDS-LEN;                                      <<03604>>12826000
      END;                                                     <<03604>>12828000
                                                               <<03604>>12830000
   IF CONTIG AND J<>0 THEN                                     <<03604>>12832000
      BEGIN                                                    <<03604>>12834000
      FWRITE( TAPEFNUM,BUF,0,%2001);                           <<03604>>12836000
      IF <> THEN FERROR( TAPEFNUM, TAPEFILE);                  <<03604>>12838000
      END;                                                     <<03604>>12840000
END; << WRITETAPE >>                                           <<03604>>12842000
INTEGER PROCEDURE DIRC'BUILD (NTRY, LEVEL, INDX, SIRS);        <<DE>>   12846000
   VALUE   LEVEL, INDX, SIRS;                                  <<DE>>   12848000
   INTEGER LEVEL, INDX;                                        <<DE>>   12850000
   DOUBLE  SIRS;                                               <<DE>>   12852000
   ARRAY   NTRY;                                               <<DE>>   12854000
                                                               <<DE>>   12856000
BEGIN                                                          <<DE>>   12858000
   INTEGER  RET'STATUS      =  DIRC'BUILD;                     <<DE>>   12860000
   DEFINE   SIR'FLAG        =  (15:2) #;                       <<DE>>   12862000
   EQUATE   SIR'REL         =  0,                              <<DE>>   12864000
            SIR'NOTREL      =  1;                              <<DE>>   12866000
   DEFINE   DIRSCAN'STATUS  =  (13:2) #;                       <<DE>>   12868000
   EQUATE   CONT'TRAV       =  0,                              <<DE>>   12870000
            SKIP'SUBTREE    =  1,                              <<DE>>   12872000
            STOP'TRAV       =  2;                              <<DE>>   12874000
                                                               <<DE>>   12876000
   INTEGER  DELTAQ          =  Q+0;                            <<DE>>   12878000
   ARRAY    ARRAYQ0 (*)     =  Q-0;                            <<DE>>   12880000
   INTEGER  ARRAY  RPARMS (*);                                 <<DE>>   12882000
   DEFINE   SCAN'LEVEL      =  RPARMS (0) #;                   <<DE>>   12884000
                                                               <<DE>>   12886000
   INTEGER  DST, I, J;                                         <<DE>>   12888000
   INTEGER  POINTER DIRC'BUFF, ENTRYP, INDEXP;                 <<DE>>   12890000
   DOUBLE   POINTER DIRC'BUFFD;                                <<DE>>   12892000
                                                               <<DE>>   12894000
   DOUBLE   CDIR'BASE,     << Save current DIRBASE address >>  <<DE>>   12896000
            NDIR'BASE,                                         <<DE>>   12898000
            WDIR'BASE;                                         <<DE>>   12900000
   INTEGER  NDIR'BASE1      =  NDIR'BASE,                      <<DE>>   12902000
            NDIR'BASE2      =  NDIR'BASE+1,                    <<DE>>   12904000
            WDIR'ADDR1      =  WDIR'BASE,                      <<DE>>   12906000
            WDIR'ADDR2      =  WDIR'BASE+1;                    <<DE>>   12908000
                                                               <<DE>>   12910000
   EQUATE   NAMESIZE        =  4,      << 4 words per name >>  <<DE>>   12912000
            BUFSIZE         =  400,    << double stack buff >> <<DE>>   12914000
                                                               <<DE>>   12916000
         << Stack directory buffer parameters >>               <<DE>>   12918000
            MISCWD''        =  12,     << in dirc buffer   >>  <<DE>>   12920000
            AREA'HDR        =  4,                              <<DE>>   12922000
            AREA'A          =  0,                              <<DE>>   12924000
            AREA'B          =  BUFSIZE,                        <<DE>>   12926000
            A << AREA A >>  =  0,                              <<DE>>   12928000
            B << AREA B >>  =  1,                              <<DE>>   12930000
                                                               <<DE>>   12932000
         << RPARMS parameters >>                               <<DE>>   12934000
            FUNC            =  0,                              <<DE>>   12936000
            MISCWD'         =  FUNC + 1,                       <<DE>>   12938000
            PGRPNAME        =  MISCWD' + 1,                    <<DE>>   12940000
            PACCTNAME       =  PGRPNAME + NAMESIZE,            <<DE>>   12942000
            ENTRYX          =  PACCTNAME + NAMESIZE,           <<DE>>   12944000
            << DIRBASE1     =  RPARMS (15) >>                  <<DE>>   12946000
            << DIRBASE2     =  RPARMS (16) >>                  <<DE>>   12948000
            << ADJ          =  RPARMS (17) >>                  <<DE>>   12950000
            ERROR'RETURN    =  ENTRYX+NAMESIZE+3,              <<DE>>   12952000
                                                               <<DE>>   12954000
         << ERROR Return codes >>                              <<DE>>   12956000
            IO'ERR          =  1,                              <<DE>>   12958000
            NOT'INDEX       =  2,  << Not an index block >>    <<DE>>   12960000
                                                               <<DE>>   12962000
         << Directory INDEX block header >>                    <<DE>>   12964000
            IMISCWD         =  AREA'HDR,                       <<DE>>   12966000
            IXCOUNT         =  IMISCWD + 1,                    <<DE>>   12968000
            IPCOUNT         =  IXCOUNT + 1,                    <<DE>>   12970000
            IETOTAL         =  IPCOUNT + 1,                    <<DE>>   12972000
            IEMISCWD        =  IETOTAL + 1,                    <<DE>>   12974000
            IPINDEXP        =  IEMISCWD + 1,                   <<DE>>   12976000
                                                               <<DE>>   12978000
         << INDEX entry pointer >>                             <<DE>>   12980000
            IEPNTR          =  4,                              <<DE>>   12982000
            IECOUNT         =  5,                              <<DE>>   12984000
            ISIZE           =  6,      << INDEX entry size >>  <<DE>>   12986000
                                                               <<DE>>   12988000
         << Words per directory entry >>                       <<DE>>   12990000
            ASIZE           =  30,     << Account >>           <<DE>>   12992000
            GSIZE           =  41,     << Group >>             <<DE>>   12994000
            USIZE           =  19,     << User >>              <<DE>>   12996000
            FSIZE           =  6,      << File >>              <<DE>>   12998000
            VSDSIZE         =  56,     << Volume Set Defin >>  <<DE>>   13000000
            FILELEVEL       =  0,                              <<DE>>   13002000
            GRPLEVEL        =  1,                              <<DE>>   13004000
            ACCTLEVEL       =  2,                              <<DE>>   13006000
            VSDLEVEL        =  3,                              <<DE>>   13008000
         << Pointers in entry >>                               <<DE>>   13010000
            AGIPNTR         =  4,                              <<DE>>   13012000
            AUIPNTR         =  AGIPNTR+1,                      <<DE>>   13014000
            GFIPNTR         =  4,                              <<DE>>   13016000
            GVSDIPNTR       =  25;                             <<DE>>   13018000
                                                               <<DE>>   13020000
   DEFINE   LEVL            =  RPARMS (MISCWD').(8:8) #,       <<DE>>   13022000
            TDIR'BASE1      =  RPARMS (15) #,                  <<DE>>   13024000
            TDIR'BASE2      =  RPARMS (16) #,                  <<DE>>   13026000
            TLDEV           =  RPARMS (15).(0:8) #,            <<DE>>   13028000
            ADJ             =  RPARMS (17) #;                  <<DE>>   13030000
                                                               <<DE>>   13032000
   LOGICAL SUBROUTINE READ'DIRC (AREA'X,NSECTS);               <<DE>>   13034000
      VALUE   AREA'X, NSECTS;                                  <<DE>>   13036000
      INTEGER AREA'X, NSECTS;                                  <<DE>>   13038000
   BEGIN                                                       <<DE>>   13040000
      TOS:=ATTACHIO (SYSDISC,0,0, (@DIRC'BUFF +                <<DE>>   13042000
           (AREA'X*BUFSIZE)+AREA'HDR), 0<<READ>>, (NSECTS*128),<<DE>>   13044000
           DIRC'BUFF(AREA'X*BUFSIZE).(8:8),                    <<DE>>   13046000
           DIRC'BUFF(AREA'X*BUFSIZE+1), 1);                    <<DE>>   13048000
      ASSEMBLE (STBX, DEL);                                    <<DE>>   13050000
      IF TOS.(13:3) <> 1 THEN READ'DIRC:=TRUE;                 <<DE>>   13052000
   END; << READ'DIRC >>                                        <<DE>>   13054000
                                                               <<DE>>   13056000
   LOGICAL SUBROUTINE WRITE'DIRC (AREA'X,NSECTS);              <<DE>>   13058000
      VALUE   AREA'X, NSECTS;                                  <<DE>>   13060000
      INTEGER AREA'X, NSECTS;                                  <<DE>>   13062000
   BEGIN                                                       <<DE>>   13064000
      WDIR'BASE := NDIR'BASE +                                 <<DE>>   13066000
                   DOUBLE (DIRC'BUFF (AREA'X*BUFSIZE+2) );     <<DE>>   13068000
      TOS:=ATTACHIO (TLDEV, 0, 0, (@DIRC'BUFF +                <<DE>>   13070000
           (AREA'X*BUFSIZE)+AREA'HDR), 1<<WRITE>>,(NSECTS*128),<<DE>>   13072000
           WDIR'ADDR1.(8:8), WDIR'ADDR2, 1);                   <<DE>>   13074000
      ASSEMBLE (STBX, DEL);                                    <<DE>>   13076000
      IF TOS.(13:3) <> 1 THEN WRITE'DIRC:=TRUE;                <<DE>>   13078000
   END; << WRITE'DIRC >>                                       <<DE>>   13080000
                                                               <<DE>>   13082000
   LOGICAL SUBROUTINE RET'ERR (ERR);                           <<DE>>   13084000
      VALUE ERR;   INTEGER ERR;                                <<DE>>   13086000
   << Return error back to caller in RPARMS array >>           <<DE>>   13088000
      BEGIN                                                    <<DE>>   13090000
         RPARMS (ERROR'RETURN) := ERR;                         <<DE>>   13092000
      END;                                                     <<DE>>   13094000
                                                               <<DE>>   13096000
   LOGICAL SUBROUTINE ADJ'DIRC (TYPE, ENTSIZE, NSECTS);        <<DE>>   13098000
      VALUE   TYPE, ENTSIZE, NSECTS;                           <<DE>>   13100000
      INTEGER TYPE, ENTSIZE, NSECTS;                           <<DE>>   13102000
   BEGIN                                                       <<DE>>   13104000
      I := 0;                                                  <<DE>>   13106000
      @INDEXP := @DIRC'BUFF + AREA'HDR <<INDEX HDR>>;          <<DE>>   13108000
      IF INDEXP (5) <> 0 THEN                                  <<DE>>   13110000
         INDEXP (5) := INDEXP (5) + ADJ; << Father pointer >>  <<DE>>   13112000
      @INDEXP := @INDEXP + 10;  << First index entry >>        <<DE>>   13114000
      WHILE (I:=I+1) <= DIRC'BUFF(IXCOUNT) DO                  <<DE>>   13116000
      BEGIN << Do all index entries >>                         <<DE>>   13118000
         IF TYPE=1 OR TYPE=2 THEN                              <<DE>>   13120000
            BEGIN << Do Group and Acct entries only >>         <<DE>>   13122000
            DIRC'BUFFD (AREA'B & LSR(1)) :=                    <<DE>>   13124000
                        DIRC'BUFFD (AREA'B & LSR(1))           <<DE>>   13126000
                        + DOUBLE (DIRC'BUFF(AREA'B+2));        <<DE>>   13128000
            IF READ'DIRC (B, NSECTS) THEN RET'ERR (IO'ERR);    <<DE>>   13130000
            J := 0;                                            <<DE>>   13132000
            @ENTRYP := @DIRC'BUFF + BUFSIZE + AREA'HDR;        <<DE>>   13134000
            WHILE (J:=J+1) <= INDEXP(IECOUNT) DO               <<DE>>   13136000
            BEGIN                                              <<DE>>   13138000
               IF TYPE=1 <<GROUP>> THEN                        <<DE>>   13140000
                  BEGIN                                        <<DE>>   13142000
                     ENTRYP(GFIPNTR):=ENTRYP(GFIPNTR)+ADJ;     <<DE>>   13144000
                     ENTRYP(GVSDIPNTR):=ENTRYP(GVSDIPNTR)+ADJ; <<DE>>   13146000
                  END                                          <<DE>>   13148000
               ELSE IF TYPE=2 <<ACCOUNT>> THEN                 <<DE>>   13150000
                  BEGIN                                        <<DE>>   13152000
                     ENTRYP(AGIPNTR):=ENTRYP(AGIPNTR)+ADJ;     <<DE>>   13154000
                     ENTRYP(AUIPNTR):=ENTRYP(AUIPNTR)+ADJ;     <<DE>>   13156000
                  END;                                         <<DE>>   13158000
               @ENTRYP := @ENTRYP + ENTSIZE;                   <<DE>>   13160000
            END;                                               <<DE>>   13162000
            IF WRITE'DIRC (B, NSECTS) THEN RET'ERR (IO'ERR);   <<DE>>   13164000
         END;                                                  <<DE>>   13166000
                                                               <<DE>>   13168000
         INDEXP(IEPNTR) := INDEXP(IEPNTR)+ADJ;                 <<DE>>   13170000
         @INDEXP := @INDEXP + ISIZE;                           <<DE>>   13172000
         DIRC'BUFFD (AREA'B & LSR(1)) := CDIR'BASE;            <<DE>>   13174000
         DIRC'BUFF (AREA'B+2) := INDEXP (IEPNTR);              <<DE>>   13176000
                                                               <<DE>>   13178000
      END;                                                     <<DE>>   13180000
   END;  << ADJ'DIRC >>                                        <<DE>>   13182000
                                                               <<DE>>   13184000
   RET'STATUS := 0;                                            <<DE>>   13186000
   RET'STATUS.SIR'FLAG := SIR'NOTREL;                          <<DE>>   13188000
                                                               <<DE>>   13190000
   DST := EXCHANGEDB (0);                                      <<DE>>   13192000
   @RPARMS := @ARRAYQ0 (INDX-DELTAQ);                          <<DE>>   13194000
                                                               <<DE>>   13196000
   PUSH (S);                                                   <<DE>>   13198000
   @DIRC'BUFF := TOS + 1;                                      <<DE>>   13200000
   TOS := BUFSIZE & LSL(1);  << double directory buffer >>     <<DE>>   13202000
   ASSEMBLE (ADDS 0);                                          <<DE>>   13204000
                                                               <<DE>>   13206000
    NDIR'BASE1 := TDIR'BASE1;                                  <<DE>>   13208000
    NDIR'BASE2 := TDIR'BASE2;                                  <<DE>>   13210000
   @DIRC'BUFFD := @DIRC'BUFF;                                  <<DE>>   13212000
                                                               <<DE>>   13214000
   << Move index information from System DST >>                <<DE>>   13216000
      TOS := @DIRC'BUFF;                                       <<DE>>   13218000
      TOS := SYS'DDS;                                          <<DE>>   13220000
      TOS := ZZ+XX;  << INDEX info is in Area B of DST >>      <<DE>>   13222000
      TOS := 3;  << Current dirc address in buffer >>          <<DE>>   13224000
      ASSEMBLE (MFDS 2);                                       <<DE>>   13226000
      TOS := ZZ+XX+MISCWD'';                                   <<DE>>   13228000
      TOS := 1;  << Current dirc address in buffer >>          <<DE>>   13230000
      ASSEMBLE (MFDS 4);                                       <<DE>>   13232000
      CDIR'BASE := DIRC'BUFFD (AREA'A);                        <<DE>>   13234000
      DIRC'BUFF(AREA'A).(0:8) := 0;                            <<DE>>   13236000
      DIRC'BUFFD (AREA'A) := DIRC'BUFFD (AREA'A) +             <<DE>>   13238000
                             DOUBLE( DIRC'BUFF (AREA'A+2));    <<DE>>   13240000
                                                               <<DE>>   13242000
      TOS := @DIRC'BUFF+BUFSIZE;                               <<DE>>   13244000
      TOS := SYS'DDS;                                          <<DE>>   13246000
      TOS := ZZ;    << Entry info is Area A of System DST >>   <<DE>>   13248000
      TOS := 3;  << Current dirc address in buffer >>          <<DE>>   13250000
      ASSEMBLE (MFDS 2);                                       <<DE>>   13252000
      TOS := ZZ+MISCWD'';                                      <<DE>>   13254000
      TOS := 1;  << Current dirc address in buffer >>          <<DE>>   13256000
      ASSEMBLE (MFDS 4);                                       <<DE>>   13258000
      DIRC'BUFF(AREA'B).(0:8) := 0;                            <<DE>>   13260000
                                                               <<DE>>   13262000
   CASE *LEVEL OF                                              <<DE>>   13264000
   BEGIN                                                       <<DE>>   13266000
                                                               <<DE>>   13268000
   <<0: FILE >>                                                <<DE>>   13270000
        BEGIN                                                  <<DE>>   13272000
           RPARMS (MISCWD') := (FSIZE & LSL(8)) + LEVEL;       <<DE>>   13274000
           MOVE RPARMS (ENTRYX) := NTRY, (NAMESIZE);           <<DE>>   13276000
                                                               <<DE>>   13278000
           << Read File INDEX block >>                         <<DE>>   13280000
           IF READ'DIRC ( A , SYSGFIBSIZE )                    <<DE>>   13282000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13284000
           IF ADJ'DIRC (LEVEL, FSIZE, SYSFEBSIZE)              <<DE>>   13286000
              THEN RET'ERR (NOT'INDEX);                        <<DE>>   13288000
                                                               <<DE>>   13290000
           << Write File INDEX block >>                        <<DE>>   13292000
           IF WRITE'DIRC ( A, SYSGFIBSIZE )                    <<DE>>   13294000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13296000
           RET'STATUS.DIRSCAN'STATUS := STOP'TRAV;             <<DE>>   13298000
        END;  << FILE >>                                       <<DE>>   13300000
                                                               <<DE>>   13302000
   <<1: GROUP>>                                                <<DE>>   13304000
        BEGIN                                                  <<DE>>   13306000
           RPARMS (MISCWD') := (GSIZE & LSL(8)) + LEVEL;       <<DE>>   13308000
           IF SCAN'LEVEL < 2                                   <<DE>>   13310000
              THEN BEGIN                                       <<DE>>   13312000
                   MOVE RPARMS (ENTRYX) := NTRY, (NAMESIZE);   <<DE>>   13314000
                                                               <<DE>>   13316000
                   << Read Account INDEX block >>              <<DE>>   13318000
                   IF READ'DIRC ( A , SYSAGIBSIZE )            <<DE>>   13320000
                      THEN RET'ERR (IO'ERR);                   <<DE>>   13322000
                   IF ADJ'DIRC (LEVEL, GSIZE, SYSGEBSIZE)      <<DE>>   13324000
                      THEN RET'ERR (NOT'INDEX);                <<DE>>   13326000
                                                               <<DE>>   13328000
                   << Write Account INDEX block >>             <<DE>>   13330000
                   IF WRITE'DIRC ( A, SYSAGIBSIZE )            <<DE>>   13332000
                      THEN RET'ERR (IO'ERR);                   <<DE>>   13334000
                   END                                         <<DE>>   13336000
              ELSE MOVE RPARMS (PGRPNAME) := NTRY, (NAMESIZE); <<DE>>   13338000
           RET'STATUS.DIRSCAN'STATUS := SKIP'SUBTREE;          <<DE>>   13340000
        END;  << GROUP >>                                      <<DE>>   13342000
                                                               <<DE>>   13344000
   <<2: ACCOUNT>>                                              <<DE>>   13346000
        BEGIN                                                  <<DE>>   13348000
           RPARMS (MISCWD') := (ASIZE & LSL(8)) + LEVEL;       <<DE>>   13350000
           IF SCAN'LEVEL < 1                                   <<DE>>   13352000
              THEN BEGIN                                       <<DE>>   13354000
                   MOVE RPARMS (ENTRYX) := NTRY, (NAMESIZE);   <<DE>>   13356000
                                                               <<DE>>   13358000
                   << Read Account INDEX block >>              <<DE>>   13360000
                   IF READ'DIRC ( A , SYSSAIBSIZE )            <<DE>>   13362000
                      THEN RET'ERR (IO'ERR);                   <<DE>>   13364000
                   IF ADJ'DIRC (LEVEL, ASIZE, SYSAEBSIZE)      <<DE>>   13366000
                      THEN RET'ERR (NOT'INDEX);                <<DE>>   13368000
                                                               <<DE>>   13370000
                   << Write Account INDEX block >>             <<DE>>   13372000
                   IF WRITE'DIRC ( A, SYSSAIBSIZE )            <<DE>>   13374000
                      THEN RET'ERR (IO'ERR);                   <<DE>>   13376000
                   END                                         <<DE>>   13378000
              ELSE MOVE RPARMS (PACCTNAME) := NTRY, (NAMESIZE);<<DE>>   13380000
           RET'STATUS.DIRSCAN'STATUS := SKIP'SUBTREE;          <<DE>>   13382000
        END;  << ACCOUNT >>                                    <<DE>>   13384000
                                                               <<DE>>   13386000
   <<3: USER >>                                                <<DE>>   13388000
        BEGIN                                                  <<DE>>   13390000
           RPARMS (MISCWD') := (USIZE & LSL(8)) + LEVEL;       <<DE>>   13392000
           MOVE RPARMS (ENTRYX) := NTRY, (NAMESIZE);           <<DE>>   13394000
                                                               <<DE>>   13396000
           << Read User INDEX block >>                         <<DE>>   13398000
           IF READ'DIRC ( A , SYSAUIBSIZE )                    <<DE>>   13400000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13402000
           IF ADJ'DIRC (LEVEL, USIZE, SYSUEBSIZE)              <<DE>>   13404000
              THEN RET'ERR (NOT'INDEX);                        <<DE>>   13406000
                                                               <<DE>>   13408000
           << Write Account/User INDEX block >>                <<DE>>   13410000
           IF WRITE'DIRC ( A, SYSAUIBSIZE )                    <<DE>>   13412000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13414000
           RET'STATUS.DIRSCAN'STATUS := STOP'TRAV;             <<DE>>   13416000
        END;  << USER >>                                       <<DE>>   13418000
                                                               <<DE>>   13420000
   <<4: VSD  >>                                                <<DE>>   13422000
        BEGIN                                                  <<DE>>   13424000
           RPARMS (MISCWD') := (VSDSIZE & LSL(8)) + LEVEL;     <<DE>>   13426000
           MOVE RPARMS (ENTRYX) := NTRY, (NAMESIZE);           <<DE>>   13428000
                                                               <<DE>>   13430000
           << Read VSD INDEX block >>                          <<DE>>   13432000
           IF READ'DIRC ( A , SYSGVSIBSIZE )                   <<DE>>   13434000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13436000
           IF ADJ'DIRC (LEVEL, VSDSIZE, SYSVSEBSIZE)           <<DE>>   13438000
              THEN RET'ERR (NOT'INDEX);                        <<DE>>   13440000
                                                               <<DE>>   13442000
           << Write Account INDEX block >>                     <<DE>>   13444000
           IF WRITE'DIRC ( A, SYSGVSIBSIZE )                   <<DE>>   13446000
              THEN RET'ERR (IO'ERR);                           <<DE>>   13448000
           RET'STATUS.DIRSCAN'STATUS := STOP'TRAV;             <<DE>>   13450000
        END;  << VSD >>                                        <<DE>>   13452000
                                                               <<DE>>   13454000
   END;  << ALL CASES:  FILES, ACCT, GRPS, VSD >>              <<DE>>   13456000
                                                               <<DE>>   13458000
   EXCHANGEDB (DST);                                           <<DE>>   13460000
END;  << DIRC'BUILD >>                                         <<DE>>   13462000
          <<*******************************>>                  <<DE>>   13464000
          << DUMP SYSTEM DIRECTORY TO TAPE >>                  <<DE>>   13466000
          <<*******************************>>                  <<DE>>   13468000
                                                               <<DE>>   13470000
PROCEDURE DUMPDIRC (SECTORS, ADDRESS, WHAT);                   <<DE>>   13472000
   VALUE   SECTORS, ADDRESS;                                   <<DE>>   13474000
   LOGICAL SECTORS;  << SIZE OF NEW DIRECTORY >>               <<DE>>   13476000
   DOUBLE  ADDRESS;                                            <<DE>>   13478000
   BYTE ARRAY WHAT;                                            <<DE>>   13480000
   OPTION PRIVILEGED, UNCALLABLE;                              <<DE>>   13482000
                                                               <<DE>>   13484000
BEGIN                                                          <<DE>>   13486000
   DOUBLE                                                      <<DE>>   13488000
      DIR'BASE,        << DIRBASE of new temp directory >>     <<DE>>   13490000
      ODIR'BASE,       << DIRBASE of old directory >>          <<DE>>   13492000
      WDIR'BASE,       << DIRBASE of directory to write >>     <<DE>>   13494000
      DIR'LIMIT,       << End of current directory >>          <<DE>>   13496000
      WORDS;                                                   <<DE>>   13498000
   INTEGER                                                     <<DE>>   13500000
      DIRFNUM   :=  0,                                         <<DE>>   13502000
      DIRFLDEV  :=  0, << Logical device of new dirc file >>   <<DE>>   13504000
      ADR1       =  ADDRESS,                                   <<DE>>   13506000
      ADR2       =  ADDRESS+1,                                 <<DE>>   13508000
      DIR'BASE1  =  DIR'BASE,                                  <<DE>>   13510000
      DIR'BASE2  =  DIR'BASE+1,                                <<DE>>   13512000
      ODIR'BASE1 =  ODIR'BASE,                                 <<DE>>   13514000
      ODIR'BASE2 =  ODIR'BASE+1,                               <<DE>>   13516000
      WADR1      =  WDIR'BASE,                                 <<DE>>   13518000
      WADR2      =  WDIR'BASE+1,                               <<DE>>   13520000
      OLD'BITSECT,     << Current #sectors used by bitmap >>   <<DE>>   13522000
      NEW'BITSECT,     << no. sectors used by new bitmap  >>   <<DE>>   13524000
      NEW'BITWORDS,    << no. of full words in new bitmap >>   <<DE>>   13526000
      ADJ,             << No. of bitmap sectors for adj.  >>   <<DE>>   13528000
      SHIFT'ADJ,       << bit shift in word >>                 <<DE>>   13530000
      SAVE'LAST,       << Save last word >>                    <<DE>>   13532000
      I, J, LEN;                                               <<DE>>   13534000
   LOGICAL                                                     <<DE>>   13536000
      MLBUF,           << bit mask for LBUF array >>           <<DE>>   13538000
      MLBUF2,                                                  <<DE>>   13540000
      DSECT;           << Directory build limit >>             <<DE>>   13542000
                                                               <<DE>>   13544000
   INTEGER ARRAY RPARMS (0:20);                                <<DE>>   13546000
                                                               <<DE>>   13548000
   INTEGER SCAN'LEVEL := 0;                                    <<DE>>   13550000
                                                               <<DE>>   13552000
   SUBROUTINE IOERRCHECK (A, B, F);                            <<DE>>   13554000
      VALUE   A, B, F;                                         <<DE>>   13556000
      INTEGER A, B, F;                                         <<DE>>   13558000
   BEGIN    << I/O  ERROR >>                                   <<DE>>   13560000
      TOS := A.(8:8);                                          <<DE>>   13562000
      IF S0 <> 1 THEN                                          <<DE>>   13564000
         BEGIN                                                 <<DE>>   13566000
         TOS := -TOS;                                          <<DE>>   13568000
         IF F=0 THEN FERROR (*, WHAT)  << SYSTEM DISC >>       <<DE>>   13570000
                ELSE FERROR (*, DIRFNAME);                     <<DE>>   13572000
         END;                                                  <<DE>>   13574000
      DEL;                                                     <<DE>>   13576000
   END;  << IOERRCHECK >>                                      <<DE>>   13578000
   SUBROUTINE TAPE'ERROR;                                      <<DE>>   13580000
   BEGIN                                                       <<DE>>   13582000
      FCHECK (TAPEFNUM, ERRORCODE);                            <<DE>>   13584000
      IF ERRORCODE = EOTCODE AND FLOPPY THEN NEXTREEL          <<DE>>   13586000
      ELSE FERROR (TAPEFNUM, TAPEFILE);                        <<DE>>   13588000
   END;  << END OF TAPE ERROR HANDLING >>                      <<DE>>   13590000
                                                               <<DE>>   13592000
   DSECT := SECTORS;                                           <<DE>>   13594000
   LBUF := 0;                                                  <<DE>>   13596000
   MOVE LBUF(1) := LBUF, (19);                                 <<DE>>   13598000
   LBUF(2) := SECTORS;                                         <<DE>>   13600000
   FWRITE (TAPEFNUM, LBUF, 20, 0);                             <<DE>>   13602000
   IF <> THEN TAPE'ERROR;                                      <<DE>>   13604000
   WDIR'BASE := ADDRESS;                                       <<DE>>   13606000
                                                               <<DE>>   13608000
<< Get current directory bitmap >>                             <<DE>>   13610000
   TOS := ATTACHIO (SYSDISC,0,0,@LBUF,0,4096,ADR1,ADR2,1);     <<DE>>   13612000
   IOERRCHECK (*,*,0);                                         <<DE>>   13614000
                                                               <<DE>>   13616000
   OLD'BITSECT := LBUF(0).(0:9);                               <<DE>>   13618000
   IF LBUF(0).(9:7) <> 0 THEN OLD'BITSECT := OLD'BITSECT +1;   <<DE>>   13620000
   IF OLD'BITSECT < 3 THEN OLD'BITSECT:=3; <<Minimum BITMAP>>  <<DE>>   13622000
   NEW'BITWORDS:= SECTORS.(0:12);                              <<DE>>   13624000
   IF SECTORS.(12:4) <> 0 THEN NEW'BITWORDS:=NEW'BITWORDS+1;   <<DE>>   13626000
   NEW'BITWORDS:= NEW'BITWORDS + DSVMBASE + 1;                 <<DE>>   13628000
   TOS := 0;                                                   <<DE>>   13630000
   NEW'BITSECT := NEW'BITWORDS & DCSR(7);                      <<DE>>   13632000
   IF TOS <> 0 THEN NEW'BITSECT :=NEW'BITSECT +1;              <<DE>>   13634000
   IF NEW'BITSECT < 3 THEN NEW'BITSECT:=3; <<Minimum BITMAP>>  <<DE>>   13636000
                                                               <<DE>>   13638000
   IF NEW'BITWORDS <> LBUF THEN                                <<DE>>   13640000
      BEGIN << BITMAP size changed, need to make last word >>  <<DE>>   13642000
      LBUF(NEW'BITWORDS+DSVMBASE) := 0;                        <<DE>>   13644000
      J := NEW'BITWORDS+DSVMBASE-1;                            <<DE>>   13646000
      IF SECTORS.(12:4)<>0 THEN                                <<DE>>   13648000
         BEGIN                                                 <<DE>>   13650000
         LBUF(J) := I := 0;                                    <<DE>>   13652000
         DO BEGIN  << Setup last word of new bitmap >>         <<DE>>   13654000
            LBUF(J) := LBUF(J) & LSR(1);                       <<DE>>   13656000
            LBUF(J).(0:1) := 1;                                <<DE>>   13658000
            END UNTIL (I:=I+1) >= INTEGER(SECTORS.(12:4));     <<DE>>   13660000
         END;                                                  <<DE>>   13662000
      SAVE'LAST := LBUF(J);                                    <<DE>>   13664000
      END;                                                     <<DE>>   13666000
                                                               <<DE>>   13668000
   IF NEW'BITSECT <> OLD'BITSECT THEN                          <<DE>>   13670000
      BEGIN                                                    <<DE>>   13672000
      << If the bitmap size changes then all the directory >>  <<DE>>   13674000
      << pointers must be adjusted for the move.  Dirc is  >>  <<DE>>   13676000
      << copied and adjusted in a temporary file.          >>  <<DE>>   13678000
                                                               <<DE>>   13680000
      << Shift bitmap by adjusted sector offset >>             <<DE>>   13682000
      ADJ := SHIFT'ADJ := NEW'BITSECT - OLD'BITSECT;           <<DE>>   13684000
                                                               <<DE>>   13686000
      IF ADJ > 0 THEN                                          <<DE>>   13688000
                                                               <<DE>>   13690000
   << * * * * * * DIRECTORY LARGER * * * * * * * >>            <<DE>>   13692000
         BEGIN  << Shift bitmap to the right >>                <<DE>>   13694000
         WHILE SHIFT'ADJ >= 16 <<bit per word>> DO             <<DE>>   13696000
            BEGIN                                              <<DE>>   13698000
            SHIFT'ADJ := SHIFT'ADJ - 16;                       <<DE>>   13700000
            I:=LBUF+DSVMBASE+1;                                <<DE>>   13702000
            WHILE (I:=I-1) >= DSVMBASE DO                      <<DE>>   13704000
               LBUF(I+1) := LBUF(I);                           <<DE>>   13706000
            END;                                               <<DE>>   13708000
                                                               <<DE>>   13710000
         FOR I:=(LBUF+DSVMBASE) UNTIL (NEW'BITWORDS+DSVMBASE-2)<<DE>>   13712000
             DO LBUF(I) := %177777;                            <<DE>>   13714000
         TOS := LBUF(LBUF+DSVMBASE-1);  <<Fill out last word>> <<DE>>   13716000
         DO BEGIN                                              <<DE>>   13718000
            ASSEMBLE (TSBC 0,X);                               <<DE>>   13720000
            IF <> THEN GO START'SHIFT'RIGHT;                   <<DE>>   13722000
            END UNTIL (X:=X-1) < 0;                            <<DE>>   13724000
         X   := 15;     << Put 15 in X reg. for TSBC instr. >> <<DE>>   13726000
                                                               <<DE>>   13728000
 START'SHIFT'RIGHT:                                            <<DE>>   13730000
         LBUF (LBUF+DSVMBASE-1) := TOS;                        <<DE>>   13732000
         I:=LBUF+DSVMBASE-1; <<Shift starting with last word>> <<DE>>   13734000
         WHILE (I:=I-1) >= DSVMBASE DO                         <<DE>>   13736000
            BEGIN                                              <<DE>>   13738000
            MLBUF := J := 0;                                   <<DE>>   13740000
            WHILE (J:=J+1) <= SHIFT'ADJ DO                     <<DE>>   13742000
               BEGIN                                           <<DE>>   13744000
               MLBUF := MLBUF & LSR(1);                        <<DE>>   13746000
               IF LBUF(I).(15:1)=1 THEN MLBUF.(0:1):=1;        <<DE>>   13748000
               LBUF (I) := LBUF(I) & LSR(1);                   <<DE>>   13750000
               END;                                            <<DE>>   13752000
            LBUF(I+1) := LOGICAL(LBUF(I+1)) LOR MLBUF;         <<DE>>   13754000
            END;                                               <<DE>>   13756000
         FOR I:=1 UNTIL SHIFT'ADJ DO                           <<DE>>   13758000
            BEGIN                                              <<DE>>   13760000
            LBUF(2) := LBUF(2) & LSR(1);                       <<DE>>   13762000
            LBUF(2).(0:1) := 0; <<sectors are now allocated>>  <<DE>>   13764000
            END;                                               <<DE>>   13766000
         END                                                   <<DE>>   13768000
                                                               <<DE>>   13770000
                                                               <<DE>>   13772000
   << * * * * * * DIRECTORY SMALLER * * * * * * * >>           <<DE>>   13774000
      ELSE BEGIN << Directory got smaller, shift left >>       <<DE>>   13776000
         WHILE SHIFT'ADJ <= -16 <<bit per word>> DO            <<DE>>   13778000
            BEGIN                                              <<DE>>   13780000
            SHIFT'ADJ := SHIFT'ADJ + 16;                       <<DE>>   13782000
            I:=DSVMBASE;                                       <<DE>>   13784000
            WHILE (I:=I+1) >= LBUF+DSVMBASE+1 DO               <<DE>>   13786000
               LBUF(I-1) := LBUF(I);                           <<DE>>   13788000
            END;                                               <<DE>>   13790000
                                                               <<DE>>   13792000
         FOR I:=(NEW'BITWORDS+DSVMBASE) UNTIL (LBUF+DSVMBASE+1)<<DE>>   13794000
             DO LBUF(I) := 0;   << not used >>                 <<DE>>   13796000
                                                               <<DE>>   13798000
 START'SHIFT'LEFT:                                             <<DE>>   13800000
         I := DSVMBASE;   << Shift starting with first word >> <<DE>>   13802000
         DO BEGIN                                              <<DE>>   13804000
            MLBUF := J := 0;                                   <<DE>>   13806000
            MLBUF2 := LBUF(I+2);                               <<DE>>   13808000
            WHILE (J:=J+1) <= -SHIFT'ADJ DO                    <<DE>>   13810000
               BEGIN                                           <<DE>>   13812000
               MLBUF := MLBUF & LSL(1);                        <<DE>>   13814000
               IF LBUF(I+1).(0:1)=1 THEN MLBUF.(15:1):=1;      <<DE>>   13816000
               LBUF (X) := LBUF(X) & LSL(1);                   <<DE>>   13818000
               IF MLBUF2.(0:1)=1 THEN LBUF(X).(15:1):=1;       <<DE>>   13820000
               MLBUF2 := MLBUF2 & LSL(1);                      <<DE>>   13822000
               LBUF (I).(15:1) := 0;                           <<DE>>   13824000
               END;                                            <<DE>>   13826000
            LBUF(I) := LOGICAL(LBUF(I)) LOR MLBUF;             <<DE>>   13828000
            END UNTIL (I:=I+1) > NEW'BITWORDS+DSVMBASE+2;      <<DE>>   13830000
         LBUF(NEW'BITWORDS+DSVMBASE)   := 0;  <<Terminator>>   <<DE>>   13832000
         LBUF(NEW'BITWORDS+DSVMBASE-1) := SAVE'LAST;           <<DE>>   13834000
         END;                                                  <<DE>>   13836000
                                                               <<DE>>   13838000
      LBUF := NEW'BITWORDS + DSVMBASE -1;                      <<DE>>   13840000
                                                               <<DE>>   13842000
                                                               <<DE>>   13844000
      << Open temp file for new directory and copy >>          <<DE>>   13846000
      DSECT := (IF SECTORS < DIRSECT THEN SECTORS              <<DE>>   13848000
                ELSE DIRSECT);                                 <<DE>>   13850000
      DIRFNUM := FOPEN (DIRFNAME,0,%(2)1000100,,,,,,,          <<DE>>   13852000
                        DOUBLE(DSECT), 1);                     <<DE>>   13854000
      IF <> THEN                                               <<DE>>   13856000
         BEGIN                                                 <<DE>>   13858000
         FCHECK (DIRFNUM, ERRORCODE);                          <<DE>>   13860000
         FERROR (DIRFNUM, DIRFNAME );                          <<DE>>   13862000
         END;                                                  <<DE>>   13864000
      FGETINFO (DIRFNUM,,,,,,DIRFLDEV,,,,,,,,,,,,,DIR'BASE);   <<DE>>   13866000
      DIR'BASE := DIR'BASE + 1D; << Don't write on file label ><<DE>>   13868000
      WDIR'BASE := DIR'BASE;                                   <<DE>>   13870000
      MOVE BINBUF := "DIRECTORY CONVERSION BEGUN...";          <<DE>>   13872000
      PRINT(INBUF, -29, 0);                                    <<DE>>   13874000
      << Write new bitmap to temp directory file >>            <<DE>>   13876000
      TOS := ATTACHIO (DIRFLDEV,0,0,@LBUF,1,(NEW'BITSECT*128), <<DE>>   13878000
                       DIR'BASE1.(8:8), DIR'BASE2, 1);         <<DE>>   13880000
      IOERRCHECK (*, *, 1);                                    <<DE>>   13882000
      DIR'BASE := DIR'BASE + DOUBLE(ADJ);                      <<DE>>   13884000
                                                               <<DE>>   13886000
      << Parms array used in DIRECSCAN >>                      <<DE>>   13888000
      RPARMS := 0;                                             <<DE>>   13890000
      MOVE RPARMS(1) := RPARMS, (20);                          <<DE>>   13892000
      RPARMS(0) := SCAN'LEVEL;                                 <<DE>>   13894000
      RPARMS(15) := DIR'BASE1;                                 <<DE>>   13896000
      RPARMS(16) := DIR'BASE2;                                 <<DE>>   13898000
      RPARMS(17) := ADJ;                                       <<DE>>   13900000
                                                               <<DE>>   13902000
      ODIR'BASE := ADDRESS + DOUBLE(OLD'BITSECT);              <<DE>>   13904000
      DIR'BASE := DIR'BASE + DOUBLE (OLD'BITSECT);             <<DE>>   13906000
                                                               <<DE>>   13908000
      I := 0;                                                  <<DE>>   13910000
      WHILE LOGICAL(I:=I+1) <= DSECT DO                        <<DE>>   13912000
         BEGIN  << Copy old directory to new file >>           <<DE>>   13914000
         LEN := 4096;  << Attempt to write 32 sectors >>       <<DE>>   13916000
         IF DSECT-LOGICAL(I) >= 32 THEN I:=I+31                <<DE>>   13918000
            ELSE LEN := 128;                                   <<DE>>   13920000
         TOS := ATTACHIO (SYSDISC,0,0,@LBUF,0,LEN,             <<DE>>   13922000
                          ODIR'BASE1,ODIR'BASE2,1);            <<DE>>   13924000
         IOERRCHECK (*,*,0);                                   <<DE>>   13926000
         TOS := ATTACHIO (DIRFLDEV,0,0,@LBUF,1,LEN,            <<DE>>   13928000
                          DIR'BASE1.(8:8),DIR'BASE2,1);        <<DE>>   13930000
         IOERRCHECK (*,*,1);                                   <<DE>>   13932000
         DIR'BASE  := DIR'BASE  + DOUBLE( LEN.(0:9) );         <<DE>>   13934000
         ODIR'BASE := ODIR'BASE + DOUBLE( LEN.(0:9) );         <<DE>>   13936000
         END;                                                  <<DE>>   13938000
                                                               <<DE>>   13940000
      DO BEGIN                                                 <<DE>>   13942000
         TOS := DIRECSCAN (TYPEMASK(SCAN'LEVEL), 0D, RPARMS(3),<<DE>>   13944000
                           RPARMS(7), RPARMS(11), DIRC'BUILD,  <<DE>>   13946000
                           RPARMS);                            <<DE>>   13948000
         IF <> THEN FERROR (DIRFNUM, DIRFNAME);                <<DE>>   13950000
         END UNTIL (SCAN'LEVEL:=SCAN'LEVEL+1) > 2;             <<DE>>   13952000
                                                               <<DE>>   13954000
      MOVE BINBUF := "DIRECTORY CONVERSION DONE ...";          <<DE>>   13956000
      PRINT(INBUF, -29, 0);                                    <<DE>>   13958000
      END;                                                     <<DE>>   13960000
                                                               <<DE>>   13962000
   << WRITE DIRECTORY TO TAPE >>                               <<DE>>   13964000
   WORDS := DOUBLE(SECTORS) * 128D;                            <<DE>>   13966000
   IF DIRFLDEV=0 THEN DIRFLDEV:=SYSDISC;                       <<DE>>   13968000
   DIR'LIMIT := DOUBLE(DSECT) * 128D;                          <<DE>>   13970000
   WHILE WORDS <> 0D DO                                        <<DE>>   13972000
      BEGIN                                                    <<DE>>   13974000
      LEN := IF WORDS > DOUBLE(TAPERECSIZE) THEN               <<DE>>   13976000
          TAPERECSIZE ELSE LOGICAL(WORDS);                     <<DE>>   13978000
      IF DIR'LIMIT > 0D THEN                                   <<DE>>   13980000
         BEGIN                                                 <<DE>>   13982000
         TOS := ATTACHIO (DIRFLDEV, 0, 0, @LBUF, 0,            <<DE>>   13984000
                          TAPERECSIZE, WADR1.(8:8), WADR2, 1); <<DE>>   13986000
         IOERRCHECK (*, *, 0);                                 <<DE>>   13988000
         END;                                                  <<DE>>   13990000
      FWRITE (TAPEFNUM, LBUF, LEN, 0);                         <<DE>>   13992000
      IF <> THEN TAPE'ERROR;                                   <<DE>>   13994000
      DIR'LIMIT := DIR'LIMIT - DOUBLE(LEN);                    <<DE>>   13996000
      WDIR'BASE := WDIR'BASE + DOUBLE(LEN/128);                <<DE>>   13998000
      WORDS := WORDS - DOUBLE(LEN);                            <<DE>>   14000000
      END;                                                     <<DE>>   14002000
   IF DIRFNUM<>0 THEN FCLOSE (DIRFNUM, 0, 0);                  <<DE>>   14004000
END;  << DUMPDIRC >>                                           <<DE>>   14006000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>14008000
          <<--------------------------                                  14010000
            CALCULATE DIRECTORY SIZE                                    14012000
          -------------------------->>                                  14014000
  DOUBLE PROCEDURE DIRSIZE(MAXSIZE);                                    14016000
    VALUE MAXSIZE;                                                      14018000
    INTEGER MAXSIZE;                                                    14020000
    OPTION PRIVILEGED,UNCALLABLE;                                       14022000
      BEGIN                                                             14024000
        LOGICAL I:=0,USED=DIRSIZE,MIN=DIRSIZE+1;               <<DE>>   14026000
        ARRAY BITMAP (*) = DB+12;                              <<DE>>   14028000
                                                               <<00173>>14030000
        ARRAY DDS (*) = DB+0;                                  <<00173>>14032000
        EQUATE                                                 <<00173>>14034000
            DDSDST = 20,                                       <<00173>>14036000
            DIRBASE = %270;                                    <<00173>>14038000
                                                               <<00173>>14040000
      COMMENT                                                  <<00173>>14042000
          THE FOLLOWING SEQUENCE, I.E, DIRALLOCATE,            <<00173>>14044000
          DIRDEALLOCATE, AND DIRXXXBITMAP, INSURES THAT        <<00173>>14046000
          THE DIRECTORY SPACE BITMAP USED TO DETERMINE THE     <<00173>>14048000
          SIZE OF THE SYSTEM DIRECTORY IS THAT OF THE          <<00173>>14050000
          SYSTEM'S DIRECTORY.   ;                              <<00173>>14052000
                                                               <<00173>>14054000
          EXCHANGEDB (0);                                      <<00173>>14056000
          TOS := DIRDISCADR;                                   <<00173>>14058000
          S1.(0:8) := SYSDISC;                                 <<03544>>14060000
          EXCHANGEDB (DDSDST);                                 <<00173>>14062000
          DDS (DIRBASE+1) := TOS;  DDS (X:=X-1) := TOS;        <<00173>>14064000
          TOS := DIRALLOCATE(1);  << INSURE SYSTEM DISC >>     <<DE>>   14066000
          IF <> THEN << NO SPACE AVAILABLE >>                  <<01211>>14068000
            DEL  << VALUE RETURNED BY DIRALLOCATE >>           <<01211>>14070000
          ELSE                                                 <<01211>>14072000
            DIRDEALLOCATE (*, 1); << FREE SPACE >>             <<DE>>   14074000
          DIRXXXBITMAP (1);  << UPDATE BITMAP >>               <<DE>>   14076000
          EXCHANGEDB(DRSPDST);  <<DIRECTORY SPACE DST>>                 14078000
          DIRSP'NEXT2:=TRUE;  DIRSP'PREV2:=FALSE;              <<DE>>   14080000
          WHILE NOT(DIRSP'LASTIN) << Start with Last Sectors >><<DE>>   14082000
                DO DIRXXXBITMAP (0);  <<READ BITMAP>>          <<DE>>   14084000
          DIRSP'NEXT2:=FALSE;                                  <<DE>>   14086000
          MIN := (BUF'LASTWORD-DIRSPHDR) & LSL(4);             <<DE>>   14088000
  NEXTBIT:                                                     <<DE>>   14090000
          TOS := BITMAP ( MIN&LSR(4) );                        <<DE>>   14092000
          X   := MIN.(12:4);                                   <<DE>>   14094000
          ASSEMBLE (TBC 0, X);                                 <<DE>>   14096000
          IF = THEN GOTO SETMIN;  << First zero seen >>        <<DE>>   14098000
          DEL;                                                 <<DE>>   14100000
          IF = THEN GOTO SETMIN;  <<FIRST ZERO SEEN>>                   14102000
          MIN := MIN - 1;                                      <<DE>>   14104000
          IF ((MIN.(12:4)>=(128-DIRSPHDR))) OR CUR'SEGMENT=1   <<DE>>   14106000
              THEN GOTO NEXTBIT;                               <<DE>>   14108000
          << Read previous 2 sectors into buffer >>            <<DE>>   14110000
             DIRSP'PREV2 := TRUE;                              <<DE>>   14112000
             DIRXXXBITMAP (0); << READ BITMAP >>               <<DE>>   14114000
             MIN := (BUF'LASTWORD-DIRSPHDR) & LSL(4);          <<DE>>   14116000
             GOTO NEXTBIT;                                     <<DE>>   14118000
  SETMIN: MIN := MIN + 1;                                      <<DE>>   14120000
          DIRSP'NEXT2:=FALSE; DIRSP'PREV2:=FALSE;              <<DE>>   14122000
          USED := I := MIN;                                    <<DE>>   14124000
  COUNT:  <<Number of used sectors >>                          <<DE>>   14126000
          TOS := BITMAP ( I & LSR(4) );                        <<DE>>   14128000
          X := I.(12:4);                                       <<DE>>   14130000
          ASSEMBLE (TBC 0, X);                                 <<DE>>   14132000
          IF <> THEN USED:=USED-1;                             <<DE>>   14134000
          DEL;                                                 <<DE>>   14136000
          I := I - 1;                                          <<DE>>   14138000
          IF I<=0 THEN GOTO DIRSIZE'EOJ;                       <<DE>>   14140000
          IF ((I.(12:4)>=(128-DIRSPHDR))) OR CUR'SEGMENT=1     <<DE>>   14142000
              THEN GOTO COUNT;                                 <<DE>>   14144000
          << Read previous 2 sectors into buffer >>            <<DE>>   14146000
             DIRSP'PREV2 := TRUE;                              <<DE>>   14148000
             DIRXXXBITMAP (0);  << READ BITMAP >>              <<DE>>   14150000
             I := (BUF'LASTWORD-DIRSPHDR) & LSL(4);            <<DE>>   14152000
             GOTO COUNT;                                       <<DE>>   14154000
   DIRSIZE'EOJ:                                                <<DE>>   14156000
          DIRSP'NEXT2:=FALSE; DIRSP'PREV2:=FALSE;              <<DE>>   14158000
          EXCHANGEDB(0);                                                14160000
      END <<DIRSIZE>> ;                                                 14162000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>14164000
                                                                        14166000
          <<--------------------------                                  14168000
            EVALUATE RETURN FROM STORE                                  14170000
          ---------------------------->>                                14172000
  PROCEDURE EVALRETURN(B,A);                                            14174000
    VALUE B,A;                                                          14176000
    INTEGER B,A;                                                        14178000
    OPTION PRIVILEGED,UNCALLABLE;                                       14180000
      BEGIN                                                             14182000
        INTEGER ARRAY ERRNUM(3:5)=PB:=83,84,85;                         14184000
          IF A=0 THEN RETURN;   <<EVERYTHING OK>>                       14186000
          IF LOCKED AND GFRCOUNT<>0 THEN UNLOCKSTORE(GOODFNUM,TRUE);    14188000
          IF A=1 THEN                                                   14190000
            BEGIN  <<FILE ERROR>>                                       14192000
              TOS := B;                                                 14194000
              IF S0=TAPEFNUM THEN TOS:=@TAPEFILE                        14196000
              ELSE IF S0=LISTFNUM THEN TOS := @LISTFILE                 14198000
              ELSE IF S0=GOODFNUM THEN TOS := @GOODFILE                 14200000
              ELSE TOS := @ERRORFILE;                                   14202000
              FERROR(*,*);                                              14204000
            END;                                                        14206000
          IF SIRS THEN                                                  14208000
            BEGIN  <<RELEASE SIRS>>                                     14210000
              RELSIR(DIRSIR,DSIR);                                      14212000
              RELSIR(FLABSIR,FSIR);                                     14214000
              RELSIR(FMAVTSIR,FMSIR);                          <<00197>>14216000
            END;                                                        14218000
          RESETCRITICAL(0);  <<IN CASE IN CRITICAL MODE>>               14220000
          IF 3<=A<=5 THEN                                      <<00134>>14222000
             MESSAGE(ERRNUM(A))                                <<00134>>14224000
          ELSE                                                 <<00134>>14226000
             GENMSG(CIMSGSET,A);                               <<00134>>14228000
          QUIT(0);                                                      14230000
      END <<EVALRETURN>> ;                                              14232000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>14234000
PROCEDURE IOERRCHECK(B,A);                                     <<00.SD>>14236000
VALUE B,A;                                                     <<00.SD>>14238000
INTEGER B,A;                                                   <<00.SD>>14240000
  BEGIN                                                        <<00.SD>>14242000
  TOS:=B.(8:8);                                                <<00.SD>>14244000
  IF S0<>NOERR THEN                                            <<00.SD>>14246000
    BEGIN                                                      <<00.SD>>14248000
    MOVE FULLNAME:="SERIAL DISC";                              <<00.SD>>14250000
    TOS:=-TOS;                                                 <<00.SD>>14252000
    FERROR(*,FULLNAME);                                        <<00.SD>>14254000
    END;                                                       <<00.SD>>14256000
  DEL;                                                         <<00.SD>>14258000
  END;                                                         <<00.SD>>14260000
                                                               <<00.SD>>14262000
$PAGE "MAINSEG1 --  INITIALIZATION"                                     14264000
$CONTROL SEGMENT=INIALIZE                                      <<01073>>14266000
                                                               <<12.KM>>14268000
LOGICAL PROCEDURE CHANGEVERSION(INPUT,VERSID);                 <<12.KM>>14270000
  VALUE INPUT,VERSID;                                          <<12.KM>>14272000
  BYTE POINTER INPUT,                                          <<12.KM>>14274000
               VERSID;                                         <<12.KM>>14276000
BEGIN                                                          <<12.KM>>14278000
  COMMENT:                                                     <<12.KM>>14280000
    "VERSID" POINTS TO THE   L A S T   POSITION IN THE         <<12.KM>>14282000
    SYSTEM VERSION ID.                                         <<12.KM>>14284000
                                                               <<12.KM>>14286000
    WE PACK SUCCESSIVE FIELDS INTO "VERSID", DRIVEN BY         <<12.KM>>14288000
    "FIELDSIZE".  THE COMPLETE FIELD MUST BE SPECIFIED.        <<12.KM>>14290000
    FIELDS MUST BE ALPHANUMERIC.  ANY ADDITIONAL INPUT         <<12.KM>>14292000
    IS FLAGGED AS AN ERROR.  (WE DEBLANK INPUT ON LEFT         <<12.KM>>14294000
    AND RIGHT.);                                               <<12.KM>>14296000
                                                               <<12.KM>>14298000
  LABEL EXITINSTR;                                             <<12.KM>>14300000
  DEFINE EXITPROC= ASSEMBLE(BR *+1,I; CON EXITINSTR) #;        <<12.KM>>14302000
                                                               <<12.KM>>14304000
  EQUATE DOT= ".";                     <<ZERO IN LEFT BYTE>>   <<12.KM>>14306000
  INTEGER ARRAY FIELDSIZE(*)=PB:= 2, 2, 1, 32767;              <<12.KM>>14308000
  INTEGER ARRAY FIELDEND(*)=PB:= DOT, DOT, 0, 0;               <<12.KM>>14310000
                                                               <<12.KM>>14312000
  EQUATE CR= %15;                                              <<12.KM>>14314000
  BYTE POINTER STRING;                                         <<12.KM>>14316000
  INTEGER FIELDINX:=0,                                         <<12.KM>>14318000
          FSIZE,                                               <<12.KM>>14320000
          LENGTH;                                              <<12.KM>>14322000
                                                               <<12.KM>>14324000
  EQUATE BADCHAR=   0,                                         <<12.KM>>14326000
         BADDELIM=  1,                                         <<12.KM>>14328000
         EXTRACHAR= 2;                                         <<12.KM>>14330000
                                                               <<12.KM>>14332000
  SUBROUTINE VERROR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM;     <<12.KM>>14334000
  BEGIN                                                        <<12.KM>>14336000
    MESSAGE(1);                                                <<12.KM>>14338000
    CHANGEVERSION:=FALSE;                                      <<12.KM>>14340000
    EXITPROC;                                                  <<12.KM>>14342000
  END <<SUBROUTINE VERROR>>;                                   <<12.KM>>14344000
                                                               <<12.KM>>14346000
                                                               <<12.KM>>14348000
  SCAN INPUT WHILE BLANK,1;            <<DEBLANK INPUT>>       <<12.KM>>14350000
  @STRING:=TOS;                                                <<12.KM>>14352000
  SCAN STRING UNTIL CR,1;                                      <<12.KM>>14354000
  LENGTH:=TOS-LOGICAL(@STRING);                                <<12.KM>>14356000
  WHILE LENGTH>0 AND STRING(LENGTH-1)=" " DO LENGTH:=LENGTH-1; <<12.KM>>14358000
                                                               <<12.KM>>14360000
  WHILE LENGTH>=(FSIZE:=FIELDSIZE(FIELDINX)) DO                <<12.KM>>14362000
    BEGIN                                                      <<12.KM>>14364000
    DO                                 <<PACK FIELD>>          <<12.KM>>14366000
      BEGIN                                                    <<12.KM>>14368000
      LENGTH:=LENGTH-1;                                        <<12.KM>>14370000
      IF (VERSID:=STRING(LENGTH))=SPECIAL THEN VERROR(BADCHAR);<<12.KM>>14372000
      @VERSID:=@VERSID(-1);                                    <<12.KM>>14374000
      END                                                      <<12.KM>>14376000
    UNTIL (FSIZE:=FSIZE-1)<=0;                                 <<12.KM>>14378000
    IF FIELDSIZE(FIELDINX).(15:1)=1 THEN                       <<12.KM>>14380000
      BEGIN                            <<CONSUME EVEN BYTES>>  <<12.KM>>14382000
      VERSID:=" ";                                             <<12.KM>>14384000
      @VERSID:=@VERSID(-1);                                    <<12.KM>>14386000
      END;                                                     <<12.KM>>14388000
    IF LENGTH<>0 AND FIELDEND(FIELDINX)<>0 THEN                <<12.KM>>14390000
      BEGIN                            <<SKIP DELIMITER>>      <<12.KM>>14392000
      LENGTH:=LENGTH-1;                                        <<12.KM>>14394000
      IF INTEGER(STRING(LENGTH))<>FIELDEND(FIELDINX)           <<12.KM>>14396000
         THEN VERROR(BADDELIM);                                <<12.KM>>14398000
      END;                                                     <<12.KM>>14400000
    FIELDINX:=FIELDINX+1;                                      <<12.KM>>14402000
    END;                                                       <<12.KM>>14404000
  IF LENGTH<>0 THEN VERROR(EXTRACHAR);                         <<12.KM>>14406000
  CHANGEVERSION:=TRUE;                                         <<12.KM>>14408000
                                                               <<12.KM>>14410000
EXITINSTR:                                                     <<12.KM>>14412000
END <<PROCEDURE CHANGEVERSION>>;                               <<12.KM>>14414000
                                                               <<12.KM>>14416000
                                                               <<12.KM>>14418000
$CONTROL SEGMENT=INIALIZE                                      <<01073>>14420000
        PROCEDURE SETVERSION;                                  <<01073>>14422000
        OPTION PRIVILEGED,UNCALLABLE;                          <<01073>>14424000
        BEGIN                                                  <<14.KM>>14426000
          VERSION:=CTAB0(VERSION');                            <<14.KM>>14428000
          UPDATEL:=CTAB0(UPDATEL');                            <<14.KM>>14430000
          FIXLEVEL:=CTAB0(FIXLEVEL');                          <<14.KM>>14432000
        END;  << SETVERSION >>                                 <<01073>>14434000
  PROCEDURE INITIALIZATION;                                    <<01073>>14436000
    OPTION PRIVILEGED,UNCALLABLE;                              <<01073>>14438000
      BEGIN                                                    <<01073>>14440000
                                                               <<04327>>14442000
        EQUATE       <<DISC COLD LOAD INFO TAB OFFSETS>>       <<04327>>14444000
          TABPTR = 0,     <<PNTR TO TABLE INFO>>               <<04327>>14446000
          LDTXADDR1 = 42, <<OFFSET INTO TAB INFO TO THE>>      <<04327>>14448000
          LDTXADDR2 = 43; <<  DISC ADDR OF THE LDTX    >>      <<04327>>14450000
                                                               <<04327>>14452000
        INTEGER CNT,      <<TRANSFER COUNT USED BY ATTACHIO>>  <<04327>>14454000
                ADDR1,                                         <<04327>>14456000
                ADDR2;                                         <<04327>>14458000
                                                               <<04327>>14460000
          PUSH(DL);                                                     14462000
          X := TOS-PS0(-1).(4:12);                                      14464000
          DB2(X).(0:1) := 1;<<SET SYSTEM MANAGER ATTRIBUTE>>   <<+0.06>>14466000
          <<BIT IN PCBX>>                                      <<+0.06>>14468000
          WHO(MODE,CAPABILITY);                                         14470000
          IF ATTRIB.(5:1)=0 THEN                                        14472000
            BEGIN                                                       14474000
            MESSAGE(101); <<USER WITHOUT REQUIED CAPABILITIES>>         14476000
COMMENT:                                                       <<+0.06>>14478000
        SYSTEM MANAGER IS REQUIRED.                            <<+0.06>>14480000
        END OF COMMENT;                                        <<+0.06>>14482000
            QUIT(0);                                                    14484000
            END;                                                        14486000
                                                                        14488000
          <<--------------                                              14490000
            SET UP FILES                                                14492000
          -------------->>                                              14494000
COMMENT:                                                       <<+0.06>>14496000
        THE COMMAND INTERPRETER ISSUES THE FILE EQUATION       <<+0.06>>14498000
        (:FILE) FOR THE DUMPTAPE AND THE LISTFILE.  THIS       <<+0.06>>14500000
        SECTION USES THE COMMAND INTRINSIC TO ISSUE THE        <<+0.06>>14502000
        FILE EQUATION FOR SEGLIST, THE OUTPUT LIST FILE        <<+0.06>>14504000
        FOR SEGMENTER MESSAGES GENERATED DURING SYSTEM         <<+0.06>>14506000
        SL CHANGES OR LISTS.                                   <<+0.06>>14508000
        END OF COMMENT;                                        <<+0.06>>14510000
                                                               <<04659>>14512000
          FILL' (STORE'FILES', STORE'FILES'LEN, CR);           <<04659>>14514000
          FILL' (DUMP'DATE', DUMP'DATE'LEN, " ");              <<04659>>14516000
          LISTFNUM:=FOPEN(LISTFILE,%(2)110001100,%(2)11000001,-81);     14518000
  LISTERR:IF<> THEN FERROR(LISTFNUM,LISTFILE);                          14520000
          FGETINFO(LISTFNUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE, 14522000
            LDEV,,,,,,,,BLKSIZE);                                       14524000
          IF <> THEN GOTO LISTERR;                                      14526000
          MOVE B := "FILE SEGLIST=",2;                                  14528000
          I := FOPTIONS.(10:3);  <<DEFAULT DESIGNATOR>>                 14530000
          CASE *I OF BEGIN                                              14532000
            BEGIN  <<0: ACTUAL DESIGNATOR>>                             14534000
              TOS := @FILENAME;                                         14536000
              ASSEMBLE(DUP,DUP);                                        14538000
              SCAN * UNTIL %6440,1;  <<GET LENGTH OF FILE NAME>>        14540000
              ASSEMBLE(SUB,NEG; MVB 2);                                 14542000
              IF FOPTIONS.(14:2)=1 THEN MOVE * := ",OLD",2;             14544000
              IF FOPTIONS.(14:2)=2 THEN MOVE *:=",OLDTEMP",2;           14546000
              IF LOGICAL(FOPTIONS.(7:1)) THEN MOVE * := ";CCTL",2       14548000
              ELSE MOVE * := ";NOCCTL",2;                               14550000
              IF DEVTYPE.RBITE > 7 THEN                                 14552000
                BEGIN  <<NOT A DISC FILE>>                              14554000
                  MOVE * := ";DEV=",2;                                  14556000
                  TOS := 0;                                             14558000
                  TOS := LDEV;                                          14560000
                  TOS := 10;                                            14562000
                  TOS := S3;                                            14564000
                  TOS := ASCII(*,*,*);                                  14566000
                  ASSEMBLE(ADD);  <<NEW BUFFER PTR>>                    14568000
                END;                                                    14570000
              MOVE * := ";ACC=APPEND;REC=",2;                           14572000
              IF BLKSIZE<0 THEN BLKSIZE := (-BLKSIZE+1)/2;              14574000
              IF RECSIZE<0 THEN L := BLKSIZE*(-2)/RECSIZE               14576000
              ELSE L := BLKSIZE/RECSIZE;                                14578000
              TOS := 0;                                                 14580000
              TOS := RECSIZE;                                           14582000
              TOS := 10;                                                14584000
              TOS := S3;                                                14586000
              TOS := ASCII(*,*,*);                                      14588000
              ASSEMBLE(ADD);                                            14590000
              BPS0 := ",";                                              14592000
              TOS := TOS+1;                                             14594000
              TOS := 0;                                                 14596000
              TOS := L;                                                 14598000
              TOS := 10;                                                14600000
              TOS := S3;                                                14602000
              TOS := ASCII(*,*,*);                                      14604000
ASSEMBLE(ADD);                                                 <<02810>>14606000
              BPS0 := ",";                                              14608000
              TOS := TOS+1;                                             14610000
              CASE * FOPTIONS.(8:2) OF                                  14612000
                BEGIN  <<RECORD TYPE>>                                  14614000
                  BPS0 := "F";                                          14616000
                  BPS0 := "V";                                          14618000
                  BPS0 := "U";                                          14620000
                END;                                                    14622000
              TOS := TOS+1;                                             14624000
              IF LOGICAL(FOPTIONS.(13:1)) THEN MOVE * := ",ASCII",2     14626000
              ELSE MOVE * := ",BINARY",2;                               14628000
            END;                                                        14630000
              MOVE * := "$STDLIST",2;                                   14632000
              MOVE * := "$NEWPASS",2;                                   14634000
              MOVE * := "$OLDPASS",2;                                   14636000
              MOVE * := "$STDIN",2;                                     14638000
              MOVE * := "$STDINX",2;                                    14640000
              MOVE * := "$NULL",2;                                      14642000
            END;                                                        14644000
          BPS0 := %15;                                                  14646000
          DEL;                                                          14648000
          COMMAND(B,I,J);                                               14650000
                                                                        14652000
          <<----------------                                            14654000
            SET UP DL AREA                                              14656000
          ---------------->>                                            14658000
                                                                        14660000
COMMENT     THE DL AREA IS BUILT WITH THE TABLES WHICH ARE EXPECTED TO  14662000
          EXPAND THE MOST CLOSEST TO DL. 5 TABLES MAY EXPAND DURING THE 14664000
          CONFIGURATION DIALOGUE. THEIR POINTERS MOST RESIDE IN ORDER   14666000
          IN THE DIRECT ARRAY TABLEPTRS AND THE INCREMENTS (OR          14668000
          DECREMENTS) WHEN MOVING THEM ARE PLACED IN THE DIRECT ARRAY   14670000
          TABLEINCRS, ONCE AGAIN IN THE ORDER THE TABLES APPEAR IN      14672000
          MEMORY. THE DL AREA LOOKS LIKE THIS:                          14674000
                                                                        14676000
                  DL => --------------------                            14678000
                        -  EXPANSION AREA  -                            14680000
             BLINBUF => --------------------                   <<00778>>14682000
                        -     FILENAME     -                   <<00778>>14684000
                        -      BUFFER      -                   <<00778>>14686000
               CSTAB => --------------------                            14688000
                        -        CS        -                            14690000
                        -      TABLE       -                            14692000
              DVRTAB => --------------------                            14694000
                        -      DRIVER      -                            14696000
                        -       TABLE      -                            14698000
                LPDT => --------------------                            14700000
                        - LOGICAL-PHYSICAL -                            14702000
                        -  DEVICE TABLE    -                            14704000
                 LDT => --------------------                            14706000
                        -    LOGICAL       -                            14708000
                        -  DEVICE TABLE    -                            14710000
             DVCLTAB => --------------------                            14712000
            (BYTE PTR)  -  DEVICE CLASS    -                            14714000
                        -      TABLE       -                            14716000
                          LDTX => --------------------         <<00.06>>14718000
                                  -    LOGICAL       -         <<00.06>>14720000
                                  -  DEVICE TABLE    -         <<00.06>>14722000
                                  -   EXTENSION      -         <<00.06>>14724000
                VTAB => --------------------                            14726000
                        -    VOLUME        -                            14728000
                        -     TABLE        -                            14730000
             OLDVTAB => --------------------                            14732000
                        -    UNCHANGED     -                            14734000
                        -   VOLUME TABLE   -                            14736000
                 RIN => --------------------                            14738000
                        -        RIN       -                            14740000
                        -       TABLE      -                            14742000
                CTAB => --------------------                            14744000
                        - CURRENT CORESIZE -                            14746000
                        -  CONFIGURATION   -                            14748000
                        -    INFORMATION   -                            14750000
               CTAB0 => --------------------                            14752000
                        -   NON-CORESIZE   -                            14754000
                        -     RELATED      -                            14756000
                        -  CONFIGURATION   -                            14758000
                        -    INFORMATION   -                            14760000
                  DB => -------------------- ;                          14762000
                                                                        14764000
          CPUTYPE:=THISCPU; <<DETERMINE WHICH HP3000 THIS IS>> <<TP.00>>14766000
          DATE:=CALENDAR;                                      <<00072>>14768000
          TIME:=CLOCK;                                         <<00072>>14770000
          IF CPUTYPE = ICF55  <<SET MAX ALLOWABLE DRT >>       <<03006>>14772000
                              <<BASED ON CPU TYPE>>            <<03006>>14774000
          THEN MAXDRT := 511  <<EXPANDED 9 BIT DRT>>           <<03006>>14776000
          ELSE MAXDRT := 127; <<ORIG 7 BIT DRT>>               <<03006>>14778000
          IF SERIESII'III THEN                                 <<02509>>14780000
             MINDRT:=4                                         <<00072>>14784000
          ELSE                                                 <<00072>>14786000
             IF POSTSERIES3 THEN                               <<01402>>14788000
                MINDRT:=8                                      <<00072>>14790000
             ELSE                                              <<00072>>14792000
                MESSAGE(171);                                  <<00072>>14794000
          CTABFNUM := FOPEN(CTABFILE,%(2)10000000001,%(2)110000);       14796000
                                           <<CONFIGURATION FILE>>       14798000
          IF <> THEN GOTO CTABERR;                                      14800000
          DLLEN := DLSIZE(-CTABSIZE-CTAB0SIZE);<<ROOM FOR FIRST 2 TBLS>>14802000
          IF <> THEN                                                    14804000
            BEGIN                                                       14806000
  DLERR:      MESSAGE(85); <<UNABLE TO OBTAIN STACK SPACE>>             14808000
              QUIT(0);                                                  14810000
            END;                                                        14812000
          TOS := -CTAB0SIZE;                                            14814000
          @CTAB0 := S0;                                                 14816000
          @CTAB := TOS-CTABSIZE;                                        14818000
          FREAD(CTABFNUM,CTAB0,CTAB0SIZE); <<NON-CORESIZE RELATED INFO>>14820000
  CTABERR:IF <> THEN FERROR(CTABFNUM,CTABFILE);                         14822000
          COREX := CTAB0(COREX');   <<CORE SIZE INDEX>>                 14824000
          HLDEV := CTAB0(HLDEV');      <<HIGHEST LOGICAL DEVICE #>>     14826000
          DVCLSIZE := CTAB0(DVCLSIZE');<<SIZE OP DEVICE CLASS TABLE>>   14828000
          NVOL := CTAB0(HVOL');        <<MVOL/HVOL>>           <<RH.PV>>14830000
          FREADDIR(CTABFNUM,CTAB,CTABSIZE,D'L(COREX+CTABREC)));         14832000
          IF <> THEN GOTO CTABERR;                                      14834000
          EXCHANGEDB(RINDSTN);                                          14836000
          TOS := DBARRAY(1);<<OFFSET TO GLOBAL AREA>>                   14838000
          X := S0+1;                                                    14840000
          TOS := DBARRAY(X);  <<# OF GLOBAL RINS>>                      14842000
          EXCHANGEDB(0);                                                14844000
          CTAB(GRINS') := TOS;                                          14846000
          CTAB(RINS') := TOS&LSR(1)-1;                                  14848000
          TOS := SETSYSDB;                                              14850000
          TOS := DBARRAY(COLDLOADCNT);                                  14852000
          TOS := S1;                                                    14854000
          RESETDB(*);                                                   14856000
          COLDLOADID := TOS;                                            14858000
          DEL;                                                          14860000
   TOS:=0;                                                     <<00506>>14862000
          DIRSECT := CTAB(DIRSECT');  <<SIZE OF DIRECTORY>>             14864000
   TOS:=CTAB(NLOGPROCS)*33+33;  <<SIZE OF LIDTAB>>             <<00506>>14866000
   LIDTABLEN:=S0;                                              <<00506>>14868000
   TOS:=-TOS+@CTAB;                                            <<00506>>14870000
   @LIDTAB:=S0;                                                <<00506>>14872000
          RINS := CTAB(RINS');        <<# OF RINS>>                     14874000
          GRINS := CTAB(GRINS');      <<# OF GLOBAL RINS>>              14876000
                                                               <<00506>>14878000
          TOS := ((RINS&LSL(1)+GRINS*12+9)&LSR(2))&LSL(2);              14880000
          RINLEN := S0;   <<SIZE OR RIN TABLE>>                         14882000
ASSEMBLE(NEG,ADD);                                             <<00506>>14884000
          @RIN := S0;     <<PTR TO RIN TABLE>>                          14886000
          TOS := (MVOL+1)*VTABSIZE;  <<SIZE OF VOLUME TABLE>>  <<RH.PV>>14888000
          ASSEMBLE(NEG,DUP; CAB,ADD; DUP);                              14890000
          @OLDVTAB := TOS;<<PTR TO UNCHANGED COPY OF VOLUME TABLE>>     14892000
          @TEMPCLASS:=@TCLASS&LSL(1);                          <<03704>>14894000
          ASSEMBLE(ADD,DUP);                                            14896000
          @VTAB := TOS;   <<PTR TO VOLUME TABLE>>                       14898000
          TOS:=TOS-(HLDEV+1)*LDTXSIZE;                         <<00.06>>14900000
          @LDTX:=S0; <<PTR TO LDT EXTENSION>>                  <<00.06>>14902000
          TOS := TOS-DVCLSIZE;                                          14904000
          @DVCLTAB := S0&LSL(1); <<BYTE PTR TO DEVICE CLASS TAB<<03704>>14906000
          TOS := TOS-(HLDEV+1)*LDTSIZE;                                 14908000
          @LDT := S0;   <<PTR TO LOGICAL DEVICE TABLE>>                 14910000
          TOS := TOS-(HLDEV+1)*LPDTSIZE;                                14912000
          @LPDT := S0;  <<PTR TO LOGICAL-PHYSICAL DEVICE TABLE>>        14914000
          TOS := TOS-(HLDEV+1)*DVRSIZE;                                 14916000
          @DVRTAB := S0;   <<PTR TO DRIVER TABLE>>                      14918000
          TOS := TOS-CTAB0(CSTABSIZE);                                  14920000
          @CSTAB := S0;                                                 14922000
          @BLINBUF:=S0&LSL(1);<<BYTE PTR TO FILE NAME BUFFER>> <<03704>>14924000
          DLLEN := DLSIZE(*);  <<GET SPACE FOR REST OF TABLES>>         14926000
          IF <> THEN GOTO DLERR;                                        14928000
                                                                        14930000
          <<--------------------------                                  14932000
            MOVE TABLES INTO DL AREA                                    14934000
          -------------------------->>                                  14936000
      TOS:=@LIDTAB;                                            <<00506>>14938000
      TOS:=LIDDST;                                             <<00506>>14940000
      TOS:=0;                                                  <<00506>>14942000
      TOS:=LIDTABLEN;                                          <<00506>>14944000
      ASSEMBLE(MFDS 4);                                        <<00506>>14946000
          RSIR := GETSIR(RINSIR);                                       14948000
          TOS := @RIN;                                                  14950000
          TOS := RINDSTN;                                               14952000
          TOS := 0;                                                     14954000
          TOS := RINLEN;                                                14956000
          ASSEMBLE(MFDS 4);       <<MOVE RIN TABLE>>                    14958000
          RELSIR(RINSIR,RSIR);                                          14960000
          TOS := @OLDVTAB;                                              14962000
          TOS := VTABDSTN;                                              14964000
          TOS := 0;                                                     14966000
          TOS := (MVOL+1)*VTABSIZE;                            <<RH.PV>>14968000
          X := S0;                                                      14970000
          ASSEMBLE(MFDS 4); <<MOVE IN UNCHANGED COPY OF VOLUME TABLE>>  14972000
          MOVE VTAB := OLDVTAB,(X); <<VOLUME TABLE TO BE CHANGED>>      14974000
          TOS := @LDT;                                                  14976000
          TOS := LDTDSTN;                                               14978000
          TOS := 0;                                                     14980000
          TOS := (HLDEV+1)*LDTSIZE;                                     14982000
          ASSEMBLE(MFDS 4); <<LOGICAL DEVICE TABLE>>                    14984000
          TOS := WORDADDRESS(DVCLTAB);                         <<03704>>14986000
          TOS := LDTDSTN;                                               14988000
          TOS := LDT(DCFIRST);                                          14990000
          TOS := DVCLSIZE;                                              14992000
          ASSEMBLE(MFDS 4);  <<DEVICE CLASS TABLE>>                     14994000
          TOS := @LPDT;                                                 14996000
          TOS := LPDTDSTN;                                              14998000
          TOS := 0;                                                     15000000
          TOS := (HLDEV+1)*LPDTSIZE;                                    15002000
          ASSEMBLE(MFDS 4);<<LOGICAL-PHYSICAL DEVICE TABLE>>            15004000
          TOS := @CSTAB;                                                15006000
          TOS := CSDSTN;                                                15008000
          TOS := 0;                                                     15010000
          TOS := CTAB0(CSTABSIZE);                                      15012000
          ASSEMBLE(MFDS 4);                                             15014000
          << SYSDUMP NOW USES THE VERSION OF THE LDTX FROM >>  <<04327>>15018000
          << POINTED TO BY THE CLIT, RATHER THAN DST%16. >>    <<04327>>15020000
                                                               <<04327>>15022000
          <<READ THE CLIT (SECTOR #28) INTO LBUF>>             <<04327>>15024000
          TOS := ATTACHIO(SYSDISC,0,0,@LBUF,0,INFOSIZE,        <<04327>>15026000
                          0,INFOSECT,1);                       <<04327>>15028000
          IOERRCHECK (*,*);                                    <<04327>>15030000
          <<FINDS THE ADDR OF THE LDTX AND IT'S SIZE>>         <<04327>>15032000
          TEMP := LBUF(TABPTR);  <<WD 0 OF CLIT>>              <<04327>>15034000
          ADDR1 := LBUF(TEMP + LDTXADDR1);  << DISC ADDR OF >> <<04327>>15036000
          ADDR2 := LBUF(TEMP + LDTXADDR2);  <<   THE LDTX   >> <<04327>>15038000
          CNT := (HLDEV +1) * LDTXSIZE;  <<SIZE OF LDTX>>      <<04327>>15040000
          <<READ THE LDTX INTO THE DL AREA>>                   <<04327>>15042000
          TOS := ATTACHIO(SYSDISC,0,0,@LDTX,0,CNT,ADDR1,       <<04327>>15044000
                          ADDR2,1);                            <<04327>>15046000
          IOERRCHECK (*,*);                                    <<04327>>15048000
          CSTAB := CTAB0(CSTABSIZE);<<UPDATE SIZE OF TABLE>>            15050000
          FREADDIR(CTABFNUM,DVRTAB,(HLDEV+1)*DVRSIZE,DVRREC); <<DRIVER>>15052000
          IF <> THEN GOTO CTABERR;                                      15054000
          FREADDIR(CTABFNUM,CSDEF,CSDEFSIZE,CSDEFREC);                  15056000
          IF <> THEN GO CTABERR;                                        15058000
          FREADDIR(CTABFNUM,CSDVR,CSDVRTSIZE,CSDVRREC);                 15060000
          IF <> THEN GO CTABERR;                                        15062000
          LPDT(1):=0;                                          <<01.00>>15064000
          I:=1;                                                <<01.00>>15066000
          DO                                                   <<01.00>>15068000
            BEGIN <<CLEAN UP LOGICAL-PHYSICAL DEVICE TABLE>>   <<01.00>>15070000
            IF NOT LDEV'EXISTS(I) THEN                         <<03544>>15072000
                                                               <<03544>>15074000
              BEGIN <<DEVICE DOES NOT EXIST>>                  <<01.00>>15076000
              LPDT(I*LPDTSIZE):=0;                             <<01.00>>15078000
              LPDT(X:=X+1):=0;                                 <<01.00>>15080000
              END                                              <<01.00>>15082000
            ELSE                                               <<01.00>>15084000
              BEGIN <<DEVICE EXISTS>>                          <<01.00>>15086000
              TOS:=LPDT(I*LPDTSIZE+1);                         <<01.00>>15088000
              IF LS0.NSDV AND                                  <<03544>>15090000
                 LDT(I*LDTSIZE+LDT2).RANGE=DIRACCESS THEN      <<03544>>15092000
                TOS := TOS LAND %30017   <<CLEAR NON-SYS DEV>> <<RH.PV>>15094000
              ELSE                                             <<RH.PV>>15096000
                TOS := TOS LAND %33017;  <<CLEAR>>             <<RH.PV>>15098000
              <<NON-CONFIGURATION BITS>>                       <<01.00>>15100000
              LPDT(I*LPDTSIZE+1) := TOS;                       <<01.00>>15102000
              LPDT(X:=X-1) := 0;                               <<01.00>>15104000
              END;                                             <<01.00>>15106000
            END <<CLEAN UP>>                                   <<01.00>>15108000
          UNTIL (I:=I+1) > HLDEV;                              <<01.00>>15110000
          DVCLSIZE := DVCLSIZE&LSL(1); <<CONVERT TO BYTE COUNT>>        15112000
          LDT(4) := 0;                                                  15114000
          I := 1;                                                       15116000
          DO                                                            15118000
            BEGIN  <<CLEAN UP LOGICAL DEVICE TABLE AND LDTX>>  <<00134>>15120000
              IF NOT LDEV'EXISTS(I) THEN                       <<03544>>15122000
                                                               <<03544>>15124000
                BEGIN                                                   15126000
                LDT(I*LDTSIZE) := 0;                                    15128000
                TOS := @LDT(X)+1;                                       15130000
                MOVE *:=LDT(X),(LDTSIZE-1);                    <<00134>>15132000
                LDTX(I*LDTXSIZE):=0;                           <<00134>>15134000
                TOS:=@LDTX(X)+1;                               <<00134>>15136000
                MOVE *:=LDTX(X),(LDTXSIZE-1);                  <<00134>>15138000
                END                                                     15140000
              ELSE                                                      15142000
                BEGIN                                                   15144000
                LDT(I*LDTSIZE) := 0;                                    15146000
                LDT(X:=X+1) := 0;                                       15148000
                LDT(X:=X+1).(9:1) := 0;                                 15150000
                LDT(X:=X+1).(2:5) := %20;                               15152000
                IF LDT(X).(0:2)=2 THEN                                  15154000
                  LDT(X:=X+1).(7:1) := 1;                               15156000
                LDTX(I*LDTXSIZE+1):=0; <<CLEAR DST# FOR>>      <<00134>>15158000
                <<ALLOCATED SDISC>>                            <<00134>>15160000
                END;                                                    15162000
            END                                                         15164000
          UNTIL (I:=I+1) > HLDEV;                                       15166000
          COMPACTRIN;                                                   15168000
X:= 0;                                                         <<04253>>15170000
WHILE X<SYSPROG'CHG'TABLE'LIMIT DO                             <<04253>>15172000
  BEGIN                                                        <<04253>>15174000
  BSPC(X):= 0;                                                 <<04253>>15176000
  X:= X+34;                                                    <<04253>>15178000
  END;                                                         <<04253>>15180000
          SETVERSION;                                          <<14.KM>>15182000
      END;                                                     <<01073>>15184000
$PAGE "             INITIALIZE SYSDUMP CHANGES"                <<01073>>15186000
$CONTROL SEGMENT=INIALIZE                                      <<01073>>15188000
  PROCEDURE INITIALIZE'CH;                                     <<01073>>15190000
  OPTION PRIVILEGED,UNCALLABLE;                                <<01073>>15192000
  BEGIN                                                        <<01073>>15194000
          DO                                                   <<12.KM>>15196000
            BEGIN                                              <<12.KM>>15198000
            SETVERSION;                                        <<14.KM>>15200000
          IF SERIESII'III THEN                                 <<02509>>15202000
            MOVE BINBUF:="SYSTEM ID = HP32002",2               <<00072>>15206000
          ELSE                                                 <<00072>>15208000
            IF CPUTYPE=LC3000 OR CPUTYPE=ICF44 OR              <<03761>>15210000
                                 CPUTYPE=ICF55 THEN            <<03761>>15212000
              MOVE BINBUF:="SYSTEM ID = HP32033",2             <<03761>>15214000
            ELSE                                               <<03761>>15216000
              MESSAGE (171);                                   <<03761>>15218000
            BPS0:=BVERSION;   TOS:=TOS+LOGICAL(1);             <<12.KM>>15224000
            BPS0:=".";        TOS:=TOS+LOGICAL(1);             <<12.KM>>15226000
            MOVE * := BUPDATEL,(2),2;                          <<12.KM>>15228000
            BPS0:=".";        TOS:=TOS+LOGICAL(1);             <<12.KM>>15230000
            MOVE * := BFIXLEVEL,(2),2;                         <<12.KM>>15232000
            MOVE * := ".?";                                    <<12.KM>>15234000
            PRINT(INBUF,14,%320);                              <<12.KM>>15236000
            READINPUT;                                         <<12.KM>>15238000
            END                                                <<12.KM>>15240000
          UNTIL CHANGEVERSION(INBUF,BVERSID'END);              <<12.KM>>15242000
  REQCORE:TEMP := CTAB0(CORESIZE);                                      15244000
          GETNEWVAL(0,TEMP,128,4096);  <<MEMORY SIZE = XXXX>>  <<01757>>15246000
          X := 0;                                                       15248000
          DO IF CORESIZES(X)=TEMP THEN GOTO COREOK   <<VALID SIZE>>     15250000
          UNTIL (X:=X+1) = NCORESIZES;                                  15252000
        <<INVALID CORE SIZE SPECIFIED>>                                 15254000
          MESSAGE(1);                                                   15256000
          GO REQCORE;                                                   15258000
        <<VALID CORE SIZE>>                                             15260000
  COREOK: TOS := X;                                                     15262000
        IF X > CORE256X THEN                                   <<.2MB.>>15264000
          BEGIN                                                <<.2MB.>>15266000
            ASSEMBLE (DEL);                                    <<.2MB.>>15268000
            TOS:=CORE256X;                                     <<.2MB.>>15270000
          END;                                                 <<.2MB.>>15272000
          COREX := S0;                                                  15274000
          CTAB0(COREX') := TOS;                                         15276000
          CTAB0(CORESIZE) := TEMP;                                      15278000
  END;                                                         <<01073>>15280000
$PAGE "             I/O CONFIGURATION CHANGES"                 <<01073>>15282000
$CONTROL SEGMENT=IOCHANGE                                      <<01073>>15284000
  PROCEDURE IO'CONFIG'CH;                                      <<01073>>15286000
  OPTION PRIVILEGED,UNCALLABLE;                                <<01073>>15288000
  BEGIN                                                        <<01073>>15290000
        BYTE ARRAY E1(0:15)=PB:="UNDEFINED CLASS ";            <<01073>>15292000
        BYTE ARRAY E2(0:41)=PB:="USED AS OUTPUT DEVICE BY",    <<01073>>15294000
                                " FOLLOWING DEVICES";          <<01073>>15296000
        INTEGER TYPE,UNIT,IDINX,PHINX,CSINDX,LASTPOLLENT,      <<01073>>15298000
                NEW'LDEV,BINDX=PHINX;                          <<03610>>15300000
        BYTE POINTER PHONE,IDLIST,BCSLDTX=PHONE;               <<01073>>15302000
        EQUATE CMAX = 1000 , SDISC = 31, FDISC = 7;            <<01115>>15304000
        BYTE ARRAY BTEMP(0:81);                                <<01073>>15306000
        ARRAY TEMPCSLDTX(0:500);                               <<03616>>15308000
        INTEGER SUBTYP;       << DEVICE SUBTYPE >>             <<03702>>15312000
        INTEGER SPEEDCDE;     << OCTAL CODE FOR TERM. SPEED >> <<03702>>15314000
          LOGICAL DSDEVICE;                                    <<01073>>15318000
                                                               <<04327>>15320000
        << SUBROUTINE TO ZERO THE LDTX ENTRY FOR A GIVEN LDEV>><<04327>>15322000
                                                               <<04327>>15324000
        SUBROUTINE ZEROLDTX;                                   <<04327>>15326000
          BEGIN                                                <<04327>>15328000
          TOS := @LDTX(LDEV * LDTXSIZE);                       <<04327>>15330000
          PS0 := 0;                                            <<04327>>15332000
          ASSEMBLE (DUP,INCB);                                 <<04327>>15334000
          TOS := LDTXSIZE-1;                                   <<04327>>15336000
          ASSEMBLE (MOVE 3);                                   <<04327>>15338000
          END;                                                 <<04327>>15340000
                                                               <<04327>>15342000
          IF YESANSWER(4) THEN LISTIODEV; <<LIST I/0 DEVICES>> <<01073>>15344000
          IF CSPRESENT THEN                                    <<01073>>15346000
           IF YESANSWER(120) THEN LISTCSDEV;                   <<01073>>15348000
          GETNEWVAL(5,CTAB0(DRTNUM),MINDRT,511);               <<03006>>15350000
             <<NOTE: ALLOW DRT UP TO 511 IN CASE USER IS>>     <<03006>>15352000
             <<CONFIGURING A SYSTEM FOR USE ON CPU WHICH>>     <<03006>>15354000
             <<SUPPORTS EXTENDED 9BIT DRT>>                    <<03006>>15356000
             <<CHECKDEV WILL GIVE WARNING LATER IF THIS CPU>>  <<03006>>15358000
             <<WON'T SUPPORT LARGE DRT>>                       <<03006>>15360000
  REQLDEV:LDEV := GETVAL(7,0,255,2);  <<LOGICAL DEVICE #?>>             15362000
          IF LDEV=0 THEN GO REQVDEV;                                    15364000
  REQDRTN:DSDEVICE := FALSE;                                            15366000
          MESSAGE(-8);   <<DRTN?>>                                      15368000
          READINPUT;                                                    15370000
          SCAN BPINBUF WHILE BLANK,1; <<DELETE LEADING BLANKS>>         15372000
          IF BPS0="#" THEN                                              15374000
            BEGIN  <<DS DEVICE>>                                        15376000
            DSDEVICE := TRUE;                                           15378000
            @BPINBUF := TOS+1;                                          15380000
            DRTN := INVAL(@REQDRTN,",");                                15382000
            IF < THEN                                                   15384000
              BEGIN <<NOT FOLLOWED BY CR>>                              15386000
              MESSAGE(1);                                               15388000
              GO REQDRTN;                                               15390000
              END;                                                      15392000
            IF NOT NON'DS'LDEV(DRTN)                           <<03726>>15396000
            THEN                                               <<03006>>15398000
              BEGIN <<DS DEVICE LINKED TO DS OR NON EXISTING DEVICE>>   15400000
              MESSAGE(162);                                             15402000
              GO REQDRTN;                                               15404000
              END;                                                      15406000
            END                                                         15408000
          ELSE                                                          15410000
            BEGIN <<REAL DEVICE>>                                       15412000
            DRTN := INVAL(@REQDRTN,",");                                15414000
            IF <= OR (1 <= DRTN <= MINDRT-1) OR                <<03023>>15416000
            (DRTN < 0) OR (DRTN > 511) THEN                    <<03023>>15418000
              BEGIN                                            <<03023>>15420000
              MESSAGE(1);                                               15422000
              GO REQDRTN;                                               15424000
              END;                                                      15426000
            END;                                                        15428000
          IF LDEV'EXISTS(LDEV) THEN                            <<03703>>15432000
            BEGIN   <<OLD LDEV EXISTS>>                        <<03703>>15434000
              IF DRTN = 0 AND LDEV = HLDEV THEN                <<03703>>15436000
                BEGIN    <<MUST COMPACT TABLES>>               <<03703>>15438000
                  DO UNTIL LDEV'EXISTS(HLDEV:=HLDEV-1)         <<03703>>15440000
                           OR HLDEV=0;                         <<03703>>15442000
                  TOS := HLDEV - LDEV;                         <<03703>>15444000
             ASSEMBLE (DUP,DDUP);<<# OF LDEV'S ELIMINATED>>    <<00.06>>15446000
                  LPDTINCR := TOS*LPDTSIZE;                             15448000
                  LDTINCR := TOS*LDTSIZE;                               15450000
                  DVRTABINCR := TOS*DVRSIZE;                            15452000
             LDTXINCR:=TOS*LDTXSIZE;                           <<00.06>>15454000
                  TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                   15456000
                  MOVEDLTABLES;  <<COMPACT TABLES>>                     15458000
                  GO KILLCSDEV;                                         15460000
                END                                                     15462000
              ELSE                                                      15464000
                BEGIN  <<ZERO ENTRY>>                                   15466000
                  TOS := @DVRTAB(LDEV*DVRSIZE);                         15468000
                  PS0 := 0;                                             15470000
                  ASSEMBLE(DUP,INCB);                                   15472000
                  TOS := DVRSIZE-1;                                     15474000
                  ASSEMBLE(MOVE 3); <<ZERO DRIVER TABLE ENTRY>>         15476000
                  TOS := @LPDT(LDEV*LPDTSIZE);                          15478000
                  PS0 := 0;                                             15480000
                  ASSEMBLE(DUP,INCB);                                   15482000
                  TOS := LPDTSIZE-1;                                    15484000
                  ASSEMBLE(MOVE 3); <<ZERO LOG-PHYS DEVICE TABLE ENTRY>>15486000
                  TOS := @LDT(LDEV*LDTSIZE);                            15488000
                  TYPE := PS0(LDT2).TYP;                                15490000
                  PS0 := 0;                                             15492000
                  ASSEMBLE(DUP,INCB);                                   15494000
                  TOS := LDTSIZE-1;                                     15496000
                  ASSEMBLE(MOVE 3);  <<ZERO LOGICAL DEVICE TABLE ENTRY>>15498000
                  ZEROLDTX;   <<ZERO LDTX ENTRY>>              <<04327>>15502000
  KILLCSDEV:   IF CSDEV17<=TYPE<=CSDEV19 THEN                  <<01165>>15504000
               BEGIN<<DELETE CSLDTX ENTRY>>                    <<+0.06>>15506000
               CSTAB(X):=CSTAB(CSXENTRIES)-1;<<ONE LESS>>      <<+0.06>>15508000
               <<CS DEVICE IN TABLE>>                          <<+0.06>>15510000
               TOS:=CSDEF(LDEV);<<CSLDTX ENTRY # FOR DEVICE>>  <<+0.06>>15512000
               <<TO BE DELETED>>                               <<+0.06>>15514000
               CSDEF(X):=0;<<THIS DEVICE IS NO LONGER IN>>     <<+0.06>>15516000
               <<CSLDTX TABLE>>                                <<+0.06>>15518000
               X := 0;                                                  15520000
                DO  <<SCAN ENTIRE CS-DEVICE INDEX TABLE>>      <<+0.06>>15522000
                  IF S0<=CSDEF(X) THEN <<ANY DEVICE WITH A>>   <<+0.06>>15524000
                    CSDEF(X):=CSDEF(X)-1 <<CSLDTX INDEX #>>    <<+0.06>>15526000
                UNTIL (X:=X+1)=CSDEFSIZE;<<GREATER THAN THE>>  <<+0.06>>15528000
                <<ONE TO BE DELETED SHOULD HAVE ITS INDEX>>    <<+0.06>>15530000
                <<DECREMENTED BY ONE TO REFLECT THE NEW>>      <<+0.06>>15532000
                <<SHORTER TABLE>>                              <<+0.06>>15534000
               TEMP := TOS;                                             15536000
                @CSLDTX:=@CSTAB+CSXSTART;<<RESET CSLDTX TO>>   <<+0.06>>15538000
                <<START OF TABLE HOLDING ENTRIES>>             <<+0.06>>15540000
               I := -1;                                                 15542000
               WHILE (I:=I+1) < TEMP DO                                 15544000
                  @CSLDTX:=CSLDTX+@CSLDTX;<<SET TO START>>     <<+0.06>>15546000
                  <<ADDRESS OF ENTRY TO BE DELETED>>           <<+0.06>>15548000
                TEMP:=CSLDTX;<<SAVE LENGTH OF THIS ENTRY>>     <<+0.06>>15550000
                TOS:=@CSLDTX;<<DESTINATION ADDRESS OF MOVE>>   <<+0.06>>15552000
                TOS:=S0+TEMP;<<SOURCE ADDRESS OF MOVE>>        <<+0.06>>15554000
                TOS:=-S0+CSTAB+@CSTAB;<<LENGTH OF REMAINDER>>  <<+0.06>>15556000
                <<OF CSLDTX TABLE--PART TO BE MOVED>>          <<+0.06>>15558000
                ASSEMBLE(MOVE 3);<<CONTRACT CSLDTX TABLE>>     <<+0.06>>15560000
                TOS:=CSTAB-TEMP;<<SIZE OF NEW CS-TABLE>>       <<+0.06>>15562000
               CSTAB := S0;                                             15564000
                CSTAB(CSXSIZE):=S0;<<SIZE OF NEW CS-EXTENSION>><<+0.06>>15566000
               CSTAB(4) := TOS;                                         15568000
                CSTABINCR:=-TEMP;<<SET LENGTH PARAMETER FOR>>  <<+0.06>>15570000
                <<COMPRESSION OF DL-AREA TABLES>>              <<+0.06>>15572000
               MOVEDLTABLES;                                            15574000
               END;                                                     15576000
                END;                                                    15578000
              REMOVECLASSREFS;  <<REMOVE REFERENCES TO THIS DEVICE>>    15580000
              IF (TEMP := TCLASS) > 0 THEN                              15582000
                BEGIN <<CHECK IF IN TEMPCLASS>>                         15584000
                I := 0;                                                 15586000
                INDEX := 12;                                            15588000
                DO                                                      15590000
                  BEGIN                                                 15592000
                  J := 0;                                               15594000
                  N := TEMPCLASS(INDEX);                                15596000
                  WHILE(J:=J+1)<=N DO                                   15598000
                    BEGIN                                               15600000
                    TOS := TEMPCLASS(INDEX+J); <<LDEV #>>               15602000
                    IF TOS = LDEV THEN                                  15604000
                      BEGIN <<DELETE FROM TEMPCLASS>>                   15606000
                      IF N=1 THEN                                       15608000
                        BEGIN <<DELETE WHOLE CLASS>>                    15610000
                        TOS := @TEMPCLASS(INDEX-8);                     15612000
                        TOS := S0+10;                                   15614000
                        ASSEMBLE(DUP,NEG);                              15616000
                        TOS := TOS+@TEMPCLASS+TCLASS(1); <<# OF BYTES>> 15618000
                        ASSEMBLE(MVB 3); <<MOVE REST OF TABLES>>        15620000
                        TCLASS(X) := TCLASS(1)-10;                      15622000
                        TCLASS := TCLASS-1;                             15624000
                        END                                             15626000
                      ELSE                                              15628000
                        BEGIN <<REMOVE LDEV FROM CLASS>>                15630000
                        TOS := @TEMPCLASS(X);                           15632000
                        ASSEMBLE(DUP,INCA);                             15634000
                        TOS := N-J;                                     15636000
                        ASSEMBLE(MVB 2);<<MOVE REST OF CLASS>>          15638000
                        IF LOGICAL(N) THEN                              15640000
                          BEGIN <<FILLER BYTE>>                         15642000
                          BPS0 := 0;                                    15644000
                          DEL;                                          15646000
                          END                                           15648000
                        ELSE                                            15650000
                          BEGIN<<1 WORD DELETED-MOVE REST>>             15652000
                          TOS := @TEMPCLASS(INDEX+N);                   15654000
                          ASSEMBLE(DUP,INCA;INCA,DUP;NEG);              15656000
                          TOS := TOS+@TEMPCLASS+TCLASS(1);<<# OF BYTES>>15658000
                          ASSEMBLE(MVB 3);                              15660000
                          TCLASS(X) := TCLASS(1)-2;                     15662000
                          END;                                          15664000
                        TEMPCLASS(X) := TEMPCLASS(INDEX)-1;             15666000
                        END;                                            15668000
                      GO CLASSESCLEAN;                                  15670000
                      END;                                              15672000
                    END;                                                15674000
                  TOS := N;                                             15676000
                  ASSEMBLE(DUP,NOT);                                    15678000
                  IF TOS THEN TOS := TOS+1; <<FILLER BYTE>>             15680000
                  INDEX := TOS+INDEX+9;                                 15682000
                  END                                                   15684000
                UNTIL(I:=I+1)=TEMP;                                     15686000
              END;                                                      15688000
  CLASSESCLEAN:                                                         15690000
              IF DRTN=0 THEN GO REQLDEV;                                15692000
            END                                                         15694000
          ELSE IF DRTN=0 THEN                                           15696000
            BEGIN                                                       15698000
              MESSAGE(11);  <<NO SUCH DEVICE>>                          15700000
              GO REQLDEV;                                               15702000
            END                                                         15704000
          ELSE IF LDEV>HLDEV THEN                                       15706000
            BEGIN  <<MUST EXPAND TABLES>>                               15708000
              TOS := LDEV-HLDEV;                                        15710000
              ASSEMBLE(DUP,DDUP);                              <<00.06>>15712000
              LPDTINCR := TOS*LPDTSIZE;                                 15714000
              LDTINCR := TOS*LDTSIZE;                                   15716000
              LDTXINCR:=TOS*LDTXSIZE;                          <<00.06>>15718000
              DVRTABINCR := TOS*DVRSIZE;                                15720000
              MOVEDLTABLES;                                             15722000
              HLDEV := LDEV;                                            15724000
            END                                                <<04327>>15726000
          ELSE <<ADDING AN LDEV THAT DIDN'T PREVIOUSLY EXIST>> <<04327>>15728000
            ZEROLDTX;    <<ZERO LDTX ENTRY>>                   <<04327>>15730000
          @DVRENT := @DVRTAB(LDEV*DVRSIZE);                             15732000
          @LDTENT := @LDT(LDEV*LDTSIZE);                                15734000
          @LDTXENT:=@LDTX(LDEV*LDTXSIZE);                      <<00.06>>15736000
          @LPDTENT := @LPDT(LDEV*LPDTSIZE);                             15738000
  REQUNIT:UNIT := GETVAL(9,0,MAXUNIT,1);   <<UNIT NUMBER>>     <<03006>>15740000
          TOS := UNIT;                                                  15742000
          IF DSDEVICE THEN                                              15744000
            BEGIN                                                       15746000
            DVRENT(DVR1).DSBIT := 1;                           <<03006>>15748000
            DVRENT(DVR1).DSDRTN := DRTN;                                15750000
            END                                                         15752000
          ELSE TOS.DRTFIELD:=DRTN;                             <<03006>>15754000
          DVRENT := TOS;                                                15756000
          DVRENT(DVR1).DVRCHAN := GETVAL(88,0,4,1);  <<CHANNEL #>>      15758000
          LDTENT(LDT3).FILEBIT := 1;  <<BELONGS TO FILE SYSTEM>>        15760000
  REQTYPE:TYPE := GETVAL(12,0,63,1);  << TYPE? >>              <<03544>>15764000
          IF CSDEV AND UNIT<>0 OR TYPE=SDISC OR                <<03544>>15766000
          TYPE=FDISC THEN                                      <<03544>>15768000
            BEGIN                                              <<03544>>15770000
            MESSAGE( 121);  << ILLEGAL TYPE OR UNIT >>         <<03544>>15772000
            GO REQUNIT;                                        <<03544>>15774000
            END;                                               <<03544>>15776000
          LDTENT(LDT2).TYP := TYPE;  << PUT TYPE IN LDT >>     <<03544>>15778000
          IF CSDEV THEN                                        <<03544>>15780000
            BEGIN     <<CS DEVICE>>                                     15782000
            LDTENT(LDT2).CSBIT:=1;<<THIS LDEV IS A CS-DEVICE>> <<+0.06>>15784000
            CSTAB(X):=CSTAB(CSXENTRIES)+1;<<THERE IS GOING TO>><<+0.06>>15786000
            <<BE ONE MORE CS-DEVICE IN THE SYSTEM>>            <<+0.06>>15788000
            @CSLDTX:=@TEMPCSLDTX;<<SET POINTER TO UNUSED AREA>><<03616>>15790000
            CSLDTX:=0;<<ZERO THE TEMP ARRAY IN PREPARATION>>   <<+0.06>>15792000
            MOVE CSLDTX(1):=CSLDTX,(500);<<TO BUILD CSLDTX>>   <<+0.06>>15794000
            <<ENTRY FOR THIS NEW DEVICE>>                      <<+0.06>>15796000
            CSINDX:=CONTRSTART;<<POINTER TO START OF CONTROL>> <<+0.06>>15798000
            <<SECTION. (WILL ALSO BE USED TO POINT TO PHONE>>  <<+0.06>>15800000
            <<NUMBER SECTION AND ID SECTION)>>                 <<+0.06>>15802000
            END;                                                        15804000
REQSTYP:  SUBTYP := GETVAL(13,0,15,1);  << SUBTYPE? >>         <<03544>>15806000
          IF (TYPE=CSDEV17 OR TYPE=CSDEV18) AND                <<03544>>15808000
            SUBTYP<>0 AND SUBTYP<>1 AND                        <<03544>>15810000
            SUBTYP<>3 AND SUBTYP<>7 OR                         <<03544>>15812000
            TYPE=CSDEV19 AND                                   <<03544>>15814000
            SUBTYP<>0 AND SUBTYP<>3 THEN                       <<03544>>15816000
             BEGIN                                             <<03544>>15818000
             MESSAGE( 122);  << ILLEGAL TYPE OR SUBTYPE >>     <<03544>>15820000
             GO REQSTYP;                                       <<03544>>15822000
             END;                                              <<03544>>15824000
          LPDTENT(LPDT1).SUBTYPE := SUBTYP;                    <<03544>>15828000
          IF TYPE=TERMDEVTYPE OR                               <<03544>>15830000
          TYPE=32 AND                                          <<03544>>15832000
           (SUBTYP=14 OR SUBTYP=15) THEN                       <<03544>>15834000
            BEGIN                                                       15836000
            TOS:=GETVAL(118,0,%36,2); <<TERM TYPE?>>           <<+0.06>>15838000
            IF = THEN                                                   15840000
              BEGIN                                                     15842000
              DEL;                                                      15844000
              TOS := %37;                                               15846000
              END;                                                      15848000
            LDTENT(LDT4).TERMTYP := TOS;                                15850000
REQSPEED:   I := GETVAL(165,0,3840,2);   << TERM SPEED >>      <<03702>>15854000
                                                               <<03702>>15856000
            IF POSTSERIES3 AND I = 0 THEN   << DEFAULT 240  >> <<03702>>15858000
               I := 240;                    << ON 33, 44, 64>> <<03702>>15860000
                                                               <<03702>>15862000
            << CALL CHECKSPEED TO CHECK TERM. SPEED REPLY >>   <<03702>>15864000
            IF CHECKSPEED(I, SPEEDCDE) THEN                    <<03702>>15866000
                                                               <<03702>>15868000
               << SUBTYPES > 3 ARE TERMINALS WHICH ARE NON- >> <<03702>>15870000
               << SPEEDSENSING, THEREFORE A VALID SPEED     >> <<03702>>15872000
               << MUST BE ENTERED.                          >> <<03702>>15874000
                                                               <<03702>>15876000
               IF NOT (SPEEDCDE = 0 LAND SUBTYP > 3) THEN      <<03702>>15878000
                  GOTO SPEEDOK;                                <<03702>>15880000
                                                               <<03702>>15882000
            MESSAGE(198);    << NOT A SUPPORTED SPEED >>       <<03702>>15884000
            GO REQSPEED;     << REQUEST TERM SPEED AGAIN >>    <<03702>>15886000
                                                               <<03702>>15888000
SPEEDOK:    LDTXENT.TERMSPEED := SPEEDCDE;                     <<03702>>15890000
            END;     << TERMINAL SPECIFIC PROMPTS >>           <<03702>>15892000
          IF CSDEVICE THEN                                              15894000
            BEGIN                                                       15896000
            IF TYPE=CSDEV19 THEN                               <<01165>>15898000
              CSLDTXHSI'CHAN:=GETVAL(160,1,15,1);<<PORT MASK>>          15900000
            IF TYPE<>17 THEN                                   <<01165>>15902000
            BEGIN                                              <<01165>>15904000
            CSLDTXPROTOCOL:=GETVAL(123,1,255,1);<<PROTOCOL>>            15906000
            CSLDTXMODE:= GETVAL(124,1,15,1);<<LOCAL MODE>>              15908000
            CSLDTXCODE := GETVAL(125,1,63,1);<<TRANSMISSION CODE>>      15910000
            END;                                               <<01165>>15912000
            TOS := GETVAL(126,0,32767,2);  <<RECEIVE TIMEOUT>>          15914000
            IF = THEN                                                   15916000
              BEGIN  <<CARRIAGE RETURN>>                                15918000
              DEL;                                                      15920000
              TOS := 20;                                                15922000
              END;                                                      15924000
            CSLDTXRECV'TIMEOUT := TOS;                                  15926000
            TOS := GETVAL(127,0,32767,2);  <<LOCAL TIMEOUT>>            15928000
            IF = THEN                                                   15930000
              BEGIN  <<CARRIAGER RETURN>>                               15932000
              DEL;                                                      15934000
              TOS := 60;                                                15936000
              END;                                                      15938000
            CSLDTXLOCAL'TIMEOUT := TOS;                                 15940000
            TOS := GETVAL(128,0,32767,2);  <<CONNECT TIMEOUT>>          15942000
            IF = THEN                                                   15944000
              BEGIN << CR >>                                            15946000
              DEL;                                                      15948000
              TOS := 900;                                               15950000
              END;                                                      15952000
            CSLDTXCONCT'TIMEOUT := TOS;                                 15954000
            IF HARDWIRED THEN GO SPEEDCH;                               15956000
            IF NOT(MODEM) OR SWITCHED THEN                              15958000
              BEGIN                                                     15960000
  REQDIAL:    MESSAGE(-159);  <<DIAL FACILITY?>>               <<01165>>15962000
              READINPUT;                                       <<01165>>15964000
              SCAN BINBUF WHILE BLANK,1;                       <<01165>>15966000
              ASSEMBLE(DUP,DUP);                               <<01165>>15968000
              MOVE * := * WHILE ANS;                           <<01165>>15970000
              IF NOCARRY AND (BPS0<>"N") THEN                  <<01165>>15972000
                 IF BPS0 = "Y" THEN                            <<01165>>15974000
                    BEGIN                                      <<01165>>15976000
                    CSLDTXDIAL := 1;                           <<01165>>15978000
                    END                                        <<01165>>15980000
                 ELSE                                          <<01165>>15982000
                    BEGIN                                      <<01165>>15984000
                    @BPINBUF := @BINBUF;                       <<01165>>15986000
                    TOS:=INVAL(@DIALERR,",");                  <<01165>>15988000
                    IF <= THEN                                 <<01165>>15990000
                       BEGIN                                   <<01165>>15992000
                       DEL;                                    <<01165>>15994000
                       GO DIALERR;                             <<01165>>15996000
                       END;                                    <<01165>>15998000
                    IF 0<=S0<=255 THEN                         <<01165>>16000000
                       BEGIN                                   <<01165>>16002000
                       CSLDTXDIAL := 1;                        <<01165>>16004000
                       CSLDTXAUTO'DIAL'LDN := TOS;             <<01165>>16006000
                       END;                                    <<01165>>16008000
                    END;                                       <<01165>>16010000
              DEL; GO REQANSW;                                 <<01165>>16012000
  DIALERR:    DEL;                                             <<01165>>16014000
              MESSAGE(1);                                      <<01165>>16016000
              GO REQDIAL;                                      <<01165>>16018000
  REQANSW:    GETYESNO(@REQDUSP,129);  <<ANSWER FACILITY?>>             16020000
              GETYESNO(@MANUAL,130);   <<AUTOMATIC ANSWER?>>            16022000
              CSLDTXANSWER := AUTOANSWER;                               16024000
              GO REQDUSP;                                               16026000
  MANUAL:     CSLDTXANSWER := MANLANSWER;                               16028000
              END;                                                      16030000
  REQDUSP:  GETYESNO(@SPEEDCH,131); <<DUAL SPEED?>>                     16032000
            CSLDTXDUAL'SPEED := 1;                                      16034000
            GETYESNO(@REQTRSP,132); <<HALF SPEED?>>                     16036000
            CSLDTXHALF'SPEED := 1 ;                                     16038000
            GO REQTRSP;                                                 16040000
  SPEEDCH:  GETYESNO(@REQTRSP,133); <<SPEED CHANGEABLE?>>               16042000
            CSLDTXSPEEDCHNGBLE:= 1;                                     16044000
  REQTRSP:  MESSAGE(-134);  <<TRANSMISSION SPEED?>>                     16046000
            READINPUT;                                                  16048000
            TOS := 0D;                                                  16050000
            TOS := @TRANSER;                                            16052000
            TOS := INVAL(*,",",TRUE);                                   16054000
            IF <= THEN                                                  16056000
  TRANSER:    BEGIN                                                     16058000
              MESSAGE(1);                                               16060000
              GO REQTRSP;                                               16062000
              END;                                                      16064000
            ASSEMBLE(DDUP);                                             16066000
            CSLDTXINSPEED := DS0;                                       16068000
            CSLDTXOUTSPEED := TOS;                                      16070000
            CSLDTXXMSNMODE:=GETVAL(135,0,3,1);<<TRANSMISSION MODE>>     16072000
            CSLDTXPBUFFSIZE:=GETVAL(136,1,4095,1);<<PREFERRED>><<04254>>16074000
            GETYESNO(@REQDOP,150); <<DRIVER CHANGEABLE?>>               16076000
            CSLDTXDVRCHANGABLE := 1;                                    16078000
  REQDOP:   CSLDTXDOPTIONS:=GETVAL(137,0,32767,1);<<DVR OPTIONS>>       16080000
            GO REQDVR;                                                  16082000
            END;                                                        16084000
          LDTENT(LDT2).RECW := GETVAL(14,1,255,1);                      16086000
                                   <<RECORD WIDTH#?>>                   16088000
  REQODEV:MESSAGE(-15);   <<OUTPUT DEVICE?>>                            16090000
          READINPUT;                                                    16092000
          TOS := INVAL(@TRYSTR,",");                                    16094000
          IF <= THEN GOTO ODEVERR;                                      16096000
          IF 0<=S0<=255 THEN GO SETODEV;                                16098000
  ODEVERR:DEL;                                                          16100000
  ODEVERR1:MESSAGE(1);                                                  16102000
          GO REQODEV;                                                   16104000
  TRYSTR: @BPINBUF := @BINBUF;                                          16106000
          GETSTR(@ODEVERR1,DEVCLASS,1,"A",8);                           16108000
          TOS := CLINDEX(DEVCLASS);   <<GET CLASS INDEX>>               16110000
          IF S0=0 THEN PUTINTEMPCLASS(LDEV);<<NO SUCH CLASS>>  <<00.03>>16112000
          LDTENT(LDT3).OUTCL := 1;                                      16114000
  SETODEV:LDTENT(LDT3).OUTDEV := TOS;                                   16116000
          GETYESNO(@REQACCD,59); <<ACCEPT JOBS/SESSIONS?>>              16118000
          LPDTENT(LPDT1).AJOBS := 1;                                    16120000
  REQACCD:GETYESNO(@REQINT,16); <<ACCEPT DATA?>>                        16122000
          LPDTENT(LPDT1).ADATA := 1;                                    16124000
  REQINT: GETYESNO(@REQDUP,17); <<INTERACTIVE?>>                        16126000
          LPDTENT(LPDT1).INTRACT := 1;                                  16128000
  REQDUP: LPDTENT(LPDT1).DUPLIC := YESANSWER(18);  << DUPLIC >><<01852>>16130000
                                                               <<02704>>16132000
          IF SERIESII'III AND                                  <<02704>>16134000
            (TYPE=DISC0 OR TYPE=DISC1) THEN                    <<03544>>16136000
            LDTXENT.LDTX'SA := YESANSWER(196);  << SEEKAHEAD?>><<01852>>16138000
          TOS := @REQDVR;                                      <<01852>>16140000
          GETYESNO(*,116);    <<INITIALLY SPOOLED?>>                    16142000
          IF 8<=LDTENT(LDT2).TYP<=15 THEN                               16144000
   INONLY:  LDTENT(LDT3).SPOOLST := 1                                   16146000
          ELSE IF 32<=LDTENT(LDT2).TYP<=39 THEN                         16148000
                 BEGIN                                                  16150000
   OUTONLY:      LDTENT(LDT3).SPOOLST := 2;                             16152000
                 LDTENT(LDT4).SPOOLQUE := 1;                            16154000
                 END                                                    16156000
               ELSE IF 16<=LDTENT(LDT2).TYP<=31 THEN                    16158000
                      BEGIN                                             16160000
   ASKAGAIN:          MESSAGE(-117);<<SPOOL IN OR OUT>>                 16162000
                      READINPUT;                                        16164000
                   MOVE BINBUF:=BINBUF WHILE ANS;              <<04581>>16166000
                      IF BINBUF="IN" THEN GO INONLY                     16168000
                        ELSE IF BINBUF="OUT" THEN GO OUTONLY;           16170000
                      MESSAGE(1);                                       16172000
                      GO ASKAGAIN;                                      16174000
                      END;                                              16176000
  REQDVR: MESSAGE(-19); <<DRIVER NAME? >>                               16178000
          READINPUT;                                                    16180000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        16182000
          IF BPS0="*" THEN                                              16184000
            BEGIN   <<CORE RESIDENT DRIVER>>                            16186000
              TOS := TOS+1;                                             16188000
              IF CSDEVICE OR DSDEVICE THEN MESSAGE(179)        <<00158>>16190000
                ELSE DVRENT(DVR1).CRBIT:=1; <<CORE RESIDENT>>  <<00158>>16192000
            END;                                                        16194000
          @BPINBUF := TOS;                                              16196000
          GETSTR(@REQDVR,DVRENT(DVR2),1,"A",8);  <<GET DRIVER NAME>>    16198000
  IF CSDEVICE THEN                                             <<01165>>16200000
     BEGIN                                                     <<01165>>16202000
     IF SWITCHED THEN                                          <<01165>>16204000
        BEGIN                                                  <<01165>>16206000
            GETYESNO(@REQLID,139);  <<PHONE LIST>>             <<00.05>>16208000
          TOS := CSINDX;                                                16210000
          CSLDTXPHLISTPTR := S0;                                        16212000
          @PHONE :=(TOS+@CSLDTX)&LSL(1);                       <<03704>>16214000
          PHINX := 4;   <<POINT PAST SEQUENCE LENGTH>>                  16216000
          J:=0;                                                         16218000
  PHONENB:MESSAGE(-140);   <<PHONE NUMBER>>                             16220000
          READINPUT;                                                    16222000
          I:=GETPHNB(@PHONENB,BTEMP,"-");                               16224000
          IF > THEN                                                     16226000
            BEGIN                                                       16228000
            MOVE PHONE(PHINX):=BTEMP,(I);                               16230000
            PHONE(X:=X-1) := I;                                         16232000
            PHINX := PHINX+I+1;  <<POINT PAST NEXT SEQUENCE LENGTH>>    16234000
            J:=J+1;                                                     16236000
            GO PHONENB;                                                 16238000
            END;                                                        16240000
          IF J<=0 THEN                                                  16242000
           BEGIN  <<NO PHONE LIST>>                                     16244000
           CSLDTXPHLISTPTR := 0;                                        16246000
           END                                                          16248000
          ELSE                                                          16250000
            BEGIN                                                       16252000
            PHONE(NUMSEQ) := J; <<# OF PHONE SEQUENCES>>                16254000
            TOS := PHINX&LSR(1);                                        16256000
            CSLDTX(CSINDX) := S0-1; <<SIZE OF LIST IN WORDS>>           16258000
            CSINDX := TOS+CSINDX;                                       16260000
            END;                                                        16262000
        END;                                                   <<01165>>16264000
     IF CONTENTION OR LDTENT(LDT2).TYP=CSDEV17 THEN            <<01165>>16266000
        BEGIN                                                  <<01165>>16268000
        IF SWITCHED THEN                                       <<01165>>16270000
          BEGIN                                                <<01165>>16272000
  REQLID: TOS:=CSINDX;                                         <<00.05>>16274000
          CSLDTXIDLISTPTR := S0;                                        16276000
          @IDLIST := (TOS+@CSLDTX)&LSL(1);                     <<03704>>16278000
          IDINX := 4;                                                   16280000
          J := 0;                                                       16282000
          I:=0;                                                         16284000
  REQLIDS:MESSAGE(-141); <<LOCAL ID SEQUENCE?>>                         16286000
          READINPUT;                                                    16288000
          SCAN BPINBUF WHILE BLANK,1;                                   16290000
          IF CARRY THEN                                                 16292000
            BEGIN                                                       16294000
            DEL;                                                        16296000
            IDLIST(IDINX-1):=0;<<NULL LOCAL ID>>;                       16298000
            IDINX:=IDINX+1;   <<POINT TO 1ST REMOTE ID>>                16300000
            END                                                         16302000
          ELSE                                                          16304000
            BEGIN                                                       16306000
            TOS := GETSEQ(@REQLIDS,BTEMP);                              16308000
            DUPLICATE;                                                  16310000
            TOS := TOS LAND %77;                                        16312000
            TEMP := TOS;          <<LENGTH>>                            16314000
            IDLIST(IDINX-1):=TOS;       <<LENGTH AND IN TYPE>>          16316000
            MOVE IDLIST(IDINX):=BTEMP,(TEMP);                           16318000
            IDINX := IDINX+TEMP+1;  <<BUMP INDEX>>                      16320000
            I := I+1;                                                   16322000
            END;                                                        16324000
  REQRIDS:  MESSAGE(-142); <<REMOTE ID SEQUENCE?>>                      16326000
          READINPUT;                                                    16328000
          TOS := GETSEQ(@REQRIDS,BTEMP);                                16330000
          IF S0=0 THEN                                                  16332000
            BEGIN <<NO INPUT>>                                          16334000
            DEL;                                                        16336000
            IF I<=0 THEN                                                16338000
              BEGIN     <<NULL ID LIST>>                                16340000
              CSLDTXIDLISTPTR := 0;                                     16342000
              GO REQCLSS;                                               16344000
              END;                                                      16346000
            IDLIST(NUMSEQ) := I;                                        16348000
            TOS := IDINX&LSR(1);                                        16350000
            CSLDTX(CSINDX) := S0-1;  <<SIZE OF LIDT IN WORDS>>          16352000
            CSINDX := TOS+CSINDX;                                       16354000
            GO REQCLSS;                                                 16356000
            END;                                                        16358000
          DUPLICATE;                                                    16360000
          TOS := TOS LAND %77;  <<LENGTH>>                              16362000
          TEMP := TOS;                                                  16364000
          IDLIST(IDINX-1) := TOS;                                       16366000
          MOVE IDLIST(IDINX) := BTEMP,(TEMP);                           16368000
          IDINX := IDINX+TEMP+1;                                        16370000
          I := I+1;                                                     16372000
          GO REQRIDS;                                                   16374000
          END;                                                 <<01165>>16376000
        END                                                    <<01165>>16378000
     ELSE                                                      <<01165>>16380000
        IF CONTROLST THEN                                      <<01165>>16382000
          BEGIN                                                <<01165>>16384000
  REQIDLAY: CSLDTX(CSINDX+INTCOMDELAY)                                  16386000
                :=GETVAL(143,0,32767,1);<<INTERCOMPONENT DELAY>>        16388000
            TOS := GETVAL(144,0,32767,1); <<# OF POLLS REPEAT>>         16390000
            CSLDTX(CSINDX) := S0;                                       16392000
            IF TOS=0 THEN GO REQCPST;                                   16394000
  REQCIRP:  CSLDTX(CSINDX+CIRPDELAY)                                    16396000
               := GETVAL(145,0,32767,1);<<CIRCULAR POLL DELAY?>>        16398000
  REQCPST:  I := GETVAL(146,0,255,1);<<COMPONENTS PER STATION?>>        16400000
  REQNCOM:  N := GETVAL(147,0,63,1);   <<# OF COMPONENTS>>              16402000
            CSLDTXCONTPTR:=CSINDX;                                      16404000
            IF CONTROLST THEN CSINDX:=CSINDX+CONSEQSTART                16406000
            ELSE CSINDX:=CSINDX+1; <<TRIBUTARY>>                        16408000
            @BCSLDTX := @CSLDTX&LSL(1);<<BYTE POINTER FOR SEQUE<<03704>>16410000
            BINDX := CSINDX&LSL(1);<<INDEX FOR BYTE ARRAY>>             16412000
            IF CONTROLST THEN BCSLDTX(BINDX-2):=(N+I-1)/I;              16414000
               <<DETERMINE # OF STATIONS IF CONTROL STATION>>           16416000
            BCSLDTX(BINDX-1) := N;    <<# OF COMPONENTS>>               16418000
            LASTPOLLENT := 0;                                           16420000
            I := -1;                                                    16422000
            WHILE(I:=I+1)<N  DO                                         16424000
              BEGIN                                                     16426000
              TOS := GETVAL(148,0,2,1);<<COMPONENT TYPE>>               16428000
              BCSLDTX(BINDX) := S0;                                     16430000
              IF TOS<>2 OR NOT(CONTROLST) THEN                          16432000
                GO REQCOMPSEQ;                                          16434000
              GETYESNO(@REQCOMPSEQ,149);  <<COMPONENT IN POLL LIST>>    16436000
              IF LASTPOLLENT=0  THEN                                    16438000
                 BEGIN                                                  16440000
                 CSLDTX(CONTRSTART+FIRSTCOMP) := I;                     16442000
                 LASTPOLLENT := BINDX;                                  16444000
                 TOS := BCSLDTX(BINDX);                                 16446000
                 TOS.(8:6) := I;                                        16448000
                 BCSLDTX(X) := TOS;                                     16450000
                 END                                                    16452000
              ELSE                                                      16454000
                 BEGIN                                                  16456000
                 TOS := BCSLDTX(LASTPOLLENT);                           16458000
                 TOS.(8:6) := I;                                        16460000
                 BCSLDTX(X) := TOS;                                     16462000
                 LASTPOLLENT := BINDX;                                  16464000
                 END;                                                   16466000
  REQCOMPSEQ: MESSAGE(-151); <<COMPONENT SEQUENCE?>>                    16468000
              READINPUT;                                                16470000
              TOS := GETSEQ(@REQCOMPSEQ,BTEMP);                         16472000
              IF S0=0 THEN                                              16474000
                BEGIN                                                   16476000
                DEL;                                                    16478000
  BADSEQ:       MESSAGE(1);                                             16480000
                GO REQCOMPSEQ;                                          16482000
                END;                                                    16484000
              DUPLICATE;                                                16486000
              TOS := TOS LAND %77;<<LENGTH>>                            16488000
              IF S0>8 THEN                                              16490000
                BEGIN                                                   16492000
                DDEL;                                                   16494000
                GOTO BADSEQ;                                            16496000
                END;                                                    16498000
              DUPLICATE;                                                16500000
              TOS := @BCSLDTX+BINDX+2; <<SEQUENCE START>>               16502000
              TOS := @BTEMP;   <<GET READY FOR MOVE BYTES>>             16504000
              ASSEMBLE(CAB;MVB 3;XCH); <<ROVE SEQUENCE INTO CSLDTX>>    16506000
              BCSLDTX(BINDX+1) := TOS;  <<IN TYPE AND LENGTH>>          16508000
              BINDX := TOS+BINDX+2; <<POINT PAST THIS SEQUENCE>>        16510000
              END;                                                      16512000
            IF N>0 THEN CSINDX := (BINDX+1)&LSR(1);                     16514000
          END;                                                 <<01165>>16516000
     END;                                                      <<01165>>16518000
  REQCLSS:MESSAGE(-20);  <<DEVICE CLASSES>>                             16520000
          READINPUT;                                                    16522000
  NEXTCLASS:                                                            16524000
          MORE := FALSE;                                                16526000
          TOS := 0;  <<RETURN FROM GETSTR>>                             16528000
          TOS := @CLSERR;                                               16530000
          GETSTR(*,DEVCLASS,2,"A",8);   <<CLASS NAME>>                  16532000
          IF = THEN GO PUTINCS;  <<NO CLASS>>                           16534000
          IF < THEN MORE := TRUE;   <<FOLLOWED BY COMMA>>               16536000
          DEVCLASS(8) := " "; <<TERMINATOR>>                   <<00844>>16538000
          INDEX := 10;                                                  16540000
          I := -1;                                                      16542000
          WHILE (I:=I+1) < LDT(DCNUM) DO                                16544000
            BEGIN                                                       16546000
              IF DVCLTAB(INDEX-10) = DEVCLASS,(8),2 THEN GOTO ENTEXST;  16548000
              TOS := DVCLTAB(INDEX);   <<UPDATE TABLE POINTER>>         16550000
              ASSEMBLE(DELB,DUP; NOT);                                  16552000
              IF TOS THEN TOS:=TOS+1;                                   16554000
              INDEX := TOS+INDEX+11;                                    16556000
            END;                                                        16558000
          DVCLTABINCR := 6; <<MAKE ROOM FOR NEW ENTRY>>                 16560000
          MOVEDLTABLES;                                                 16562000
          MOVE DVCLTAB(DVCLSIZE) := DEVCLASS,(8),2; <<CLASS NAME>>      16564000
          BPS0 := 1;   <<CYCLICAL POINTER>>                             16566000
          TOS := TOS+1;                                                 16568000
          IF SDISC'TYPE(TYPE,SUBTYP) THEN                      <<03544>>16570000
             BEGIN <<CREATING A DISC CLASS--COULD BE SERIAL>>  <<SD.00>>16574000
             MOVE BLBUF:="IS ",2;                              <<SD.00>>16576000
             ASSEMBLE(DUP);                                    <<SD.00>>16578000
             MOVE *:=DEVCLASS WHILE AN,1;                      <<SD.00>>16580000
             ASSEMBLE(DUP,CAB;SUB);                            <<SD.00>>16582000
             TEMP:=TOS; <<LENGTH OF CLASSNAME>>                <<SD.00>>16584000
             MOVE *:=" A SERIAL DISC CLASS?";                  <<SD.00>>16586000
             PRINT(LBUF,-TEMP-24,%320);                        <<SD.00>>16588000
             TEMP:=SDISC;                                      <<SD.00>>16590000
             READ(LBUF,-3); <<GET YES OR NO--DEFAULT=NO>>      <<SD.00>>16592000
             MOVE BLBUF:= BLBUF WHILE ANS;                     <<03700>>16594000
             IF BLBUF="Y" THEN GO ISSDISC;                     <<SD.00>>16596000
             MOVE BLBUF:="IS ",2;                              <<01115>>16598000
             ASSEMBLE(DUP);                                    <<01115>>16600000
             MOVE *:=DEVCLASS WHILE AN,1;                      <<01115>>16602000
             ASSEMBLE(DUP,CAB;SUB);                            <<01115>>16604000
             TEMP:=TOS;<<LENGTH OF CLASSNAME>>                 <<01115>>16606000
             MOVE *:=" A FOREIGN DISC CLASS?";                 <<01115>>16608000
             PRINT(LBUF,-TEMP-25,%320);                        <<01115>>16610000
             TEMP:=FDISC;                                      <<01115>>16612000
             READ(LBUF,-3);<<YES OR NO -- DEFAULT NO>>         <<01115>>16614000
             MOVE BLBUF:= BLBUF WHILE ANS;                     <<03700>>16616000
             IF BLBUF="Y" THEN GO ISFDISC;                     <<01115>>16618000
             TEMP:=TYPE;                                       <<03610>>16620000
ISSDISC:                                                       <<SD.00>>16622000
ISFDISC:                                                       <<01115>>16624000
             BPS0:=BYTE(TEMP);                                 <<SD.00>>16626000
             END                                               <<SD.00>>16628000
          ELSE                                                 <<SD.00>>16630000
             BPS0:=LDT(LDEV*LDTSIZE+LDT2).TYP;                 <<SD.00>>16632000
          TOS := TOS+1;                                                 16634000
          BPS0 := 1;    <<ONE ENTRY IN CLASS>>                          16636000
          TOS := TOS+1;                                                 16638000
          BPS0 := LDEV;    <<DEVICE NUMBER OF ENTRY>>                   16640000
          DEL;                                                          16642000
          DVCLSIZE := DVCLSIZE+12;                                      16644000
          LDT(X) := LDT(DCNUM)+1;                                       16646000
          IF MORE THEN GO NEXTCLASS ELSE GO PUTINCS;                    16648000
  ENTEXST:I := 0;                                                       16650000
          TOS := TOS+2;   <<POINT TO # OF DEVICES IN CLASS>>            16652000
          WHILE (I:=I+1) <= INTEGER(BPS0) DO                            16654000
          IF INTEGER(DVCLTAB(INDEX+I))=LDEV THEN                        16656000
            BEGIN    <<DUPLICATE ENTRY>>                                16658000
              DEL;                                                      16660000
              MESSAGE(1);                                               16662000
  CLSERR:     REMOVECLASSREFS;                                          16664000
              GO REQCLSS;                                               16666000
            END;                                                        16668000
          IF LOGICAL(N:=BPS0) THEN                                      16670000
            BEGIN    <<MUST MAKE ROOM FOR NEW ENTRY>>                   16672000
              DVCLTABINCR := 1; <<ADD 1 WORD>>                          16674000
              MOVEDLTABLES;                                             16676000
              TOS := TOS-2;   <<COUNT WORD HAS MOVED BY 2 BYTES>>       16678000
              TOS := @DVCLTAB(DVCLSIZE-1);<<PTR TO LAST BYTE OF TABLE>> 16680000
              ASSEMBLE(DUP,INCB, INCB,DUP; NEG);                        16682000
              TOS := TOS+@DVCLTAB(INDEX+N);                             16684000
              ASSEMBLE(MVB 2);                                          16686000
              BPS0 := 0;      <<FILLER BYTE FOR ALIGNMENT>>             16688000
              TOS := TOS-1;                                             16690000
              DVCLSIZE := DVCLSIZE+2;                                   16692000
            END                                                         16694000
          ELSE TOS := S0+N+1; <<INSERT OVER FORMER FILLER BYTE>>        16696000
          BPS0 := LDEV;    <<INSERT NEW ENTRY>>                         16698000
          BPS1 := BPS1+1;  <<BUMP BOUNT OF ENTRIES>>                    16700000
          DDEL;                                                         16702000
          DETERMCTYP(@SAMEPLACE,INDEX,FALSE);                  <<03610>>16704000
SAMEPLACE:IF MORE THEN GO NEXTCLASS;                           <<03610>>16706000
  PUTINCS:IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN <<01165>>16708000
            BEGIN                                                       16710000
            CSLDTX := CSINDX;                                           16712000
            CSTABINCR := CSINDX;                                        16714000
            MOVEDLTABLES;                                               16716000
            TOS := @CSTAB+CSTAB;   <<FIRST FREE BYTE>>                  16718000
            DUPLICATE;                                                  16720000
            MOVE *:=CSLDTX,(CSINDX);                                    16722000
            CSTAB := CSTAB+CSINDX; <<UPDATE SEGMENT SIZE>>              16724000
            I := -1;                                                    16726000
            @CSLDTX := @CSTAB + CSXSTART;                               16728000
            DO I:=I+1                                                   16730000
            UNTIL(@CSLDTX:=@CSLDTX+CSLDTX)>S0;                          16732000
            DEL;                                                        16734000
            CSDEF(LDEV) := I;                                           16736000
            END;                                                        16738000
          GO REQLDEV;                                                   16740000
  REQVDEV:I:=-1;                                                        16742000
          J:=0;                                                         16744000
          WHILE (I:=I+1) <= HLDEV DO                                    16746000
           IF DVRTAB(I*DVRSIZE) <> 0 OR <<COUNT USED DRTS>>    <<03006>>16748000
              DVRTAB(I*DVRSIZE + 1).DSBIT = 1 THEN J:=J+1;     <<03006>>16750000
  MAXOSPOOL:                                                            16752000
          GETNEWVAL(113,CTAB0(MAXSPOOLF),0,255-J);<<MAX # OF OPEN       16754000
                                                   SPOOLFILES>>         16756000
          IF CTAB0(MAXSPOOLF)>(255-J) THEN                              16758000
            <<MUST MAKE THIS TEST IN THE CASE WHERE A LARGE>>           16760000
            <<NUMBER OF REAL DEVICES HAVE BEEN ADDED AND   >>           16762000
            <<THE NUMBER OF OPEN SPOOLFILES WAS NOT CHANGED>>           16764000
            BEGIN <<MUST CHANGE MAX # OF OPEN SPOOLFILES>>              16766000
            MESSAGE(163);                                               16768000
            MESSAGE(164);                                               16770000
            MOVE  BINBUF := "IS ";                                      16772000
            I := ASCII(255-J,10,BINBUF(3));                             16774000
            PRINT(INBUF,-I-3,0);                                        16776000
            GOTO MAXOSPOOL;                                             16778000
            END;                                                        16780000
           GETYESNO(@REQNLCS,4);   <<LIST I/O DEVICES>>                 16782000
          LISTIODEV;                                                    16784000
  REQNLCS:IF CSPRESENT THEN                                             16786000
            BEGIN                                                       16788000
            GETYESNO(@REQCLC,120); <<LIST CS DEVICES>>                  16790000
            LISTCSDEV;                                                  16792000
            END;                                                        16794000
   REQCLC:TOS := @UPDODEV;                                              16796000
          GETYESNO(*,102);    <<CLASS CHANGES?>>                        16798000
   REQLOC:TOS := @REQDCLS;                                              16800000
          GETYESNO(*,103);    <<LIST CLASSES?>>                         16802000
          LISTCLASSES;                                                  16804000
   REQDCLS:GETYESNO(@REQACLS,104); <<DELETE CLASSES>>                   16806000
           ERROR := FALSE;                                              16808000
   GETCLASSN:                                                           16810000
          MESSAGE(-106);  <<CLASS NAMES>>                               16812000
          READINPUT;                                                    16814000
   NEXTCL:MORE := FALSE;                                                16816000
          GETSTR(@REQLIC,DEVCLASS,2,"A",8);                             16818000
          IF = AND LAST  THEN GO DCLERR;                                16820000
          IF < THEN MORE := LAST  := TRUE ELSE LAST:=FALSE;             16822000
          I := DELETECLASS(@REQLOC);                                    16824000
          K := 0;                                                       16826000
          WHILE (K:=K+1) <=HLDEV DO                                     16828000
          IF LOGICAL(LDT((M:=K*LDTSIZE)+LDT3).OUTCL) THEN               16830000
            BEGIN <<OUTPUT DEVICE IS CLASS>>                            16832000
            TOS := LDT(M+LDT3).OUTDEV; <<INDEX TO CLASS TABLE>>         16834000
            IF S0=I THEN                                       <<00.03>>16836000
              BEGIN <<OUTPUT DEVICE IS DELETED CLASS>>         <<00.03>>16838000
              LDT(M+LDT3).OUTDEV := 0;                         <<00.03>>16840000
              PUTINTEMPCLASS(K);                               <<00.03>>16842000
              END                                              <<00.03>>16844000
            ELSE IF S0>I THEN LDT(M+LDT3).OUTDEV:=S0-1;                 16846000
            DEL;                                                        16848000
            END;                                                        16850000
          IF MORE THEN GO NEXTCL ELSE GO REQACLS;                       16852000
   REQLIC:GETYESNO(@GETCLASSN,103);                                     16854000
          LISTCLASSES;                                                  16856000
          GO GETCLASSN;                                                 16858000
   DCLERR:MESSAGE(1);                                                   16860000
          GO GETCLASSN;                                                 16862000
   REQACLS:GETYESNO(@REQLNC,105);<<ADD CLASSES>>                        16864000
   REQNCL:MESSAGE(-109); <<CLASS NAME>>                                 16866000
          READINPUT;                                                    16868000
          GETSTR(@REQNCL ,DEVCLASS,3,"A",8);                            16870000
          IF = THEN GO REQLNC; <<CARRIAGE RETURN>>                      16872000
   REQDEVS:I := 0;                                                      16874000
          MESSAGE(-107);  <<LOGICAL DEVICES #'S>>                       16876000
          READINPUT;                                                    16878000
   GETNDEV:I:=I+1;                                                      16880000
          MORE := FALSE;                                                16882000
          TOS := INVAL(@CLASERR,",");                          <<01009>>16884000
          IF = THEN                                            <<01009>>16886000
   CLASERR: BEGIN                                              <<01009>>16888000
              MESSAGE(1);                                      <<01009>>16890000
              TOS:=I;                                          <<01009>>16892000
              ASSEMBLE(SUBS 0);  <<DELETE INPUT FROM STACK>>   <<01009>>16894000
              GO TO REQDEVS;  <<TRY AGAIN>>                    <<01009>>16896000
             END;                                              <<01009>>16898000
          IF < THEN MORE := TRUE;                                       16900000
          NEW'LDEV:= S0;                                       <<03610>>16902000
          IF NOT LDEV'EXISTS(NEW'LDEV) THEN                    <<03610>>16904000
            GO CLASERR; <<DEVICE NOT DEFINED>>                          16906000
          IF MORE THEN GO GETNDEV;                                      16908000
          INDEX := 10;                                                  16910000
          J:= -1;                                                       16912000
          WHILE (J:=J+1)<LDT(DCNUM) DO                                  16914000
            BEGIN                                                       16916000
            IF DVCLTAB(INDEX-10)=DEVCLASS,(8),2 THEN GO OLDENT;         16918000
            TOS := DVCLTAB(INDEX);                                      16920000
            ASSEMBLE(DELB,DUP;NOT);                                     16922000
            IF TOS THEN TOS:=TOS+1;                                     16924000
            INDEX := TOS+INDEX+11;                                      16926000
            END;                                                        16928000
          X := DVCLSIZE;        <<FIRST FREE BYTE>>                     16930000
          INDEX := X+10;                                                16932000
          DVCLTABINCR := (I+2)&LSR(1)+5;                                16934000
          MOVEDLTABLES;                                                 16936000
          MOVE DVCLTAB(X):=DEVCLASS,(8),2;                              16938000
          BPS0 := 1; <<CYCLICAL POINTER>>                      <<00298>>16940000
          TOS := TOS + 1;                                               16942000
          BPS0 := 0; <<CLASS ACCESS TYPE>>                     <<00298>>16944000
          TOS := TOS + 1;                                               16946000
          BPS0 := I; <<#DEVICES IN CLASS>>                     <<00298>>16948000
          TOS := TOS+1;                                                 16950000
          X := -I-1;                                                    16952000
          WHILE (X:=X+1)<0  DO                                          16954000
            BEGIN                                                       16956000
            BPS0 := IAS0(X);                                            16958000
            TOS := TOS + 1;                                             16960000
            END;                                                        16962000
          TOS := I;                                                     16964000
          J := S0+1;     <<SAVE STACK DECREMENT>>                       16966000
          IF NOT(TOS) THEN                                              16968000
            BEGIN  <<INCLUDE FILLER BYTE>>                              16970000
            I := I+1;                                                   16972000
            BPS0 := 0;                                                  16974000
            END;                                                        16976000
          DVCLSIZE := DVCLSIZE+I+11;                                    16978000
          LDT(X) := LDT(DCNUM)+1;                                       16980000
          TOS := J;                                                     16982000
          ASSEMBLE(SUBS 0);                                             16984000
          DETERMCTYP(@REQLOC,INDEX,TRUE);<<DETERMINE CLASS TP>><<03610>>16986000
          GO REQNCL;                                                    16988000
  OLDENT: TOS := TOS+2;     <<CLASS ALREADY EXISTED>>                   16990000
          K := -I-1;                                                    16992000
          WHILE (K:=K+1)<0 DO                                           16994000
            BEGIN                                                       16996000
            M := 0;                                                     16998000
            WHILE (M:=M+1)<=INTEGER(BPS0) DO                            17000000
              IF IAS0(K)=INTEGER(BPS0(M)) THEN                          17002000
                BEGIN <<DUPLICATE ENTRIES>>                             17004000
                MESSAGE(108);                                           17006000
                TOS := I+1;                                             17008000
                ASSEMBLE(SUBS 0);                                       17010000
                GETYESNO(@REQDEVS,103);                                 17012000
                LISTCLASSES;                                            17014000
                GO REQDEVS;                                             17016000
                END;                                                    17018000
            END;                                                        17020000
          TOS := TOS -@DVCLTAB;  <<SAVE DISPLACEMENT>>                  17022000
          DVCLTABINCR := (I+1)&LSR(1);                                  17024000
          MOVEDLTABLES;                                                 17026000
          TOS := TOS + @DVCLTAB;                                        17028000
          IF LOGICAL(N:=BPS0) THEN        <<IF N+I IS EVEN THEN>>       17030000
            IF LOGICAL(I) THEN J:=I+1     <<FILLER BYTE WILL BE>>       17032000
            ELSE  J:=I                    <<NEEDED             >>       17034000
          ELSE IF LOGICAL(I) THEN J:=I-1                                17036000
               ELSE J := I;                                             17038000
          TOS := @DVCLTAB+DVCLSIZE-1;                                   17040000
          DUPLICATE;                                                    17042000
          TOS := TOS+J;                                                 17044000
          DUPLICATE;                                                    17046000
          TOS := -TOS+@DVCLTAB+INDEX+N;                                 17048000
          ASSEMBLE(CAB,XCH;MVB 3);                                      17050000
          DVCLSIZE := DVCLSIZE+J;                                       17052000
          BPS0 := N+I;                                                  17054000
          X := -I-1;                                                    17056000
          TOS := TOS+N+1;                                               17058000
          WHILE (X:=X+1)<0 DO                                           17060000
            BEGIN                                                       17062000
            BPS0 := IAS0(X);                                            17064000
            TOS := TOS+1;                                               17066000
            END;                                                        17068000
          IF NOT(LOGICAL(N+I)) THEN  BPS0:=0;<<FILLER BYTE>>            17070000
          TOS := I+1;                                                   17072000
          ASSEMBLE(SUBS 0);                                             17074000
          GO REQNCL;                                                    17076000
   REQLNC:GETYESNO(@UPDODEV,103);<<LIST CLASSES>>                       17078000
          LISTCLASSES;                                                  17080000
   UPDODEV:TINDEX := 4;                                                 17082000
          K := 0;                                                       17084000
          ERROR := FALSE;                                               17086000
          INDEX := 12;                                                  17088000
          TEMP := TCLASS;                                               17090000
          WHILE (K:=K+1)<=TEMP DO                                       17092000
            BEGIN                                                       17094000
            N := INTEGER(TEMPCLASS(INDEX));                             17096000
            TOS := CLINDEX(TEMPCLASS(INDEX-8));                         17098000
            IF S0=0 THEN                                                17100000
              BEGIN  <<ILLEGAL OUTPUT CLASS>>                           17102000
              DEL;                                                      17104000
              MOVE BINBUF:=E1,(16),2;                                   17106000
              MOVE *:=TEMPCLASS(INDEX-8),(8),2;                         17108000
              MOVE *:=E2,(44);                                 <<00887>>17110000
              PRINT(INBUF,-67,0);                                       17112000
              J:=L:=M:=0;                                               17114000
              WHILE (J:=J+1)<=N DO                                      17116000
                BEGIN                                                   17118000
                L := ASCII(INTEGER(TEMPCLASS(INDEX+J)),10,BINBUF(M));   17120000
                X := M+L;                                               17122000
                BINBUF(X) := ",";                                       17124000
                M := X+1;                                               17126000
                IF M>69 AND J<N THEN                                    17128000
                  BEGIN                                                 17130000
                  PRINT(INBUF,-M+1,0);                                  17132000
                  M := 0;                                               17134000
                  END;                                                  17136000
                END;                                                    17138000
              PRINT(INBUF,-M+1,0);                                      17140000
              TOS := N;                                                 17142000
              ASSEMBLE(DUP,NOT);          <<MAKE TEMPCLASS >>           17144000
              IF TOS THEN TOS := TOS+1;   <<LOOK UNCHANGED >>           17146000
              I:=TOS+9;                                                 17148000
              MOVE TEMPCLASS(TINDEX):=TEMPCLASS(INDEX-8),(I);           17150000
              TINDEX := TINDEX+I;                                       17152000
              INDEX := INDEX+I;                                         17154000
              ERROR :=TRUE;                                             17156000
              END                                                       17158000
            ELSE                                                        17160000
              BEGIN                                                     17162000
              J := 0;                                                   17164000
              WHILE (J:=J+1)<=N DO                                      17166000
                BEGIN                                                   17168000
                LDEV := TEMPCLASS(INDEX+J);                             17170000
                IF DVRTAB(LDEV*DVRSIZE).UNITFIELD<>0 THEN      <<03006>>17172000
                   LDT(LDEV*LDTSIZE+LDT3).OUTDEV := S0;                 17174000
                END;                                                    17176000
              DEL;                                                      17178000
              TCLASS := TCLASS-1;                                       17180000
              TOS := N;                                                 17182000
              ASSEMBLE(DUP,NOT);                                        17184000
              IF TOS THEN TOS:=TOS+1;                                   17186000
              TCLASS(X) := -S0 -9+TCLASS(1);                            17188000
              INDEX := TOS+INDEX+9;                                     17190000
              END;                                                      17192000
            END;                                                        17194000
         IF ERROR THEN GO CONFDONE;                            <<01073>>17196000
  REQNLIO:TOS := @REQDVRC;                                              17198000
          GETYESNO(*,4);       <<LIST I/O DEVICES>>                     17200000
          LISTIODEV;                                                    17202000
  REQDVRC:IF CTAB0(NUMADVRS)>0 THEN                                     17204000
            BEGIN <<DELETE DVRS FROM CS LIST IF CONFIGURED>>            17206000
            I := -1;                                                    17208000
            TOS := @BCSDVR;                                             17210000
            WHILE(I:=I+1)<CTAB0(NUMADVRS) DO                            17212000
              BEGIN <<CHECK IF CONFIGURED>>                             17214000
              J := 0;                                                   17216000
              WHILE(J:=J+1)<=CTAB0(DRTNUM) DO                           17218000
                BEGIN                                                   17220000
                DUPLICATE;                                              17222000
                TOS := @DVRTAB(J*DVRSIZE)&LSL(1);              <<03704>>17224000
                IF *=*,(8) THEN                                         17226000
                  BEGIN <<DELETE FROM CS LIST>>                         17228000
                  DUPLICATE;                                            17230000
                  TOS:=S0+8; <<MOVE ALL FOLLOWING DVRS UP>>             17232000
                  TOS:=-S0+CTAB0(NUMADVRS)*CSDVRSIZE;<<LENGTH>>         17234000
                  ASSEMBLE(MVB 3);                                      17236000
                  CTAB0(X) := CTAB0(NUMADVRS)-1;                        17238000
                  I:=I-1;  <<REFLECT DELETED DVR IN COUNT>>             17240000
                  GOTO NEXTCSD;                                         17242000
                  END;                                                  17244000
                END;                                                    17246000
              TOS := TOS+8; <<NEXT CS DRIVER>>                          17248000
  NEXTCSD:    END;                                                      17250000
            DEL;                                                        17252000
            END;                                                        17254000
          IF CTAB0(NUMADVRS)>0  OR CSPRESENT THEN                       17256000
            BEGIN                                                       17258000
            GETYESNO(@CONFDONE, 152);  << ADDIT DVR CHANGES? >><<01073>>17260000
            IF CTAB0(NUMADVRS)<=0 THEN GO REQADVR;                      17262000
  REQLDVR:  GETYESNO(@REQDDVR,153); <<LIST ADDITIONAL DRIVERS?>>        17264000
            LISTDVRS;                                                   17266000
  REQDDVR:  GETYESNO(@REQADVR,154); <<DELETE DRIVERS?>>                 17268000
  GETDNAM:  MESSAGE(-19);   <<DRIVER NAME>>                             17270000
            READINPUT;                                                  17272000
            GETSTR(@GETDNAM,BDNAME,3,"A",8);                   <<00.04>>17274000
            IF = THEN GO REQADVR;                                       17276000
            I := -1;                                                    17278000
            WHILE(I:=I+1)<CTAB0(NUMADVRS) DO                            17280000
              IF BCSDVR((I*CSDVRSIZE)&LSL(1))=BDNAME,(8),2 THEN         17282000
                BEGIN  <<FOUND IT>>                                     17284000
                TOS := WORDADDRESS(BPS0); DELB; <<MAKE WORD ADD<<03704>>17286000
                TOS := S0-4;                                            17288000
                ASSEMBLE(XCH,DUP,NEG);                                  17290000
                TOS:=TOS+CTAB0(NUMADVRS)*CSDVRSIZE+@CSDVR;     <<01.00>>17292000
                <<CALCULATE REMAINING SIZE OF TABLE TO MOVE>>  <<00.06>>17294000
                ASSEMBLE(MOVE 3); <<COMPACT TABLE>>                     17296000
                CTAB0(X) := CTAB0(NUMADVRS)-1;                          17298000
                GO GETDNAM;                                             17300000
                END                                                     17302000
              ELSE DEL;                                                 17304000
            MESSAGE(155); <<DRIVER NOT IN LIST>>                        17306000
            GOTO GETDNAM;                                      <<00.04>>17308000
  REQADVR:  GETYESNO(@REQLNDVR,158); <<ADD DRIVERS?>>          <<+0.06>>17310000
  REQDNAME: MESSAGE(-19);    <<DRIVER NAME?>>                           17312000
            READINPUT;                                                  17314000
            GETSTR(@REQADVR,BDNAME,3,"A",8);                            17316000
            IF = THEN GO REQLNDVR;                                      17318000
            IF CTAB0(NUMADVRS)>=CSDRIVERS THEN                          17320000
              BEGIN <<MAX # OF EXTRA DRIVERS EXCEEDED>>                 17322000
              MESSAGE(157);                                             17324000
              GO REQLDVR;                                               17326000
              END;                                                      17328000
            I := -1;                                                    17330000
            WHILE(I:=I+1)<CTAB0(NUMADVRS) DO                            17332000
              IF BDNAME=BCSDVR(I*8),(8) THEN                            17334000
                BEGIN <<ALREADY EXISTS>>                                17336000
  DVRERR:       MESSAGE(156);                                           17338000
                GO REQLDVR;                                             17340000
                END;                                                    17342000
            I := 0;                                                     17344000
            WHILE(I:=I+1)<=HLDEV DO                                     17346000
              BEGIN                                                     17348000
              TOS := @DVRTAB(I*DVRSIZE+2)&LSL(1);              <<03704>>17350000
              IF *=BDNAME,(8) THEN GO DVRERR;                           17352000
              END;                                                      17354000
            TOS := @CSDVR+CTAB0(NUMADVRS)*CSDVRSIZE;                    17356000
            MOVE *:=DNAME,(4);                                          17358000
            CTAB0(X) := CTAB0(NUMADVRS)+1;                              17360000
            GOTO REQDNAME;                                              17362000
  REQLNDVR: IF CTAB0(NUMADVRS) <= 0 THEN GO TO CONFDONE;       <<01073>>17364000
            GETYESNO(@CONFDONE,153);                           <<01073>>17366000
            LISTDVRS;                                                   17368000
            END;                                                        17370000
  CONFDONE:                                                             17372000
      END <<MAINSEG1>> ;                                                17374000
$PAGE "MAINSEG2  --  CONFIGURATION CHANGES"                             17376000
$CONTROL SEGMENT=MAINSEG2                                               17378000
$PAGE "             SYSTEM TABLE CHANGES"                      <<01073>>17380000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>17382000
     PROCEDURE SYSTEM'TABLE'CH;                                <<01073>>17384000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>17386000
     BEGIN                                                     <<01073>>17388000
          GETNEWVAL(6,CTAB(CSTNUM),2,192); <<SHAREABLE AREA CST>>       17390000
          GETNEWVAL(25,CTAB(CSTXNUM),1,8192); <<PROGRAM AREA CST>>      17392000
          GETNEWVAL(26,CTAB(DSTNUM),1,1024);  <<DST>>                   17394000
          GETNEWVAL(27,CTAB(PCBNUM),2,256);   <<PCB>>                   17396000
          GETNEWVAL(28,CTAB(IOQNUM),20,255);   <<IOQ>>                  17398000
           GETNEWVAL(33,CTAB(DISCREQTABLE),20,255);<<DISC REQ TABLE>>   17400000
          GETNEWVAL(29,CTAB(TBUFNUM),1,  << NO. TBUFS/PORT >>  <<03007>>17402000
             PERPORTMAX);                                      <<03007>>17404000
                                                               <<03702>>17406000
          << THE FOLLOWING VALUE IS TYPE-AHEAD BUFFER SIZE  >> <<03702>>17408000
          << FOR TERMINALS.  IT IS RESERVED FOR FUTURE USE. >> <<03702>>17410000
                                                               <<03702>>17412000
     <<   GETNEWVAL(174,CTAB(TYPEBUF),0,60); <<TYPE-AHEAD   >> <<03702>>17414000
     <<                                      << BUFFER SIZE >> <<03702>>17416000
          GETNEWVAL(30,CTAB(SBUFNUM),8,255); <<SYSTEM BUFFERS>>         17418000
           GETNEWVAL(94,CTAB(SWAPTABLE),128,2048);<<SWAP TABLE><<01779>>17420000
           GETNEWVAL(95,CTAB(PRIMARYMSGTABLE),10,255);<<PRM MSG TAB>>   17422000
           GETNEWVAL(199,CTAB(SECNDRYMSGTABLE),10,255);<<2DRY>><<03701>>17424000
           GETNEWVAL(96,CTAB(SPECIALREQTABLE),10,255);<<SPCL REQ TAB>>  17426000
               GETNEWVAL(31,CTAB(ICSSIZE),128,2048);           <<03064>>17428000
          GETNEWVAL(32,CTAB(UCRQNUM),1,256);  <<UCOP REQUEST QUEUE>>    17430000
           GETNEWVAL(34,CTAB(TRLNUM),1,255);   <<TRL>>         <<04863>>17432000
          GETNEWVAL(97,CTAB(STOPNUM),1,255);                            17434000
   GETNEWVAL(181,CTAB(NLOGPROCS),2,64);                        <<00506>>17436000
   GETNEWVAL(182,CTAB(LOGIDS),1,128);                          <<00506>>17438000
     END;                                                      <<01073>>17440000
$PAGE "             MISCELLANEOUS TABLE CHANGES"               <<01073>>17442000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>17444000
     PROCEDURE MISC'CONFIG'CH;                                 <<01073>>17446000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>17448000
     BEGIN                                                     <<01073>>17450000
          IF YESANSWER(46) THEN LISTRIN;                       <<01073>>17452000
          IF YESANSWER(47) THEN                                <<01073>>17454000
          BEGIN                   << DELETE GLOBAL RIN >>      <<01073>>17456000
  REQRN:  N := GETVAL(60,1,1024,2);   <<ENTER RIN NUMBER>>              17458000
          IF N=0 THEN GOTO REQNLR;                                      17460000
          IF N>MINRIN OR RIN(N&LSL(1)).(0:2)<>2 THEN MESSAGE(10)        17462000
          ELSE                                                          17464000
            BEGIN  <<DELETE IT>>                                        17466000
              INDEX := RIN(N&LSL(1)).(2:14);                            17468000
              RIN(X) := 0;                                              17470000
              RIN(INDEX+1) := 0;  <<ZERO GLOBAL AREA>>                  17472000
              MOVE RIN(X:=X+1) := RIN(X:=X-1),(10);                     17474000
              RIN(INDEX) := RIN(I:=RINS&LSL(1)+2);  <<FREE LIST PTR>>   17476000
              RIN(I) := INDEX;  <<FREE LIST HEAD>>                      17478000
            END;                                                        17480000
          GO REQRN;                                                     17482000
  REQNLR: IF YESANSWER(46) THEN LISTRIN;                       <<01073>>17484000
          COMPACTRIN;                                          <<01073>>17486000
          END;                                                 <<01073>>17488000
  SETMIN: IF CTAB(RINS')<MINRIN THEN CTAB(X) := MINRIN;<<CORESIZE CHNG>>17490000
          IF CTAB(GRINS')<MINGRIN  THEN CTAB(X) := MINGRIN;             17492000
          RINCHANGE := TRUE;                                            17494000
          TOS := 0;                                                     17496000
          TOS := MINRIN;                                                17498000
          TOS := 10;                                                    17500000
          MOVE BINBUF := "# OF RINS MIN = ",2;                          17502000
          I := ASCII(*,*,*);                                            17504000
          MOVE BINBUF(I+16) := ", ";                                    17506000
          PRINT(INBUF,-I-18,%320);                                      17508000
          GETNEWVAL(37,CTAB(RINS'),MINRIN,1024);  <<MAX>>               17510000
          TOS := 0;                                                     17512000
          TOS := MINGRIN;                                               17514000
          TOS := 10;                                                    17516000
          MOVE BINBUF := "# OF GLOBAL RINS USED = ",2;                  17518000
          I := ASCII(*,*,*);                                            17520000
          MOVE BINBUF(I+24) := ", ";                                    17522000
          PRINT(INBUF,-I-26,%320);                                      17524000
          GETNEWVAL(37,CTAB(GRINS'),MINGRIN,1024);                      17526000
          GETNEWVAL(62,CTAB0(LOGON),10,600);  <<# OF SECONDS TO LOGON>> 17528000
          GETNEWVAL(114,CTAB(MAXRSES),1,255);<<MAX # OF                 17530000
                                  CONCURRENT RUNNING SESSIONS>>         17532000
          GETNEWVAL(52,CTAB(MAXRJOB),1,255);  <<MAX # OF RUNNING JOBS>> 17534000
          GETNEWVAL(81,CTAB0(CPULIM),0,32767);<<DEFAULT CPU TIME LIMIT>>17536000
CHNGMC:   GETYESNO(@REQSDFC,98);                               <<00150>>17538000
      MESSAGE(-100); <<CATALOG INPUT FILENAME?>>               <<DL.01>>17540000
      READINPUT;                                               <<DL.01>>17542000
      SCAN BINBUF WHILE BLANK,1;                               <<DL.01>>17544000
      @BPINBUF:=TOS;                                           <<DL.01>>17546000
      TOS:=0; <<SPACE FOR RETURN FROM GETSTR>>                 <<DL.01>>17548000
      TOS:=@MAKECATERROR; <<ERROR RETURN POINT>>               <<DL.01>>17550000
      MOVE B:="FILE INPUT=",2;                                 <<DL.01>>17552000
      TEMP:=GETSTR(*,*,1,".",27);                              <<DL.01>>17554000
      B(11+TEMP):=BYTE(%15);                                   <<DL.01>>17556000
      COMMAND(B,I,J);                                          <<DL.01>>17558000
      IF <> THEN GOTO MAKECATERROR;                            <<DL.01>>17560000
      SETJCW(0);                                               <<DL.01>>17562000
      IF <> THEN GOTO MAKECATERROR;                            <<DL.01>>17564000
      CREATE(MAKECATPROG,,MAKECATPIN,,MAKECATFLAG);            <<DL.01>>17566000
      IF <> THEN GOTO MAKECATERROR;                            <<DL.01>>17568000
      ACTIVATE(MAKECATPIN,MAKECATSUSP);                        <<DL.01>>17570000
      IF <> THEN GOTO MAKECATERROR;                            <<DL.01>>17572000
      MAKECATJCW:=GETJCW;                                      <<DL.01>>17574000
      IF <> THEN GOTO MAKECATERROR;                            <<DL.01>>17576000
      IF MAKECATJCW<>0 THEN                                    <<DL.01>>17578000
        BEGIN <<ERROR>>                                        <<DL.01>>17580000
MAKECATERROR:                                                  <<DL.01>>17582000
        MESSAGE(168); <<**MAKECAT ERROR**>>                    <<DL.01>>17584000
        IF MAKECATJCW<0 THEN                                   <<DL.01>>17586000
          PURGETEMPSL                                          <<DL.01>>17588000
        ELSE                                                   <<DL.01>>17590000
          GOTO CHNGMC;                                         <<DL.01>>17592000
        END   <<ERROR>>                                        <<DL.01>>17594000
      ELSE                                                     <<DL.01>>17596000
        BEGIN <<REPLACE CATALOG>>                              <<DL.01>>17598000
                                                               <<04253>>17600000
        ADD'TO'SYSPROG'CHG'TABLE(CATALOGFILE,CATALOGFILE'REP); <<04253>>17602000
                                                               <<04253>>17604000
                                                               <<04253>>17606000
        END;  <<CHANGE MESSAGE CATALOG>>                       <<04253>>17608000
                                                               <<00150>>17610000
REQSDFC:                                                       <<00150>>17612000
        IF POSTSERIES3 THEN                                    <<01402>>17614000
           BEGIN <<ALLOW CHANGES TO SOFTDUMP FACILITY>>        <<00150>>17616000
           IF NOT YESANSWER(176) THEN RETURN;                  <<01073>>17618000
           <<CHANGES?>>                                        <<00150>>17620000
           MESSAGE(-177); <<SDF COMMAND FILE NAME>>            <<00150>>17622000
           READINPUT;                                          <<00150>>17624000
           SCAN BINBUF WHILE BLANK,1;                          <<00150>>17626000
           @BPINBUF:=TOS;                                      <<00150>>17628000
           TOS:=0; <<SPACE FOR RETURN FROM GETSTR>>            <<00150>>17630000
           TOS:=@SDFERR; <<ERROR RETURN LABEL>>                <<00150>>17632000
           MOVE B:="FILE INPUT=",2;                            <<00150>>17634000
           TEMP:=GETSTR(*,*,1,".",27);                         <<00150>>17636000
           B(11+TEMP):=BYTE(%15);                              <<00150>>17638000
           COMMAND(B,I,J);                                     <<00150>>17640000
           IF <> THEN GOTO SDFERR;                             <<00150>>17642000
           SETJCW(0);                                          <<00150>>17644000
           IF <> THEN GOTO SDFERR;                             <<00150>>17646000
           CREATE(SDFPROG,,SDFPIN,,SDFFLAG);                   <<00150>>17648000
           IF <> THEN GOTO SDFERR;                             <<00150>>17650000
           ACTIVATE(SDFPIN,SDFSUSP);                           <<00150>>17652000
           IF <> THEN GOTO SDFERR;                             <<00150>>17654000
           SDFJCW:=GETJCW;                                     <<00150>>17656000
           IF <> THEN GOTO SDFERR;                             <<00150>>17658000
           IF SDFJCW<>0 THEN                                   <<00150>>17660000
              BEGIN <<ERROR>>                                  <<00150>>17662000
SDFERR:                                                        <<00150>>17664000
              MESSAGE(178); <<SDF ERROR>>                      <<00150>>17666000
              IF SDFJCW<0 THEN                                 <<00150>>17668000
                 PURGETEMPSL <<FATAL>>                         <<00150>>17670000
              ELSE                                             <<00150>>17672000
                 GOTO REQSDFC; <<RETRY>>                       <<00150>>17674000
              END   <<ERROR>>                                  <<00150>>17676000
           ELSE                                                <<00150>>17678000
              BEGIN <<REPLACE SDF COMMAND FILE >>              <<00150>>17680000
                                                               <<04253>>17682000
                                                               <<04253>>17684000
                                                               <<04253>>17686000
          ADD'TO'SYSPROG'CHG'TABLE(SDFCOMFILE,SDFCOMFILE'REP); <<04253>>17688000
              END;  <<REPLACE>>                                <<00150>>17690000
           END;  <<SDF CHANGES>>                               <<00150>>17692000
                                                               <<00150>>17694000
     END;                                                      <<01073>>17696000
$PAGE "             LOGGING CHANGES"                           <<01073>>17698000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>17700000
     PROCEDURE LOGGING'CH;                                     <<01073>>17702000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>17704000
     BEGIN                                                     <<01073>>17706000
         IF YESANSWER(76) THEN LISTLOG;                        <<01073>>17708000
         IF YESANSWER(77) THEN                                 <<01073>>17710000
         BEGIN                  << CHANGE STATUS >>            <<01073>>17712000
  REQLC:  MESSAGE(-78);  <<ENTER TYPE, ON/OFF>>                         17714000
          READINPUT;                                                    17716000
          N := INVAL(@LOGERR,",");     <<LOG TYPE>>                     17718000
          IF = THEN GOTO REQNLLG;                                       17720000
          IF > THEN                                                     17722000
            BEGIN  <<FOLLOWED BY CR>>                                   17724000
  LOGERR:     MESSAGE(1);                                               17726000
              GO REQLC;                                                 17728000
            END;                                                        17730000
          IF NOT (1<=N<=LOGRMAX) THEN GOTO LOGERR;             <<RH.PV>>17732000
          GETSTR(@REQLC,VNAME,1,"A",3); <<GET "ON" OR "OFF">>           17734000
          IF VNAME = "OFF" THEN TOS := 0                                17736000
          ELSE IF VNAME="ON" THEN TOS := 1                              17738000
          ELSE GOTO LOGERR;                                             17740000
          MORE := TOS;                                                  17742000
        EVENT'WORD:=N/16;     <<logging mask word #>>          <<01762>>17744000
        tos:=CTAB0(LOGBITS+EVENT'WORD);    <<get mask word>>   <<01762>>17746000
        X:=15 - N MOD 16;          <<compute bit position>>    <<01762>>17748000
          IF MORE THEN ASSEMBLE(TSBC 0,X) ELSE ASSEMBLE(TRBC 0,X);      17750000
        CTAB0(LOGBITS+EVENT'WORD):=tos;    <<set mask word>>   <<01762>>17752000
          GO REQLC;                                                     17754000
  REQNLLG:CTAB0(LOGBITS).(15:1) := CTAB0(LOGBITS).(14:1);               17756000
          IF YESANSWER(76) THEN LISTLOG;                       <<01073>>17758000
         END;                                                  <<01073>>17760000
          GETNEWVAL(79,CTAB0(LOGRECSIZE),1,8);                 <<01073>>17762000
          GETNEWVAL(80,CTAB0(LOGFILESIZE),16,32767);  <<LOG FILE SIZE>> 17764000
     END;                                                      <<01073>>17766000
$PAGE "             DISK ALLOCATION CHANGES"                   <<01073>>17768000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>17770000
     PROCEDURE DISK'ALLOC'CH;                                  <<01073>>17772000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>17774000
     BEGIN                                                     <<01073>>17776000
     DOUBLE  VDSLEN;     << V.M. LENGTH IN SECTORS >>          <<01549>>17778000
     LOGICAL VOLUME,                                           <<01549>>17780000
             VDSLEN1     = VDSLEN,                             <<01549>>17782000
             VDSLEN2     = VDSLEN+1;                           <<01549>>17784000
     BYTE ARRAY NAME(0:79);                                    <<01549>>17786000
     DOUBLE  DDIRC;                                            <<DE>>   17788000
     LOGICAL LDIRC1 = DDIRC,                                   <<DE>>   17790000
             LDIRC2 = DDIRC+1;                                 <<DE>>   17792000
                                                               <<01549>>17794000
          TOS := 0D;  <<FOR ASCII>>                                     17796000
          DSIR := GETSIR(DIRSIR);   <<DIRECTORY SIR>>                   17798000
          TOS:=SETSYSDB; <<FETCH DIRECTORY ADDRESS FROM SYS GLOB>>      17800000
          TOS:=DBARRAY(DIRDISC1);                              <<00215>>17802000
          TOS:=DBARRAY(DIRDISC2);                              <<00215>>17804000
          TOS:=S2;                                             <<00215>>17806000
          RESETDB(*);                                          <<00215>>17808000
          DIRDISCADR:=TOS;                                     <<00215>>17810000
          DEL;                                                 <<00215>>17812000
          DDIRC := DIRSIZE ( DIRSECT );                        <<DE>>   17814000
          RELSIR(DIRSIR,DSIR);                                          17816000
          TOS := DOUBLE (LDIRC1);  << Used Sectors >>          <<DE>>   17818000
          TOS := 10;                                                    17820000
          MOVE BINBUF := "DIRECTORY USED = ",2;                         17822000
          J := DASCII (*,*,*);                                 <<DE>>   17824000
          TOS := DOUBLE (LDIRC2);  << Minimum Size >>          <<DE>>   17826000
          TOS := 10;                                                    17828000
          MOVE BINBUF(J+17) := ", MIN = ",2;                            17830000
          TOS := DASCII (*,*,*);                               <<DE>>   17832000
          J := TOS+J;                                                   17834000
          MOVE BINBUF(J+25) := ", ";                                    17836000
          PRINT(INBUF,-J-27,%320);                                      17838000
          LDIRC1 := CTAB (DIRSECT');                           <<DE>>   17840000
          IF LDIRC1 < LDIRC2 THEN CTAB(DIRSECT'):=LDIRC2;      <<DE>>   17842000
          GETNEWVAL (37,CTAB(DIRSECT'),I,65000<<MAX>>);        <<DE>>   17844000
          IF YESANSWER(71) THEN LISTVOL;                       <<01073>>17846000
  REQDVOL:GETYESNO(@REQAVOL,66);  <<DELETE VOLUME>>                     17848000
  REQVNAME1:                                                            17850000
          MESSAGE(-67);    <<ENTER VOLUME NAME>>                        17852000
          READINPUT;                                                    17854000
          SCAN BINBUF WHILE BLANK;                                      17856000
          IF CARRY THEN GO REQAVOL;   <<CARRAIGE RETURN INPUT>>         17858000
          GETSTR(@REQVNAME1,VNAME,1,"A",8);                             17860000
          INDEX := FINDVOL(VNAME);                                      17862000
          IF <> THEN                                                    17864000
            BEGIN    <<NOT FOUND>>                                      17866000
              MESSAGE(69);                                              17868000
              GO REQVNAME1;                                             17870000
            END;                                                        17872000
          IF INDEX/VTABSIZE = MVOL THEN                        <<RH.PV>>17874000
            BEGIN  <<MUST COMPACT TABLE>>                               17876000
              DO                                               <<RH.PV>>17878000
                 BEGIN                                         <<RH.PV>>17880000
                 MVOL:=MVOL-1;                                 <<RH.PV>>17882000
                 I:=MVOL;                                      <<RH.PV>>17884000
                 IF VTAB(I*VTABSIZE) <> 0 THEN                 <<RH.PV>>17886000
                    GOTO SQUISHVTAB;                           <<RH.PV>>17888000
                 END                                           <<RH.PV>>17890000
              UNTIL <>;  <<WILL ALWAYS BE =>>                  <<RH.PV>>17892000
SQUISHVTAB:   HVOL:=MVOL;                                      <<RH.PV>>17894000
              VTABINCR := X-INDEX;                             <<RH.PV>>17896000
              MOVEDLTABLES;  <<COMPACT TABLE>>                          17898000
            END                                                         17900000
          ELSE                                                          17902000
            BEGIN  <<ZERO ENTRY>>                                       17904000
              VTAB(INDEX) := 0;                                         17906000
              MOVE VTAB(X:=X+1) := VTAB(X:=X-1),(VTABSIZE-1);           17908000
            END;                                                        17910000
          GO REQVNAME1;                                                 17912000
 REQAVOL:IF YESANSWER(68) THEN                                 <<01073>>17914000
         BEGIN                                                 <<01073>>17916000
  REQVNAME2:                                                            17918000
          MESSAGE(-67);   <<ENTER VOLUME NAME>>                         17920000
          READINPUT;                                                    17922000
          SCAN BINBUF WHILE BLANK;                                      17924000
          IF CARRY THEN GO REQNVL;                                      17926000
          GETSTR(@REQVNAME2,VNAME,1,"A",8);                             17928000
          FINDVOL(VNAME);                                               17930000
          IF = THEN                                                     17932000
            BEGIN  <<DUPLICATE>>                                        17934000
              MESSAGE(70);                                              17936000
              GO REQVNAME2;                                             17938000
            END;                                                        17940000
          I := 0;                                                       17942000
          WHILE (I:=I+1) <= HVOL DO                                     17944000
          IF VTAB(VTABSIZE*I)=0 THEN GO INSERTVOL;                      17946000
          IF I=256 THEN                                                 17948000
            BEGIN                                                       17950000
              MESSAGE(89); <<TOO MANY VOLUMES>>                         17952000
              GO REQDVOL;                                               17954000
            END;                                                        17956000
          HVOL := HVOL+1;                                               17958000
          MVOL := MVOL+1;                                      <<RH.PV>>17960000
          VTABINCR := VTABSIZE;                                         17962000
          MOVEDLTABLES;    <<MAKE ROOM FOR NEW ENTRY>>                  17964000
  INSERTVOL:                                                            17966000
          MOVE VTAB(I*VTABSIZE) := IVNAME,(4);  <<MOVE IN NAME>>        17968000
          GO REQVNAME2;                                                 17970000
         END;                                                  <<01073>>17972000
  REQNVL: IF YESANSWER(71) THEN LISTVOL;                       <<01073>>17974000
        <<-------------------------->>                         <<01549>>17976000
        <<  VIRTUAL MEMORY CHANGES  >>                         <<01549>>17978000
        <<-------------------------->>                         <<01549>>17980000
                                                               <<01549>>17982000
WHILE YESANSWER(193) DO                                        <<01549>>17984000
  BEGIN  << VIRTUAL MEMORY CHANGES? >>                         <<01549>>17986000
  IF YESANSWER(194) THEN LISTVM;                               <<01549>>17988000
  << LIST VIRTUAL MEMORY ALLOCATION? >>                        <<01549>>17990000
REDO:                                                          <<01549>>17992000
  MESSAGE(-195);  << ENTER VOLUME, SIZE IN KILO SECTORS >>     <<01549>>17994000
  READINPUT;                                                   <<01549>>17996000
  SCAN BINBUF WHILE BLANK, 1;                                  <<01549>>17998000
  IF NOCARRY THEN  << NOT CARRAGE RETURN INPUT >>              <<01549>>18000000
    BEGIN                                                      <<01549>>18002000
    @BPINBUF := TOS;                                           <<01549>>18004000
    << IF 1ST BYTE = ALPHA NAME WAS INPUT ELSE LDEV WAS INPUT>><<01549>>18006000
    IF BPINBUF = ALPHA THEN                                    <<01549>>18008000
      BEGIN  << GET VOLUME # FROM NAME >>                      <<01549>>18010000
      MOVE NAME := "        ";  << 8 BLANKS >>                 <<01549>>18012000
      MOVE NAME := BPINBUF WHILE ANS, 0;                       <<01549>>18014000
      DELB;  << SAVE SOURCE, DELETE DESTINATION >>             <<01549>>18016000
      IF BPS0 <> "," THEN                                      <<01549>>18018000
        BEGIN                                                  <<01549>>18020000
WRONG:  MESSAGE(01);  << ILLEGAL INPUT >>                      <<01549>>18022000
        GOTO REDO;                                             <<01549>>18024000
        END;                                                   <<01549>>18026000
      @BPINBUF := TOS+1;  << SKIP COMMA >>                     <<01549>>18028000
      VOLUME := FINDVOL(NAME);                                 <<01549>>18030000
      IF <> THEN                                               <<01549>>18032000
        BEGIN                                                  <<01549>>18034000
        MESSAGE(69);  << NO SUCH VOLUME >>                     <<01549>>18036000
        GOTO REDO;                                             <<01549>>18038000
        END;                                                   <<01549>>18040000
      VOLUME := VOLUME / VTABSIZE;                             <<01549>>18042000
      END                                                      <<01549>>18044000
    ELSE                                                       <<01549>>18046000
      BEGIN  << GET VOLUME # FROM LDEV >>                      <<01549>>18048000
      LDEV := INVAL(@WRONG, ",");                              <<01549>>18050000
      IF >= THEN GOTO WRONG;                                   <<01549>>18052000
      << BPINBUF NOW POINTING JUST PAST COMMA >>               <<01549>>18054000
      VOLUME := GETVOL(LDEV);                                  <<01549>>18056000
      IF <> THEN                                               <<01549>>18058000
        BEGIN                                                  <<01549>>18060000
        MESSAGE(69);  << NO SUCH VOLUME >>                     <<01549>>18062000
        GOTO REDO;                                             <<01549>>18064000
        END;                                                   <<01549>>18066000
      END;                                                     <<01549>>18068000
                                                               <<01549>>18070000
  << GOT VOLUME NOW GET REQUESTED LENGTH >>                    <<01549>>18072000
    TOS := 0;  << FOR DOUBLE VALUE RETURNED BY INVAL >>        <<01549>>18074000
    TOS := INVAL(@WRONG,,TRUE);                                <<01549>>18076000
    IF <= THEN GOTO WRONG;                                     <<01549>>18078000
    VDSLEN := TOS * 1024D;                                     <<01549>>18080000
                                                               <<01549>>18082000
  << VIRTUAL MEMORY SIZE HAS CHANGED - UPDATE VTAB >>          <<01549>>18084000
    VTAB(VOLUME*VTABSIZE+VTAB8) := 0;  << ZERO ADDRESS >>      <<01549>>18086000
    VTAB(X:=X+1) := 0;                                         <<01549>>18088000
    VTAB(X:=X+1) := VDSLEN1;                                   <<01549>>18090000
    VTAB(X:=X+1) := VDSLEN2;                                   <<01549>>18092000
    IF VDSLEN = 0D THEN VTAB(X:=X+1).VMS := 0                  <<01549>>18094000
    ELSE VTAB(X:=X+1).VMS := 1;                                <<01549>>18096000
                                                               <<01549>>18098000
    GOTO REDO;                                                 <<01549>>18100000
    END;  << NOT A CARRAGE RETURN INPUT >>                     <<01549>>18102000
  END;  << VIRTUAL MEMORY CHANGES >>                           <<01549>>18104000
  MAXKILS:MESSAGE(115);                                                 18106000
          BINBUF := "=";                                                18108000
          I := DASCII(DCTAB0(KILOSECTS),10,BINBUF(1));                  18110000
          BINBUF(I+1):="?";                                             18112000
          PRINT(INBUF,-I-2,%320);                                       18114000
          READINPUT;                                                    18116000
          TOS:=0D;                                                      18118000
          TOS:=INVAL(@MAXKILS,",",1);                                   18120000
          IF = THEN DDEL;                                               18122000
          IF < THEN                                                     18124000
           BEGIN                                                        18126000
           DDEL;                                                        18128000
           MESSAGE(1);                                                  18130000
           GO MAXKILS;                                                  18132000
           END;                                                         18134000
          IF > THEN                                                     18136000
            BEGIN                                                       18138000
            IF DS0<0D OR DS0>%777777D THEN                              18140000
             BEGIN                                                      18142000
             DDEL;                                                      18144000
             MESSAGE(1);                                                18146000
             GO MAXKILS;                                                18148000
             END                                                        18150000
            ELSE DCTAB0(KILOSECTS) := TOS;                              18152000
          END;                                                          18154000
RQEXTSSECT:                                                    <<00311>>18156000
         TOS:=CTAB0(EXTSSECT');                                <<00311>>18158000
          GETNEWVAL(161,CTAB0(EXTSSECT'),128,32767);                    18160000
         IF CTAB0(EXTSSECT').(14:2) <> 0 THEN                  <<00311>>18162000
            BEGIN                                              <<00311>>18164000
              MESSAGE(180);                                    <<00311>>18166000
              CTAB0(EXTSSECT'):=TOS; <<RESTORE OLD VALUE>>     <<00311>>18168000
              GO RQEXTSSECT;                                   <<00311>>18170000
            END                                                <<00311>>18172000
         ELSE                                                  <<00311>>18174000
           DEL;                                                <<00311>>18176000
     END;                                                      <<01073>>18178000
$PAGE "             SCHEDULING CHANGES"                        <<01073>>18180000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>18182000
     PROCEDURE SCHEDULING'CH;                                  <<01073>>18184000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>18186000
     BEGIN                                                     <<01073>>18188000
     END;                                                      <<01073>>18190000
$PAGE "             SEGMENT LIMIT CHANGES"                     <<01073>>18192000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>18194000
     PROCEDURE SEG'LIMIT'CH;                                   <<01073>>18196000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>18198000
     BEGIN                                                     <<01073>>18200000
          GETNEWVAL(92,CTAB(CONPROGNUM),1,127);                         18202000
          GETNEWVAL(40,CTAB(MCSS),1024,16384);  <<MAX CODE SEG>>        18204000
          GETNEWVAL(41,CTAB(MCSP),1,63); <<MAX CODE SEGS/PROC>><<00.04>>18206000
          GETNEWVAL(42,CTAB(MSTACK),256,31232);                         18208000
          GETNEWVAL(43,CTAB(MXDSS),0,32767);   <<MAX XDSEG SIZE>>       18210000
          GETNEWVAL(45,CTAB(MXDSP),0,255);  <<MAX XDSEGS/PROCESS>>      18212000
          GETNEWVAL(44,CTAB0(SSS),256,4096);  <<STD STACK SIZE>>        18214000
     END;                                                      <<01073>>18216000
$PAGE "             SYSTEM PROGRAM CHANGES"                    <<01073>>18218000
$CONTROL SEGMENT=SYSTEMCH                                      <<04253>>18222000
     PROCEDURE SYSTEM'PROG'CH;                                 <<04253>>18224000
     OPTION PRIVILEGED,UNCALLABLE;                             <<04253>>18226000
     BEGIN                                                     <<04253>>18228000
     DEFINE CR=%15#;                                           <<04253>>18230000
     LOGICAL TABLE'FULL;                                       <<04253>>18232000
     INTEGER I,ERROR,PARM;                                     <<04253>>18234000
     ARRAY MSGBUF(0:19);                                       <<04253>>18236000
     BYTE ARRAY BMSGBUF(*)=MSGBUF;                             <<04253>>18238000
     BYTE ARRAY PROGNAME(0:7),                                 <<04253>>18240000
                REPNAME(0:25),                                 <<04253>>18242000
                CKREPFILE(0:39);                               <<04253>>18244000
  REQSPC: MESSAGE(-51);   <<ENTER PROGRAM NAME, REPLACEMENT             18246000
                                  FILE NAME>>                  <<04253>>18248000
          READINPUT;                                           <<04253>>18250000
          SCAN BINBUF WHILE BLANK,1;                           <<04253>>18252000
          IF CARRY THEN                                        <<04253>>18254000
            BEGIN   <<CARRIAGE RETURN INPUT>>                  <<04253>>18256000
              DEL;                                             <<04253>>18258000
              GO REQSSLC;                                      <<04253>>18260000
            END;                                               <<04253>>18262000
          @BPINBUF := TOS;                                     <<04253>>18264000
          PROGNAME:= " ";                                      <<04253>>18266000
          MOVE PROGNAME(1):= PROGNAME,(7);                     <<04253>>18268000
          GETSTR(@BADSPC,PROGNAME,0,"A",8);                    <<04253>>18270000
          TABLE'FULL:= TRUE;                                   <<04253>>18272000
          I:= 0;                                               <<04253>>18274000
          WHILE I<SYSPROG'CHG'TABLE'LIMIT-68 DO                <<04253>>18276000
            BEGIN                                              <<04253>>18278000
            IF PROGNAME = BSPC(I),(8) THEN                     <<04253>>18280000
              BEGIN   <<ALREADY IN TABLE>>                     <<04253>>18282000
              BSPC(I):= 0;                                     <<04253>>18284000
              GO TO GETNEWP;                                   <<04253>>18286000
              END;                                             <<04253>>18288000
            IF BSPC(I)=0 THEN                                  <<04253>>18290000
              TABLE'FULL:= FALSE;                              <<04253>>18292000
            I:= I+34;  <<UPDATE TABLE PTR>>                    <<04253>>18294000
            END;                                               <<04253>>18296000
          IF TABLE'FULL THEN                                   <<04253>>18298000
            BEGIN                                              <<04253>>18300000
            MOVE BMSGBUF:=                                     <<04253>>18302000
              "SYSTEM PROGRAM CHANGE TABLE FULL        ";      <<04253>>18304000
            PRINT(MSGBUF,20,%40);                              <<04253>>18306000
            MOVE BMSGBUF:= "NO SYSTEM PROGRAM CHANGE FOR ";    <<04253>>18308000
            MOVE BMSGBUF(29):= PROGNAME,(8);                   <<04253>>18310000
            MOVE BMSGBUF(37):= "   ";                          <<04253>>18312000
            PRINT(MSGBUF,20,%40);                              <<04253>>18314000
            GO TO REQSPC;                                      <<04253>>18316000
            END;                                               <<04253>>18318000
                                                               <<04253>>18320000
          I:= -1;                                              <<04253>>18322000
          X:= -8;                                              <<04253>>18324000
          WHILE (I:=I+1) < NSYSPROG DO <<CHECK IF SYSTEM PROG>><<04253>>18326000
            BEGIN                                              <<04253>>18328000
              IF SYSPROG(X:=X+8) = PROGNAME,(8)                <<04253>>18330000
                              THEN GOTO GETNEWP;               <<04253>>18332000
            END;                                               <<04253>>18334000
          IF POSTSERIES3 THEN                                  <<04253>>18336000
             BEGIN <<SYSTEM PROGRAMS UNIQUE TO SERIES'33>>     <<04253>>18338000
             I:=-1;                                            <<04253>>18340000
             X:=-8;                                            <<04253>>18342000
             WHILE (I:=I+1) < NSYSPROG'33 DO                   <<04253>>18344000
                BEGIN                                          <<04253>>18346000
                IF SYSPROG'33(X:=X+8) = PROGNAME,(8)           <<04253>>18348000
                                   THEN GOTO GETNEWP;          <<04253>>18350000
                END;                                           <<04253>>18352000
             END;  <<SYSTEM PROGRAMS UNIQUE TO SERIES'33>>     <<04253>>18354000
          IF SERIESII'III THEN                                 <<04253>>18356000
             BEGIN <<UNIQUE SYSTEM PROGRAMS>>                  <<04253>>18358000
             I:=-1;                                            <<04253>>18360000
             X:=-8;                                            <<04253>>18362000
             WHILE (I:=I+1) < NSYSPROG'2 DO                    <<04253>>18364000
                BEGIN                                          <<04253>>18366000
                IF SYSPROG'2(X:=X+8)=PROGNAME,(8)              <<04253>>18368000
                                  THEN GOTO GETNEWP;           <<04253>>18370000
                END;                                           <<04253>>18372000
             END;                                              <<04253>>18374000
          I := -1;                                             <<04253>>18376000
          X := -DVRSIZE+DVR2;                                  <<04253>>18378000
          WHILE (I:=I+1)<=HLDEV DO                             <<04253>>18380000
            BEGIN  <<CHECK IF NON-STD DRIVER>>                 <<04253>>18382000
              @BDVRTAB:= @DVRTAB(X:=X+DVRSIZE)&LSL(1);         <<04267>>18384000
              IF BDVRTAB = PROGNAME,(8)                        <<04267>>18386000
                         THEN GO TO GETNEWP;                   <<04253>>18388000
            END;                                               <<04253>>18390000
          I := -1;                                             <<04253>>18392000
          TEMP := CTAB0(NUMADVRS);                             <<04253>>18394000
          X := -8;                                             <<04267>>18396000
          WHILE(I:=I+1)<TEMP DO                                <<04253>>18398000
            BEGIN  <<CHECK IF ADDITIONAL CS DRIVERS>>          <<04253>>18400000
            IF BCSDVR(X:=X+8)=PROGNAME,(8) THEN GOTO GETNEWP;  <<04267>>18402000
            END;                                               <<04253>>18404000
          MESSAGE(72);  <<NOT A SYSTEM PROGRAM>>               <<04253>>18406000
          IF LOGICAL(MODE) THEN GO REQSPC <<INTERACTIVE>>      <<04253>>18408000
             ELSE QUIT(1); <<BATCH>>                           <<04253>>18410000
  GETNEWP:GETSTR(@BADSPC,REPNAME,1,".",26);  <<FILE NAME>>     <<04253>>18412000
          MOVE CKREPFILE:= "LISTF ";                           <<04253>>18414000
          MOVE CKREPFILE(6):= REPNAME,(26);                    <<04253>>18416000
          MOVE CKREPFILE(32):= ";$NULL";                       <<04253>>18418000
          MOVE CKREPFILE(38):= CR;                             <<04253>>18420000
          ERROR:= 0;                                           <<04253>>18422000
          COMMAND(CKREPFILE,ERROR,PARM);                       <<04253>>18424000
          IF ERROR <> 0 THEN                                   <<04253>>18426000
            BEGIN                                              <<04253>>18428000
            MOVE BMSGBUF:=                                     <<04253>>18430000
              "REPLACEMENT FILE DOES NOT EXIST         ";      <<04253>>18432000
            PRINT(MSGBUF,20,%40);                              <<04253>>18434000
            MOVE BMSGBUF:= "NO SYSTEM PROGRAM CHANGE FOR ";    <<04253>>18436000
            MOVE BMSGBUF(29):= PROGNAME,(8);                   <<04253>>18438000
            MOVE BMSGBUF(37):= "   ";                          <<04253>>18440000
            PRINT(MSGBUF,20,%40);                              <<04253>>18442000
            GO TO REQSPC;                                      <<04253>>18444000
            END;                                               <<04253>>18446000
          ADD'TO'SYSPROG'CHG'TABLE(PROGNAME,REPNAME);          <<04253>>18448000
          GO TO REQSPC;                                        <<04253>>18450000
BADSPC:                                                        <<04253>>18452000
          IF LOGICAL(MODE) THEN GO REQSPC;                     <<04253>>18454000
          QUIT(1);                                             <<04253>>18456000
REQSSLC:                                                       <<04253>>18458000
     END;                                                      <<04253>>18460000
$PAGE "             SYSTEM SL CHANGES"                         <<01073>>18462000
$CONTROL SEGMENT=SYSTEMCH                                      <<01073>>18464000
     PROCEDURE SYSTEM'SL'CH;                                   <<01073>>18466000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>18468000
     BEGIN                                                     <<01073>>18470000
        INTEGER PATCHSIZE;                                     <<01073>>18472000
        SWITCH SEGSW := REQSEGR,REQSEGA,REQNSLL;               <<01073>>18474000
          ADDPUBSYS(PSLFILE);                                           18476000
          PSLFNUM := FOPEN(FULLNAME,1,%(2)100110000);                   18478000
  PSLERR: IF <> THEN FERROR(PSLFNUM,FULLNAME);                          18480000
          FLOCK(PSLFNUM,TRUE);                                          18482000
          IF <> THEN GOTO PSLERR;                                       18484000
          FGETINFO(PSLFNUM,,,,,,,,FILECODE,,EOF,FLIMIT,,,,              18486000
            EXTSIZE,NUMEXTENTS);                                        18488000
          IF <> THEN GOTO PSLERR;                                       18490000
          TOS := EOF;                                                   18492000
          TOS := EXTSIZE;                                               18494000
          ASSEMBLE(LDIV);                                               18496000
          IF TOS<>0 THEN TOS := TOS+1;                                  18498000
          INITALLOC := TOS;   <<INITIAL ALLOCATION FOR TEMPSL>>         18500000
          TSLFNUM:=FOPEN(TSLFILE,2);<<PURGE JOB-TEMP-FILE>>    <<01.00>>18502000
          FCLOSE(TSLFNUM,4,0);<<"TEMPSL" FROM ABORTED SYSDUMP>><<01.00>>18504000
          TSLFNUM := FOPEN(TSLFILE,,%(2)111010100,,,,,,,FLIMIT,         18506000
            NUMEXTENTS,INITALLOC,FILECODE);                             18508000
  TSLERR: IF <> THEN FERROR(TSLFNUM,TSLFILE);                           18510000
  COPYNEXT:                                                             18512000
          FREAD(PSLFNUM,LBUF,4096);                            <<03604>>18514000
          IF > THEN GOTO EOFREAD;                                       18516000
          IF < THEN GOTO PSLERR;                                        18518000
          FWRITE(TSLFNUM,LBUF,4096,0);                         <<03604>>18520000
          IF <> THEN GOTO TSLERR;                                       18522000
          GOTO COPYNEXT;                                                18524000
  EOFREAD:FREAD(PSLFNUM,LBUF,128);                                      18526000
          IF > THEN GOTO COPYDONE;                                      18528000
          IF < THEN GOTO PSLERR;                                        18530000
          FWRITE(TSLFNUM,LBUF,128,0);                                   18532000
          IF <> THEN GOTO TSLERR;                                       18534000
          GOTO EOFREAD;                                                 18536000
  COPYDONE:                                                             18538000
          FCLOSE(PSLFNUM,0,0);                                          18540000
          IF <> THEN GOTO PSLERR;                                       18542000
          FCLOSE(TSLFNUM,2,0);                                          18544000
          IF <> THEN GOTO TSLERR;                                       18546000
          TEMPSLSAVED := TRUE;                                          18548000
                                                               <<04253>>18550000
                                                               <<04253>>18552000
                                                               <<04253>>18554000
                                                               <<04253>>18556000
          ADD'TO'SYSPROG'CHG'TABLE(PSLFILE,TSLFILE);           <<04253>>18558000
                                                               <<04253>>18560000
                                                               <<04253>>18562000
                                                               <<04253>>18564000
          PIN := 0;                                                     18566000
          USLLEN := 0;                                                  18568000
          SEGMENTER(PIN,USESL,SEGERROR,,,,,,,,,TSLFILE);       <<00629>>18570000
                     <<INFORM SEGMENTER OF SL FILE>>                    18572000
          IF <> THEN                                                    18574000
            BEGIN                                                       18576000
  SEGERR:     IF > THEN                                                 18578000
              IF 0<=SEGERROR<=1 THEN <<SOFT ERROR>>            <<00458>>18580000
                 IF LOGICAL(MODE) THEN GO REQSEGD;<<INTERACTIVE<<00458>>18582000
              TOS := 0;                                                 18584000
              TOS := SEGERROR;                                          18586000
              TOS := 10;                                                18588000
              MOVE BINBUF := SEGERRMESS,(18),2;                         18590000
              X := ASCII(*,*,*);                                        18592000
              PRINT(INBUF,-X-18,0);                                     18594000
              PURGETEMPSL;                                              18596000
            END;                                                        18598000
          TOS := @REQSEGD;                                              18600000
          GETYESNO(*,49);     <<LIST SYSTEM MODULES?>>                  18602000
          SEGMENTER(PIN,LISTSL,SEGERROR,,,1);  <<LIST SL FILE>>         18604000
          IF <> THEN GOTO SEGERR;                                       18606000
  REQSEGD:I := -1;   <<DELETE MODE>>                                    18608000
          TOS := @REQSEGR;                                              18610000
          GETYESNO(*,53);   <<DELETE SEGMENT?>>                         18612000
  REQSEGC:IF I<0 THEN MESSAGE(-54) ELSE MESSAGE(-50);                   18614000
          PATCHSIZE := 0;  <<DEFAULT NO PATCH>>                <<01194>>18616000
          READINPUT;                                                    18618000
          SCAN BPINBUF WHILE BLANK,1;                                   18620000
          IF CARRY THEN                                                 18622000
            BEGIN       <<CARRIAGE RETURN INPUT>>                       18624000
              DEL;                                                      18626000
              GOTO SEGSW(I+1);                                          18628000
  REQSEGA:    I := I+1;                                                 18630000
              TOS := @REQNSLL;                                          18632000
              GETYESNO(*,55);   <<ADD SEGMENT?>>                        18634000
              GO REQSEGC;                                               18636000
  REQSEGR:    I := I+1;                                                 18638000
              TOS := @REQSEGA;                                          18640000
              GETYESNO(*,56);   <<REPLACE SEGMENT?>>                    18642000
              GO REQSEGC;                                               18644000
            END;                                                        18646000
          @BPINBUF := TOS;    <<UPDATE BUFFER POINTER>>                 18648000
          SEGMENT(15) := " ";                                           18650000
          TOS := 0;                                                     18652000
          TOS := @REQSEGC;                                              18654000
          TOS := @SEGMENT;                                              18656000
          IF I<0 THEN GETSTR(*,*,1,"'",15)                              18658000
          ELSE                                                          18660000
            BEGIN                                                       18662000
              GETSTR(*,*,0,"'",15);                                     18664000
              TEMP := 1;                                                18666000
              TOS := 0;                                                 18668000
              TOS := @REQSEGC;                                          18670000
              M := GETSTR(*,FULLNAME,-1,".",26);                        18672000
              IF < THEN                                                 18674000
                BEGIN   <<COMMA FOLLOWS>>                               18676000
                  SCAN BPINBUF WHILE BLANK,1;                           18678000
                  IF CARRY THEN                                         18680000
                    BEGIN                                               18682000
  ACERR:              DEL;                                              18684000
  ACERR1:             MESSAGE(1);                                       18686000
                      IF NOT LOGICAL(MODE) THEN QUIT(1);<<BATCH<<00458>>18688000
                      GO REQSEGC;                                       18690000
                    END;                                                18692000
                  IF BPS0="S" OR BPS0="s" THEN                 <<D.005>>18694000
                     TEMP:=%20001 <<SYS SEG>>                  <<D.005>>18696000
                  ELSE IF BPS0="C" OR BPS0="c" THEN            <<D.005>>18698000
                     TEMP:=%60001 <<CORE RES>>                 <<D.005>>18700000
                  ELSE IF BPS0="P" OR BPS0="p" THEN            <<D.005>>18702000
                     TEMP:=%100001 <<ALLOC>>                   <<D.005>>18704000
                  ELSE IF BPS0="," THEN TOS:=TOS-1             <<00629>>18706000
                  ELSE GOTO ACERR;                                      18708000
                  TOS := TOS+1;                                         18710000
                  SCAN * WHILE BLANK,1;                        <<00629>>18712000
                  IF NOCARRY THEN                              <<00629>>18714000
                     BEGIN                                     <<00629>>18716000
                     IF BPS0 <> "," THEN GO ACERR;             <<00629>>18718000
                     @BPINBUF := TOS+1;                        <<00629>>18720000
                     PATCHSIZE := INVAL(@ACERR1,",");          <<00629>>18722000
                     IF <= THEN GO ACERR1;                     <<00629>>18724000
                     END                                       <<00629>>18726000
                  ELSE                                         <<00629>>18728000
                     DEL;                                      <<00629>>18730000
                END;                                                    18732000
              FULLNAME(M) := " ";  <<FILENAME TERMINATOR>>              18734000
            END;                                                        18736000
          IF I>=0 THEN   <<REP OR ADD>>                        <<00458>>18738000
            BEGIN                                                       18740000
              IF USLLEN<>M OR USLFILE<>FULLNAME,(USLLEN) THEN           18742000
                BEGIN  <<NEW USL SPECIFICATION>>                        18744000
                  MOVE USLFILE := FULLNAME,(USLLEN:=M);                 18746000
                  SEGMENTER(PIN,USEUSL,SEGERROR,,,,,,,,,       <<00629>>18748000
                    FULLNAME);                                          18750000
                  IF <> THEN GOTO SEGERR;                               18752000
                                                                        18754000
                END;                                                    18756000
            END;                                               <<00458>>18758000
          IF I <= 0 THEN <<DEL OR REP>>                        <<00458>>18760000
             BEGIN                                             <<00458>>18762000
             SEGMENTER(PIN,PURGESL,SEGERROR,,,,,,,SEGMENT);    <<00629>>18764000
             IF <> THEN GOTO SEGERR;                           <<00458>>18766000
             END;                                              <<00458>>18768000
          IF I >= 0 THEN <<REP OR ADD>>                        <<00458>>18770000
             BEGIN                                             <<00458>>18772000
             SEGMENTER(PIN,ADDSL,SEGERROR,,,TEMP,,,PATCHSIZE,, <<00629>>18774000
                SEGMENT);                                      <<00629>>18776000
             IF <> THEN                                        <<00458>>18778000
                BEGIN                                          <<00458>>18780000
                PUSH( STATUS );  <<SAVE CONDCODE>>             <<00458>>18782000
                IF I=0 AND SEGERROR<>1 THEN  << REPLACE/WARN >><<01592>>18784000
                   BEGIN                                       <<00458>>18786000
                   MOVE BINBUF := "**WARNING** SEGMENT ",2;    <<00458>>18788000
                   SCAN SEGMENT UNTIL " ,",1;                  <<00458>>18790000
                   X := TOS-@SEGMENT;                          <<00458>>18792000
                   MOVE * := SEGMENT,(X),2;                    <<00458>>18794000
                   MOVE * := " PURGED!",2;                     <<00458>>18796000
                   X := TOS-@BINBUF;                           <<00458>>18798000
                   PRINT( INBUF,-X,0);                         <<00458>>18800000
                   END;                                        <<00458>>18802000
                SET( STATUS );  <<REPLACE CONDCODE>>           <<00458>>18804000
                GOTO SEGERR;                                   <<00458>>18806000
                END;                                           <<00458>>18808000
             END;                                              <<00458>>18810000
          GO REQSEGC;                                                   18812000
                                                                        18814000
 REQNSLL:IF YESANSWER(49) THEN                                 <<01073>>18816000
         BEGIN               << LIST SYSTEM MODULES >>         <<01073>>18818000
          SEGMENTER(PIN,LISTSL,SEGERROR,,,1);  <<LIST SL FILE>>         18820000
          IF <> THEN GOTO SEGERR;                                       18822000
         END;                                                  <<01073>>18824000
  SEGEXIT:    SEGMENTER(PIN,EXITSEG,SEGERROR);                          18826000
          IF <> THEN GOTO SEGERR;                              <<00598>>18828000
     END;                                                      <<01073>>18830000
$PAGE "             BUILD THE FILE MPECHECK"                   <<01073>>18832000
$CONTROL SEGMENT=MPECHECK                                      <<01073>>18834000
     PROCEDURE BUILD'MPECHECK;                                 <<01073>>18836000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>18838000
     BEGIN                                                     <<01073>>18840000
DEFINE                                                         <<01073>>18842000
      BA = OWN BYTE ARRAY#; << BYTE ARRAY DEFINITION >>        <<01073>>18844000
      BA F'NAME(0:8);   << TEMP. BUFFER FOR PUB.SYS FILE >>    <<01073>>18846000
      BA A'(0:44):=                                            <<01073>>18848000
      "BUILD SCR;DISC=2000,16;REC=-12,,F,ASCII;TEMP ";         <<01073>>18850000
      BA B'(0:20):=                                            <<01073>>18852000
      "FILE SCR=SCR,OLDTEMP "; << FILE DECLARATION >>          <<01073>>18854000
      BA C'(0:20):="LISTF @.PUB.SYS;*SCR ";  <<LISTF CMD>>     <<01073>>18856000
      BA D'(0:3):="SCR ";                                      <<01073>>18858000
      BA E'(0:9):="PURGE SCR ";                                <<01073>>18860000
      BA CR(0:1):=%15,%0;                                      <<01073>>18862000
        BA CHEKFILE(0:8):=                                     <<01073>>18864000
        "MPECHECK ";    << CHECKSUM FILE >>                    <<01073>>18866000
DOUBLE DCKSUM;          << DOUBLE CHECKSUM WORD >>             <<01073>>18868000
                                                               <<01073>>18870000
INTEGER ARRAY                                                  <<01073>>18872000
        CKSUM (*) = DCKSUM; << INTEGER ADDR.>>                 <<01073>>18874000
                                                               <<01073>>18876000
LOGICAL ARRAY                                                  <<01073>>18878000
        BUFL(*)=LBUF;   << LOGICAL WORKING BUFFER >>           <<01073>>18880000
                        << LBUF=INTEGER ARRAY (0:4000) >>      <<01073>>18882000
                                                               <<01073>>18884000
        BYTE ARRAY BYBUF(*)=BUFL(512);  <<BYTE BUFFER ADDR.>>  <<01073>>18886000
                                                               <<01073>>18888000
        BYTE ARRAY BBUF(*)=BUFL(384);<<BYTE ADDR/OUTPT BUFFER>><<01073>>18890000
                                                               <<01073>>18892000
BYTE POINTER BUFP;      << BYTE POINTER >>                     <<01073>>18894000
                                                               <<01073>>18896000
INTEGER CHEKFNUM,       << FILE NO. FOR MPECHECK >>            <<01073>>18898000
        II,             << SCR WORD >>                         <<01073>>18900000
        F'CODE,         << FILE CODE >>                        <<01073>>18902000
        REC'CNT,        << RECORD COUNT >>                     <<01073>>18904000
        JJ,             << COUNTER >>                          <<01073>>18906000
        SL'WD,          << SEG. LENGTH COUNT >>                <<01073>>18908000
        SEG'LEN,        << SEGMENT LENGTH >>                   <<01073>>18910000
        I1,             << COMMAND INTR. PARM >>               <<01073>>18912000
        I2,             << COMMEND INTR. PARM >>               <<01073>>18914000
        FNSCR,          << FILE # FOR SCR FILE >>              <<01073>>18916000
        FNSYS,          << SYSTEM FILE # >>                    <<01073>>18918000
        SPACE:=%20040,  << TEMPORARY >>                        <<01073>>18920000
        IX40:=40,                                              <<01073>>18922000
        IX79:=79,                                              <<01073>>18924000
        IX128:=128,                                            <<01073>>18926000
        IX255:=255,                                            <<01073>>18928000
        IX256:=256,                                            <<01073>>18930000
        W'EOF:=6,                                              <<01073>>18932000
        P'FILE:=4,                                             <<01073>>18934000
        ENTRY'CNT;      << SEG ENTRY COUNT >>                  <<01073>>18936000
                                                               <<01073>>18938000
LOGICAL NS'SUM,         << # OF SECTIONS >>                    <<01073>>18940000
        NRT'SUM,        << # REFERENCE TABLE ENTRIES >>        <<01073>>18942000
        FRTL'SUM,       << S.A. OF FREE R.T.ENTRY LIST >>      <<01073>>18944000
        NSEG'SUM,       << # SEGMENTS >>                       <<01073>>18946000
        EL'SUM,         << EXTENT LENGTH(IN RECORDS)>>         <<01073>>18948000
        FL'SUM,         << FILE LENGTH(IN RECORDS)>>           <<01073>>18950000
        S'REC,          << # OF SEG. RECORDS >>                <<01073>>18952000
        SADDR,          << TEMP. STARTING REC. ADDR. >>        <<01073>>18954000
        STT'NUM,        << LOC. OF MAP ARRAY LENGTH >>         <<01073>>18956000
        L'SEG'LEN,      << LOGICAL SEG. LENGTH >>              <<01073>>18958000
        SUM'PARM:=9;    << FCONTROL PARM >>                    <<01073>>18960000
                                                               <<01073>>18962000
DOUBLE  DRECNUM;        << TEMPORARY REC # >>                  <<01073>>18964000
                                                               <<01073>>18966000
EQUATE                                                         <<01073>>18968000
        EQFL'=1,        << LOC. FILE LENGTH(IN REC)>>          <<01073>>18970000
        EQEL'=2,        << LOC. EXTENT LENGTH(IN REC)>>        <<01073>>18972000
        EQNSEG'=4,      << LOC. # OF SEGMENTS >>               <<01073>>18974000
        EQFRTL'=7,      << LOC. S.A. OF FREE R.T. ENTRY LIST>> <<01073>>18976000
        EQNRT'=9,       << LOC. REF.TABLE ENTRIES >>           <<01073>>18978000
        EQNS'=11,       << LOC. # OF SECTIONS >>               <<01073>>18980000
        INDX1=1,                                               <<01073>>18982000
        INDX4=4,                                               <<01073>>18984000
        INDX20=20,                                             <<01073>>18986000
        INDX25=25,                                             <<01073>>18988000
        INDX28=28,                                             <<01073>>18990000
        INDX32=32,                                             <<01073>>18992000
        INDX35=35,                                             <<01073>>18994000
        INDX127=127,                                           <<01073>>18996000
        INDX128=128,                                           <<01073>>18998000
        SUMSEGL'=0,     << SEG. LENGTH >>                      <<01073>>19000000
        SUMSEGAD'=1,    << SEG. ADDRESS REC # >>               <<01073>>19002000
        SUMSEGNO'=2,    << #REC=SEG + EXTERNAL LIST >>         <<01073>>19004000
        SUMENTRY'=3,    << # ENTRY POINTS >>                   <<01073>>19006000
        SYSSEG'=1,      << LOC. OF # OF SEGMENTS/FILE >>       <<01073>>19008000
        SYSCODE'=4,     << STARTING CODE SEGMENT REC# >>       <<01073>>19010000
        INDX3=3,        << MULTIPLE INDEX COUNTER >>           <<01073>>19012000
        INDX8=8,        << MULTIPLE INDEX COUNTER >>           <<01073>>19014000
        INDX256=256,    << START INDEX VALUE >>                <<01073>>19016000
        INDX384=384,    << END   INDEX VALUE >>                <<01073>>19018000
        INDX512=512,    << BUFFER START INDEX >>               <<01073>>19020000
        FNAME'PTR=8;    << FILE NAME ADDRESS INDEX >>          <<01073>>19022000
                                                               <<01073>>19024000
<<*******************************************************>>    <<00598>>19026000
                                                               <<00598>>19028000
     ADDPUBSYS(CHEKFILE);   << CANCATENATE PUB.SYS TO >>       <<00598>>19030000
                            << MPECHECKFILE.          >>       <<00598>>19032000
      CHEKFNUM:=FOPEN(FULLNAME,%2005,%240);                    <<00740>>19034000
     IF = THEN              << MPECHECK EXISTS >>              <<00598>>19036000
     BEGIN                                                     <<00598>>19038000
      FGETINFO(CHEKFNUM,,,,,,,,F'CODE);<<GET FILECODE>>        <<00598>>19040000
      IF <> THEN FERROR(CHEKFNUM,FULLNAME);<<DUMP ERR>>        <<00598>>19042000
      IF F'CODE <> -1023 THEN                                  <<00598>>19044000
      BEGIN                                                    <<00598>>19046000
       FCLOSE(CHEKFNUM,4,0); << PURGE FILE >>                  <<00598>>19048000
       IF <> THEN FERROR(CHEKFNUM,FULLNAME);<<DUMP ERR>>       <<00598>>19050000
       GO OPEN'CHECK;                                          <<00598>>19052000
      END; << END: FILECODE <> -1023 >>                        <<00598>>19054000
                                                               <<00598>>19056000
      FCLOSE(CHEKFNUM,0,0); << LEAVE IT ALONE >>               <<00598>>19058000
      IF <> THEN FERROR(CHEKFNUM,FULLNAME);                    <<00598>>19060000
      GO EXT';              << GENERATE CHECKSUM FOR SYSPROG>> <<00598>>19062000
     END                                                       <<00598>>19064000
     ELSE                                                      <<00598>>19066000
     BEGIN   <<MPECHECK FILE IS NON-EXISTENT>>                 <<00598>>19068000
      FCHECK(CHEKFNUM,II);  << FIND OUT WHAT'S WRONG >>        <<00598>>19070000
                                                               <<00598>>19072000
      << **** TEST FOR NON-EXISTENT PERMANENT FILE **** >>     <<00598>>19074000
                                                               <<00598>>19076000
      IF II <> 52 THEN FERROR(CHEKFNUM,FULLNAME);              <<00598>>19078000
                                                               <<00598>>19080000
      <<***** MPECHECK FILE NON-EXISTENT *****>>               <<00598>>19082000
OPEN'CHECK:                                                    <<00598>>19084000
       CHEKFNUM:=FOPEN(FULLNAME,%2004,%144,,,,,,               <<00740>>19086000
                       ,8000D,,,1023);                         <<00740>>19088000
      IF <> THEN FERROR(CHEKFNUM,FULLNAME);                    <<00598>>19090000
                                                               <<00598>>19092000
      <<******************************************>>           <<00598>>19094000
      <<**** WRITE OUT UPDATE LEVEL, FIX LEVEL, **>>           <<00598>>19096000
      <<**** VERSION NUMBER ONTO MPECHECK FILE. **>>           <<00598>>19098000
      <<******************************************>>           <<00598>>19100000
                                                               <<00598>>19102000
      MOVE BBUF:=" ";  << BLANK OUT >>                         <<00598>>19104000
      MOVE BBUF(1):=BBUF,(71); << OUTPUT BUFFER >>             <<00598>>19106000
                                                               <<00598>>19108000
      II:=-1;  << INITIALIZE LOOP COUNTER >>                   <<00598>>19110000
      WHILE (II:=II+1) < 3 DO                                  <<00598>>19112000
      BEGIN                                                    <<00598>>19114000
       ASCII(VERSID(II),8,BBUF(II*7));                         <<00598>>19116000
      END;                                                     <<00598>>19118000
                                                               <<00598>>19120000
      FWRITE(CHEKFNUM,BUFL(384),11,0); <<WRITE IT>>            <<00598>>19122000
      IF <> THEN FERROR(CHEKFNUM,FULLNAME);                    <<00598>>19124000
                                                               <<00598>>19126000
                                                               <<00598>>19128000
      << *********************************************>>       <<00598>>19130000
      << *********************************************>>       <<00598>>19132000
      << ****                                     ****>>       <<00598>>19134000
      << **** BEGIN STRIPPING SL FILE FOR CHECK-  ****>>       <<00598>>19136000
      << **** SUM CALCULATION.                    ****>>       <<00598>>19138000
      << ****                                     ****>>       <<00598>>19140000
      << *********************************************>>       <<00598>>19142000
      << *********************************************>>       <<00598>>19144000
                                                               <<00598>>19146000
      ADDPUBSYS(PSLFILE);   << CANCATENATE PUB.SYS TO >>       <<00598>>19148000
                            << SL                     >>       <<00598>>19150000
      PSLFNUM:=FOPEN(FULLNAME,1,%(2)100110000);<< OPEN >>      <<00598>>19152000
                                               << SL  >>       <<00598>>19154000
      IF <> THEN FERROR(PSLFNUM,FULLNAME);                     <<00598>>19156000
      FLOCK(PSLFNUM,TRUE);  << LOCK SL WHILE ATTEMPTING >>     <<00598>>19158000
                            << TO READ                  >>     <<00598>>19160000
      IF <> THEN FERROR(PSLFNUM,FULLNAME); <<ERROR>>           <<00598>>19162000
                                                               <<00598>>19164000
      DRECNUM:=0D;          << INITIALIZE REC # >>             <<00598>>19166000
      FREADDIR(PSLFNUM,BUFL,IX128,DRECNUM);<<READ REC #0>>     <<00598>>19168000
      IF > THEN GO EOFSUM;  << EOF REACHED >>                  <<00598>>19170000
      IF < THEN FERROR(PSLFNUM,FULLNAME);<<OTHER ERROR>>       <<00598>>19172000
                                                               <<00598>>19174000
      FL'SUM:=BUFL(EQFL');  << SL FILE LENGTH >>               <<00598>>19176000
      EL'SUM:=BUFL(EQEL');  << SL EXTENT LENGTH >>             <<00598>>19178000
      NSEG'SUM:=BUFL(EQNSEG');<< # OF SEGMENTS >>              <<00598>>19180000
      FRTL'SUM:=BUFL(EQFRTL');<< FREE R.T. ENTRY LIST>>        <<00598>>19182000
      NRT'SUM:=BUFL(EQNRT');  << REF.TABLE ENTRIES >>          <<00598>>19184000
      NS'SUM:=BUFL(EQNS');    << # OF SECTIONS >>              <<00598>>19186000
                                                               <<00598>>19188000
      FREADDIR(PSLFNUM,BUFL,IX128,DRECNUM+1D);<<READ REC 1>>   <<00598>>19190000
      IF > THEN GO EOFSUM;   << EOF REACHED >>                 <<00598>>19192000
      IF < THEN FERROR(PSLFNUM,FULLNAME);<< OTHER ERROR>>      <<00598>>19194000
                                                               <<00598>>19196000
      II:=-1;  << INITIALIZE BUFFER INDEX >>                   <<00598>>19198000
      WHILE (LBUF(II:=II+1)) <> 0 DO                           <<00598>>19200000
      BEGIN                                                    <<00598>>19202000
       FREADDIR(PSLFNUM,BUFL(INDX128),IX128,DOUBLE(LBUF(II))); <<00598>>19204000
       IF < THEN FERROR(PSLFNUM,FULLNAME);                     <<00598>>19206000
       IF > THEN GO EOFSUM;  << REACHED EOF>>                  <<00598>>19208000
       ENTRY'CNT:=INDX3;                                       <<00598>>19210000
       WHILE (ENTRY'CNT:=ENTRY'CNT+1) < INDX8 DO               <<00598>>19212000
       BEGIN                                                   <<00598>>19214000
        IF NOT(BUFL(INDX32*ENTRY'CNT+SUMENTRY').(0:1)) AND     <<00598>>19216000
        BUFL(INDX32*ENTRY'CNT+SUMENTRY').(6:1) THEN            <<00598>>19218000
        BEGIN  << IF SEGMENT NON-DELETED AND IS A MPE SEGMENT>><<00598>>19220000
         SL'WD:=0;  << INITIALIZE SEG.LENGTH WORD COUNT>>      <<00598>>19222000
         REC'CNT:=-1;  << INITIALIZE COUNTER >>                <<00598>>19224000
         @BUFP:=@BUFL(INDX32*ENTRY'CNT+FNAME'PTR)&LSL(1);      <<03704>>19226000
         SEG'LEN:=LBUF(INDX32*ENTRY'CNT+SUMSEGL').(2:14);      <<00598>>19228000
         S'REC:=LOGICAL(SEG'LEN+INDX127)&LSR(7);<<# OF RECS>>  <<00598>>19230000
         SADDR:=LBUF(INDX32*ENTRY'CNT+SUMSEGAD');<<SAVE S.A>>  <<00598>>19232000
         FREADDIR(PSLFNUM,BUFL(INDX256),IX128,DOUBLE(SADDR)+   <<00598>>19234000
                  DOUBLE(S'REC-1));<<GET REC INCL.STT>>        <<00598>>19236000
                                   <<LENGTH.         >>        <<00598>>19238000
         IF > THEN GO EOFSUM;  <<REACHED EOF>>                 <<00598>>19240000
         IF <  THEN                                            <<00598>>19242000
          BEGIN                                                <<00598>>19244000
           ADDPUBSYS(PSLFILE);  << CANCATENATE PUB.SYS >>      <<00598>>19246000
           FERROR(PSLFNUM,FULLNAME); <<DUMP FILE ID.>>         <<00598>>19248000
          END;                                                 <<00598>>19250000
                                                               <<00598>>19252000
         STT'NUM:=LOGICAL(SEG'LEN)-(S'REC-1)&LSL(7)-1;<<GET>>  <<00598>>19254000
                                       <<SEGMENT ELEMENT>>     <<00598>>19256000
         SEG'LEN:=LOGICAL(SEG'LEN)-BUFL(STT'NUM+      <<GET>>  <<00598>>19258000
                  INDX256).(8:8)-1;  << STT LENGTH >>          <<00598>>19260000
                                                               <<00598>>19262000
         DCKSUM:=0D;  << INITIALIZE CHECKSUM VALUE>>           <<00598>>19264000
         WHILE (REC'CNT:=REC'CNT+1) < INTEGER(S'REC) DO        <<00598>>19266000
         BEGIN                                                 <<00598>>19268000
          FREADDIR(PSLFNUM,BUFL(INDX256),IX128,DOUBLE(         <<00598>>19270000
          LBUF(INDX32*ENTRY'CNT+SUMSEGAD'))+DOUBLE(REC'CNT));  <<00598>>19272000
          IF > THEN GO EOFSUM;  << EOF REACHED >>              <<00598>>19274000
          IF < THEN FERROR(PSLFNUM,FULLNAME);<< OTHER >>       <<00598>>19276000
                                             << ERROR >>       <<00598>>19278000
          JJ:=INDX256;  << INITIALIZE INDEX VALUE >>           <<00598>>19280000
          DO                                                   <<00598>>19282000
           BEGIN                                               <<00598>>19284000
            DCKSUM:=DCKSUM+DOUBLE(BUFL(JJ));<<GEN. CHECKSUM >> <<00598>>19286000
            TOS:=0;  << ZERO STACK >>                          <<00598>>19288000
            TOS:=CKSUM;                                        <<00598>>19290000
            TOS:=CKSUM(1);                                     <<00598>>19292000
            ASSEMBLE ( OR );                                   <<00598>>19294000
            DCKSUM:=TOS;                                       <<00598>>19296000
            IF (SL'WD:=SL'WD+1) = SEG'LEN THEN GO NEW'REC;     <<00598>>19298000
           END                                                 <<00598>>19300000
          UNTIL (JJ:=JJ+1) = INDX384;     << BUFF END >>       <<00598>>19302000
         END;    << END: WHILE REC'CNT >>                      <<00598>>19304000
NEW'REC:                                                       <<00598>>19306000
                                                               <<00598>>19308000
         MOVE BBUF:=" ";                                       <<00598>>19310000
         MOVE BBUF(INDX1):=BBUF,(IX255);     << BLANK OUTPUT >><<00598>>19312000
                                   << BUFFER           >>      <<00598>>19314000
         SCAN BUFP UNTIL SPACE,1;  <<LOOK FOR SPACE>>          <<00598>>19316000
         JJ:=TOS - @BUFP;  << GET DELTA LENGTH >>              <<00598>>19318000
         MOVE BBUF:=BUFP,(JJ); << MOVE FILE NAME >>            <<00598>>19320000
         ASCII(LOGICAL(SEG'LEN),8,BBUF(INDX25));<< SEG. LEN >> <<00598>>19322000
         ASCII(LOGICAL(CKSUM(1)),8,BBUF(INDX35));<<CHECKSUM >> <<00598>>19324000
                                                               <<00598>>19326000
         <<*********************************************>>     <<00598>>19328000
         <<*** TO INSERT MOD/PRODUCT ID. LATER        ***>>    <<00598>>19330000
         <<*********************************************>>     <<00598>>19332000
                                                               <<00598>>19334000
         FWRITE(CHEKFNUM,BUFL(INDX384),IX128,0);<< WRITE >>    <<00598>>19336000
                                           << MPECHECK >>      <<00598>>19338000
                                           << FILE.    >>      <<00598>>19340000
         IF <> THEN                                            <<00598>>19342000
          BEGIN                                                <<00598>>19344000
           ADDPUBSYS(CHEKFILE); << CANCATENATE PUB.SYS >>      <<00598>>19346000
           FERROR(CHEKFNUM,FULLNAME);                          <<00598>>19348000
          END;                                                 <<00598>>19350000
         END;  << END: IF SEG. NOT DELETED AND MPE SEG >>      <<00598>>19352000
        END; << END: WHILE ENTRY'CNT >>                        <<00598>>19354000
       END; << END: WHILE II-BUFFER INDEX >>                   <<00598>>19356000
EOFSUM:                                                        <<00598>>19358000
       FUNLOCK(PSLFNUM); << UNLOCK THE FILE >>                 <<00598>>19360000
       IF <> THEN                                              <<00598>>19362000
        BEGIN                                                  <<00598>>19364000
         ADDPUBSYS(PSLFILE); << CAN PUB.SYS >>                 <<00598>>19366000
         FERROR(PSLFNUM,FULLNAME);                             <<00598>>19368000
        END;                                                   <<00598>>19370000
                                                               <<00598>>19372000
       FCLOSE(PSLFNUM,0,0); << CLOSE SL FILE >>                <<00598>>19374000
       IF <> THEN                                              <<00598>>19376000
        BEGIN                                                  <<00598>>19378000
         ADDPUBSYS(PSLFILE); << CANCATENATE PUB.SYS >>         <<00598>>19380000
         FERROR(PSLFNUM,FULLNAME);                             <<00598>>19382000
        END;                                                   <<00598>>19384000
                                                               <<00598>>19386000
        << ******    GOOD - CONTINUE   ****** >>               <<00598>>19388000
                                                               <<00598>>19390000
        << CONTINUE >>                                         <<00598>>19392000
        MOVE A'(44):=CR,(1);  << BUILD CMD >>                  <<00598>>19394000
        MOVE B'(20):=CR,(1);  << FILE DECLARATION >>           <<00598>>19396000
        MOVE C'(20):=CR,(1);  << LISTF CMD >>                  <<00598>>19398000
        MOVE E'(9) :=CR,(1);  << PURGE CMD >>                  <<00598>>19400000
                                                               <<00598>>19402000
        COMMAND(E',I1,I2);IF <> THEN QUIT(0);<<PURGE CMD>>     <<00598>>19404000
        COMMAND(A',I1,I2);IF <> THEN QUIT(1);<<BUILD CMD>>     <<00598>>19406000
        COMMAND(B',I1,I2);IF <> THEN QUIT(2);<<FILE DECLAR>>   <<00598>>19408000
        COMMAND(C',I1,I2);IF <> THEN QUIT(3);<<LISTF CMD>>     <<00598>>19410000
                                                               <<00598>>19412000
                                                               <<00598>>19414000
   FNSCR:=FOPEN(D',3,,-80,,,,1,,300D,1,1);                     <<00598>>19416000
   IF <> THEN                                                  <<00598>>19418000
    BEGIN                                                      <<00598>>19420000
     ADDPUBSYS(D');  << CANCATENATE PUB.SYS >>                 <<00598>>19422000
     FERROR(FNSCR,FULLNAME); << DUMP FILE ID. >>               <<00598>>19424000
    END;  << END: CC UNEQUAL >>                                <<00598>>19426000
   DRECNUM:=2D;   << INITIALIZE RECORD # >>                    <<00598>>19428000
   MOVE BYBUF:=%377;  << MAKE IT <> SPACE >>                   <<00598>>19430000
   WHILE BYBUF <> " " DO                                       <<00598>>19432000
   BEGIN                                                       <<00598>>19434000
    MOVE BYBUF:=" ";  << BLANK OUT >>                          <<00598>>19436000
    MOVE BYBUF(INDX1):=BYBUF,(IX79); << BUFFER >>              <<00598>>19438000
    DRECNUM:=DRECNUM+1D;  <<INCREMENT RECORD COUNTER>>         <<00598>>19440000
    FREADDIR(FNSCR,BUFL(INDX512),IX40,DRECNUM);<<RD FILNAME>>  <<00598>>19442000
    IF > THEN GO EOF'SCR;  << REACHED EOF ON SCR >>            <<00598>>19444000
    IF < THEN                                                  <<00598>>19446000
     BEGIN                                                     <<00598>>19448000
      ADDPUBSYS(D');  << CANCATENATE PUB.SYS >>                <<00598>>19450000
      FERROR(FNSCR,FULLNAME); << DUMP FILE ID. >>              <<00598>>19452000
     END; << END: CC LESS THAN >>                              <<00598>>19454000
                                                               <<00598>>19456000
   IF BYBUF = " " THEN GO EOF'SCR; <<EXIT FINISHED>>           <<00598>>19458000
   MOVE F'NAME:=" "; <<BLANK OUT FILE NAME >>                  <<00598>>19460000
   MOVE F'NAME(1):=F'NAME,(8);                                 <<00598>>19462000
   MOVE F'NAME:=BYBUF WHILE AN;  <<GET FILNAME>>               <<00598>>19464000
                                                               <<00598>>19466000
   ADDPUBSYS(F'NAME);  << CANCATENATE PUB.SYS >>               <<00598>>19468000
   FNSYS:=FOPEN(FULLNAME,1,%(2)100110000);<<OPEN SYS FILE>>    <<00598>>19470000
   IF FNSYS = 0 THEN GO EXT1';                                 <<00598>>19472000
                                                               <<00598>>19474000
   FGETINFO (FNSYS,,,,,,,,F'CODE); << GET FILE CODE >>         <<00598>>19476000
   IF <> THEN FERROR(FNSYS,FULLNAME); <<DUMP FILE ID>>         <<00598>>19478000
                                                               <<00598>>19480000
   IF F'CODE <> 1029 THEN GO F'CLOSE; <<CLOSE FILES>>          <<00598>>19482000
   FLOCK(FNSYS,TRUE);  << LOCK SYS. FILE WHILE ACCESSING >>    <<00598>>19484000
   IF <> THEN FERROR(FNSYS,FULLNAME);<<DUMP FILE ID.>>         <<00598>>19486000
                                                               <<00598>>19488000
                                                               <<00598>>19490000
   <<***********************************************>>         <<00598>>19492000
   <<***********************************************>>         <<00598>>19494000
   <<*** STRIP DOWN SYSTEM PROGRAM FILE AND      ***>>         <<00598>>19496000
   <<*** GENERATE CHECKSUM CODE.                 ***>>         <<00598>>19498000
   <<***********************************************>>         <<00598>>19500000
   <<***********************************************>>         <<00598>>19502000
                                                               <<00598>>19504000
   FREADDIR(FNSYS,BUFL,IX256,0D);<<READ 2 RECS AT REC# 0>>     <<00598>>19506000
   IF > THEN GO EOF'SYS;   << EOF REACHED ON SYS. FILE >>      <<00598>>19508000
   IF < THEN                                                   <<00598>>19510000
   BEGIN                                                       <<00598>>19512000
    ADDPUBSYS(F'NAME);  << CANCATENATE PUB.SYS >>              <<00598>>19514000
    FERROR(FNSYS,FULLNAME);<< DUMP FILE ID. >>                 <<00598>>19516000
   END; << END: CC LESS THAN >>                                <<00598>>19518000
                                                               <<00598>>19520000
   L'SEG'LEN:=0;  << INITIALIZE SEG.LEN COUNT >>               <<00598>>19522000
   DCKSUM:=0D;    << INITIALIZE CHECKSUM VALUE >>              <<00598>>19524000
                                                               <<00598>>19526000
   NSEG'SUM:=BUFL(INDX1);<<# OF SEGS. IN PROG. FILE>>          <<00598>>19528000
   SADDR:=BUFL(INDX4);   <<STARTING CODE SEG. ADDR.>>          <<00598>>19530000
   II:=-1;           <<INITIALIZE SEG. COUNTER >>              <<00598>>19532000
   WHILE (II:=II+1) < INTEGER(NSEG'SUM) DO                     <<00598>>19534000
   BEGIN                                                       <<00598>>19536000
    SEG'LEN:=BUFL(INDX28+(NSEG'SUM+1)&LSR(1)+                  <<00598>>19538000
                 LOGICAL(II)).(2:14);                          <<00598>>19540000
    S'REC:=LOGICAL(SEG'LEN+INDX127)&LSR(7);<<# OF RECS>>       <<00598>>19542000
    NS'SUM:=S'REC;  << SAVE # OF RECORDS >>                    <<00598>>19544000
    FREADDIR(FNSYS,BUFL(INDX256),IX128,DOUBLE(SADDR)+          <<00598>>19546000
             DOUBLE(S'REC-1)); <<READ REC INCL.STT>>           <<00598>>19548000
    IF > THEN GO EOF'SYS; <<EOF REACHED ON SYS PROG.FILE>>     <<00598>>19550000
    IF < THEN                                                  <<00598>>19552000
     BEGIN                                                     <<00598>>19554000
      ADDPUBSYS(F'NAME); <<CANCATENATE PUB.SYS>>               <<00598>>19556000
      FERROR(FNSYS,FULLNAME);<< DUMP FILE ID. >>               <<00598>>19558000
     END; <<END: CC LESS THAN >>                               <<00598>>19560000
                                                               <<00598>>19562000
   STT'NUM:=LOGICAL(SEG'LEN)-(S'REC-1)&LSL(7)-1;<<LEN.ELE>>    <<00598>>19564000
   SEG'LEN:=LOGICAL(SEG'LEN)-BUFL(STT'NUM+INDX256).(8:8)-1;    <<00598>>19566000
   TOS:=L'SEG'LEN;  << LOAD ACCUMULATIVE SEG. LENGTH >>        <<00598>>19568000
   TOS:=SEG'LEN;    << LOAD COMPUTED SEG. LENGTH >>            <<00598>>19570000
   ASSEMBLE ( LADD ); << DO A LOGICALL ADD >>                  <<00598>>19572000
   L'SEG'LEN:=TOS;  << SAVE ACCUMULATIVE SEG. LENGTH >>        <<00598>>19574000
   SL'WD:=0;  << INITIALIZE CODE WORD COUNTER >>               <<00598>>19576000
   S'REC:=LOGICAL(SEG'LEN+INDX127)&LSR(7); << # OF RECORDS >>  <<00598>>19578000
   REC'CNT:=-1; << INITIALIZE RECORD COUNT >>                  <<00598>>19580000
   WHILE (REC'CNT:=REC'CNT+1) < INTEGER(S'REC) DO              <<00598>>19582000
   BEGIN                                                       <<00598>>19584000
    FREADDIR(FNSYS,BUFL(INDX256),IX128,DOUBLE(SADDR)+          <<00598>>19586000
             DOUBLE(REC'CNT)); << READ CODE SEG. RECORD >>     <<00598>>19588000
    IF > THEN GO EOF'SYS; <<REACHED EOF ON SYS. FILE>>         <<00598>>19590000
    IF < THEN                                                  <<00598>>19592000
     BEGIN                                                     <<00598>>19594000
      ADDPUBSYS(F'NAME); <<CANCATENATE PUB.SYS>>               <<00598>>19596000
      FERROR(FNSYS,FULLNAME); <<DUMP FILE ID.>>                <<00598>>19598000
     END;                                                      <<00598>>19600000
    JJ:=INDX256; <<INITIALIZE INDEX VALUE>>                    <<00598>>19602000
    DO                                                         <<00598>>19604000
     BEGIN                                                     <<00598>>19606000
      DCKSUM:=DCKSUM+DOUBLE(BUFL(JJ)); <<GEN.CHECKSUM>>        <<00598>>19608000
      TOS:=0;                                                  <<00598>>19610000
      TOS:=CKSUM;                                              <<00598>>19612000
      TOS:=CKSUM(1);                                           <<00598>>19614000
      ASSEMBLE ( OR );                                         <<00598>>19616000
      DCKSUM:=TOS;                                             <<00598>>19618000
      IF (SL'WD:=SL'WD+1) = SEG'LEN THEN GO SYS'REC;           <<00598>>19620000
     END                                                       <<00598>>19622000
    UNTIL (JJ:=JJ+1) = INDX384;    <<ENTIRE RECORD>>           <<00598>>19624000
   END;  << END: WHILE REC'CNT >>                              <<00598>>19626000
SYS'REC:                                                       <<00598>>19628000
   SADDR:=SADDR + NS'SUM; <<COMPUTES NEXT STARTING REC>>       <<00598>>19630000
                          <<ADDRESS.                  >>       <<00598>>19632000
                                                               <<00598>>19634000
  END;  << END: WHILE II-SEGMENT COUNTER >>                    <<00598>>19636000
  <<**********************************************>>           <<00598>>19638000
  <<**********************************************>>           <<00598>>19640000
  <<**** WRITE OUT FILENAME,SEGMENT LENGTH, AND **>>           <<00598>>19642000
  <<**** CHECKSUM.                              **>>           <<00598>>19644000
  <<**********************************************>>           <<00598>>19646000
  <<**********************************************>>           <<00598>>19648000
                                                               <<00598>>19650000
  MOVE BBUF:=" ";                                              <<00598>>19652000
  MOVE BBUF(1):=BBUF,(IX255);     <<BLANK O/P BUFFER>>         <<00598>>19654000
  MOVE BBUF:=F'NAME WHILE AN;<<MOVE SYS.FILE NAME>>            <<00598>>19656000
  ASCII(L'SEG'LEN,8,BBUF(INDX25)); << DUMP SEG. LENGTH >>      <<00598>>19658000
  ASCII(LOGICAL(CKSUM(1)),8,BBUF(INDX35));<<CKSUM>>            <<00598>>19660000
                                                               <<00598>>19662000
  FWRITE(CHEKFNUM,BUFL(INDX384),IX128,0);<<WRITE RECORD>>      <<00598>>19664000
  IF <> THEN                                                   <<00598>>19666000
   BEGIN                                                       <<00598>>19668000
    ADDPUBSYS(CHEKFILE); <<CAN PUB.SYS>>                       <<00598>>19670000
    FERROR(CHEKFNUM,FULLNAME); <<DUMP FILE ID.>>               <<00598>>19672000
   END;                                                        <<00598>>19674000
                                                               <<00598>>19676000
EOF'SYS:                                                       <<00598>>19678000
   FUNLOCK(FNSYS); << UNLOCK SYS. FILE >>                      <<00598>>19680000
   IF <> THEN                                                  <<00598>>19682000
    BEGIN                                                      <<00598>>19684000
     ADDPUBSYS(F'NAME); <<CAN PUB.SYS>>                        <<00598>>19686000
     FERROR(FNSYS,FULLNAME); <<DUMP FILE ID.>>                 <<00598>>19688000
    END;                                                       <<00598>>19690000
F'CLOSE:                                                       <<00598>>19692000
   FCLOSE(FNSYS,0,0); <<CLOSE SYS. FILE>>                      <<00598>>19694000
   IF <> THEN                                                  <<00598>>19696000
    BEGIN                                                      <<00598>>19698000
     ADDPUBSYS(F'NAME);                                        <<00598>>19700000
     FERROR(FNSYS,FULLNAME);                                   <<00598>>19702000
    END;                                                       <<00598>>19704000
EXT1':                                                         <<00598>>19706000
 END;  << END: WHILE BYBUF <> SPACE >>                         <<00598>>19708000
                                                               <<00598>>19710000
EOF'SCR:                                                       <<00598>>19712000
   FCLOSE(FNSCR,P'FILE,0); << PURGE SCRATCH FILE >>            <<00598>>19714000
   IF <> THEN                                                  <<00598>>19716000
   BEGIN                                                       <<00598>>19718000
    ADDPUBSYS(D'); << CAN PUB.SYS >>                           <<00598>>19720000
    FERROR(FNSCR,FULLNAME); <<DUMP FILE ID.>>                  <<00598>>19722000
   END;                                                        <<00598>>19724000
                                                               <<00598>>19726000
   FCLOSE(CHEKFNUM,1,1); << CLOSE MPECHECK FILE >>             <<00598>>19728000
   IF <> THEN                                                  <<00598>>19730000
    BEGIN                                                      <<00598>>19732000
     ADDPUBSYS(CHEKFILE);                                      <<00598>>19734000
     FERROR(CHEKFNUM,FULLNAME);                                <<00598>>19736000
    END;                                                       <<00598>>19738000
                                                               <<00598>>19740000
 END;  <<END: MPECHECK FILE NON-EXISTENT>>                     <<00598>>19742000
EXT':                                                          <<00598>>19744000
     END;                                                      <<01073>>19746000
$PAGE "             PROCESS THE DUMP DATE"                     <<01073>>19748000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>19750000
     LOGICAL PROCEDURE GETDUMPDATE;                            <<01073>>19752000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>19754000
     BEGIN                                                     <<01073>>19756000
     BYTE ARRAY                                                <<04659>>19758000
         SAVE'DATE' (0:DUMP'DATE'LEN-1);    <<MM/DD/YY>>       <<04659>>19760000
                                                               <<04659>>19762000
     INTEGER                                                   <<04659>>19764000
         MM       := 0,       <<Month: 1..12>>                 <<04659>>19766000
         DD       := 0,       <<day:   1..28/29/30/31>>        <<04659>>19768000
         YY       := 0;       <<Year:  1..99>>                 <<04659>>19770000
                                                               <<04659>>19772000
     BYTE POINTER                                              <<04659>>19774000
         PDATE';              <<points along SAVE'DATE'>>      <<04659>>19776000
                                                               <<04659>>19778000
         GETDUMPDATE := TRUE;                                  <<01073>>19780000
  REQDATE':                                                    <<00598>>19782000
          DUMPDATE := -1;                                               19784000
          MESSAGE(-74);    <<ENTER DUMP DATE>>                          19786000
          READINPUT;                                                    19788000
          DUMPDATE := INVAL(@DATERR,"/"); <<MONTH,0 OR CARRIAGE RETURN>>19790000
          IF = THEN                                                     19792000
            BEGIN  <<CARRIAGE RETURN INPUT>>                            19794000
              DUMPDATE := -1; <<DUMP NO FILES>>                         19796000
              GETDUMPDATE := FALSE;                            <<01073>>19798000
              RETURN;                                          <<01073>>19800000
            END;                                                        19802000
          IF > THEN IF DUMPDATE<>0 THEN                                 19804000
            BEGIN  <<ERROR - FOLLOWED BY CR>>                           19806000
  DATERR:     MESSAGE(1);                                               19808000
              GO TO REQDATE';                                  <<01073>>19810000
            END                                                         19812000
          ELSE RETURN;      <<0 -- DUMP ALL FILES>>            <<01073>>19814000
          IF NOT (1<=DUMPDATE<=12) THEN GO DATERR; <<ILL. MONTH>>       19816000
          MM:=DUMPDATE;                <<save the month>>      <<04659>>19818000
          M := DUMPDATE-1;                                              19820000
          N := INVAL(@DATERR,"/");  <<GET DAY>>                         19822000
          IF >= THEN GOTO DATERR;                                       19824000
          DD:=N;                       <<save the day>>        <<04659>>19826000
          I := INVAL(@DATERR,"/");                                      19828000
          IF <= THEN GOTO DATERR;  <<NOT FOLLOWED BY CR>>               19830000
          YY:=I;                       <<save the year>>       <<04659>>19832000
          IF NOT (1<=I<=99) THEN GO DATERR; <<BAD YEAR>>                19834000
          TOS := 1;                                                     19836000
          TOS := DAYINMONTH(M);  <<# OF DAYS IN MONTH>>                 19838000
          IF (M=1) AND (I MOD 4)=0 THEN TOS := TOS+1;  <<LEAP YEAR>>    19840000
          X := N;                                                       19842000
          ASSEMBLE(CPRB OKDAY);  <<CHECK FOR DAY CORRECT>>              19844000
          GOTO DATERR;                                                  19846000
  OKDAY:  TOS := N+FIRSTDAY(M);  <<DAY IN YEAR>>                        19848000
          IF ( I MOD 4 = 0) AND (M>1) THEN TOS := TOS+1;  <<LEAP YEAR>> 19850000
          TOS.(0:7) := I;  <<YEAR>>                                     19852000
          DUMPDATE := TOS;                                              19854000
                                                               <<04659>>19856000
                <<build "MM/DD/YY" in SAVE'DATE'...>>          <<04659>>19858000
                                                               <<04659>>19860000
         FILL' (SAVE'DATE', DUMP'DATE'LEN, " ");               <<04659>>19862000
                                                               <<04659>>19864000
          @PDATE':=@SAVE'DATE';                                <<04659>>19866000
          @PDATE':=@PDATE'+ASCII (MM, 10, PDATE');             <<04659>>19868000
          PDATE':="/";                                         <<04659>>19870000
          @PDATE':=@PDATE'(1);                                 <<04659>>19872000
          @PDATE':=@PDATE'+ASCII (DD, 10, PDATE');             <<04659>>19874000
          PDATE':="/";                                         <<04659>>19876000
          @PDATE':=@PDATE'(1);                                 <<04659>>19878000
          @PDATE':=@PDATE'+ASCII (YY, 10, PDATE');             <<04659>>19880000
          PDATE':=" ";                                         <<04659>>19882000
                                                               <<04659>>19884000
          MOVE DUMP'DATE':=SAVE'DATE', (DUMP'DATE'LEN);        <<04659>>19886000
                                                               <<04659>>19888000
     END;                                                      <<01073>>19890000
$PAGE "             PROCESS THE DUMP FILE SUBSET(S)"           <<01073>>19892000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>19894000
     PROCEDURE GET'FILE'SUBSET;                                <<01073>>19896000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>19898000
     BEGIN                                                     <<01073>>19900000
        LOGICAL GENERIC, WILD, CONTINUE, SYNTAXERR;            <<01073>>19902000
        INTEGER                                                <<04659>>19904000
           BLINBUFLEN         := 0,                            <<04659>>19906000
           ERRNUM             := 0,                            <<04659>>19908000
           ERR'SUBCLASS       := 0,                            <<04659>>19910000
           FIELD              := 0,                            <<04659>>19912000
           INSIZE             := 0,                            <<04659>>19914000
           NEXT'BYTE          := 0;                            <<04659>>19916000
                                                               <<04659>>19918000
        BYTE POINTER                                           <<04659>>19920000
           PT;                <<scratch pointer>>              <<04659>>19922000
        EQUATE BLINBUFEXT = 128;  <<EXTENSION LENGTH IN WORDS>><<01073>>19924000
REQDL:                                                         <<00777>>19926000
      COMMENT:  ENTER FILE SET NAMES INTO EXPANDABLE ARRAY     <<00778>>19928000
              BLINBUF.  EXPANSION IS IN 126 WORD INCREMENTS    <<00778>>19930000
              UNTIL THE DL AREA IS USED UP (THEN SYSDUMP GO    <<00778>>19932000
              BYE BYE).  THIS SECTION OF CODE EXPECTS BLINBUF  <<00778>>19934000
              TO NOT BE IN USE AND ITS LENGTH IS ZERO WORDS;   <<00778>>19936000
          MESSAGE(167);  <<ENTER DUMP FILE SUBSET(S)>>         <<00777>>19938000
          SYNTAXERR:=FALSE;                                    <<00777>>19940000
          BLINBUFLEN:=0;                                       <<00778>>19942000
          NEXT'BYTE:=0;                                        <<00778>>19944000
          DO BEGIN                                             <<00777>>19946000
            READINPUT;                                         <<00777>>19948000
            SCAN BPINBUF UNTIL %6446,1;  <<cr,&>>              <<00777>>19950000
            IF CARRY THEN CONTINUE:=FALSE                      <<00777>>19952000
            ELSE                                               <<00777>>19954000
              BEGIN                                            <<00777>>19956000
              CONTINUE:=TRUE;                                  <<00777>>19958000
              IF LOGICAL(MODE) THEN MESSAGE(183);              <<00778>>19960000
              END;                                             <<00777>>19962000
            INSIZE:=TOS - @BPINBUF + 1;                        <<00778>>19964000
            IF NEXT'BYTE + INSIZE >= BLINBUFLEN THEN           <<00778>>19966000
              BEGIN                                            <<00778>>19968000
              BLINBUFINCR:=BLINBUFEXT;                         <<00778>>19970000
              MOVEDLTABLES;                                    <<00778>>19972000
              BLINBUFLEN:=BLINBUFLEN + BLINBUFEXT * 2;         <<00778>>19974000
              END;                                             <<00778>>19976000
            TOS:=@BLINBUF + NEXT'BYTE;                         <<00778>>19978000
            MOVE * := BPINBUF, (INSIZE),2;                     <<00778>>19980000
            NEXT'BYTE:=TOS - @BLINBUF - 1;                     <<00778>>19982000
            END UNTIL NOT CONTINUE;                            <<00778>>19984000
                                                               <<00777>>19986000
          SCAN BLINBUF WHILE " ", 1;                           <<04659>>19990000
          @PT:=TOS;           <<first non-blank>>              <<04659>>19992000
          IF PT = CR THEN     <<is it the end of the buffer?>> <<04659>>19994000
             MOVE BLINBUF:=("@.@.@", CR);         <<yep>>      <<04659>>19996000
                                                               <<04659>>19998000
          SCAN BLINBUF UNTIL CR, 1;    <<find end of buffer>>  <<04659>>20000000
          INSIZE:=TOS-@BLINBUF;        <<length scanned>>      <<04659>>20002000
                                                               <<04659>>20004000
          IF INSIZE > STORE'FILES'LEN THEN                     <<04659>>20006000
             BEGIN                                             <<04659>>20008000
             MESSAGE (1001);        <<file subset too large>>  <<04659>>20010000
             GO REQDL;                                         <<04659>>20012000
             END;                                              <<04659>>20014000
                                                               <<04659>>20016000
          MOVE STORE'FILES':=BLINBUF, (INSIZE), 2;             <<04659>>20018000
          MOVE *:=(CR);                                        <<04659>>20020000
                                                               <<04659>>20022000
                                                               <<04659>>20024000
                                                               <<04659>>20026000
                <<check for valid syntax..>>                   <<04659>>20028000
                                                               <<04659>>20030000
          STORE'USER'FILES (0,         <<tape file#>>          <<04659>>20032000
                            FALSE,     <<SHOW flag>>           <<04659>>20034000
                            TRUE,      <<syntax only>>         <<04659>>20036000
                            ERRNUM, ERR'SUBCLASS);             <<04659>>20038000
                                                               <<04659>>20040000
          IF ERRNUM = S'ERR'SYNTAX THEN                        <<04659>>20042000
             BEGIN                                             <<04659>>20044000
             MESSAGE (1002);        <<syntax error in STORE>>  <<04659>>20046000
             GO REQDL;                                         <<04659>>20048000
             END;                                              <<04659>>20050000
                                                               <<00777>>20052000
     END;                                                      <<01073>>20054000
$PAGE "             CREATE THE DUMP TAPE"                      <<01073>>20056000
$CONTROL SEGMENT=DUMPTAPE                                      <<01073>>20058000
     PROCEDURE DUMPTAPE(SHOW);                                 <<01073>>20060000
     VALUE SHOW;                                               <<01073>>20062000
     LOGICAL SHOW;                                             <<01073>>20064000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>20066000
     BEGIN                                                     <<01073>>20068000
INTEGER ERR'SUBCLASS;                                          <<04659>>20070000
        EQUATE SDISC=31;                                       <<01073>>20072000
BYTE ARRAY SNDOPENDEV(0:3);                                    <<01073>>20074000
INTEGER                                                        <<02567>>20078000
   SYSTAPE := 0,                                               <<02567>>20080000
   MAX'RECSIZE,     << Maximum record size for device >>       <<02567>>20082000
   DENSITY,         << Tape density >>                         <<02567>>20084000
   ERRNUM;                                                     <<02567>>20086000
DOUBLE                                                         <<03604>>20088000
   INITDL,          <<Configurator DL>>                        <<03604>>20090000
   INITDB,          <<Configurator DB>>                        <<03604>>20092000
   INITPB,          <<Configurator PB>>                        <<03604>>20094000
   SVALUE,          <<Initial SVALUE>>                         <<03604>>20096000
   ZVALUE,          <<Initial ZVALUE>>                         <<03604>>20098000
   ININBASE;        <<Start of internal interrupts>>           <<03604>>20100000
LOGICAL                                                        <<02567>>20102000
   LDIRC,                                                      <<DE>>   20104000
   FSTORE'FLAG;     << Flag for 6250 BPI default case >>       <<02567>>20106000
EQUATE                                                         <<02567>>20108000
   XRETPMASKFAIL = 1063;   << CI error message >>              <<02567>>20110000
DOUBLE  SIOADR;                                                <<03604>>20112000
INTEGER SIOADR1=SIOADR,                                        <<03604>>20114000
        SIOADR2=SIOADR+1;                                      <<03604>>20116000
DOUBLE  ARRAY COREADR(0:31);   <<INIT segment core adresses>>  <<03604>>20118000
INTEGER ARRAY DEFAULTS(0:287)=PB:=                             <<03701>>20120000
 <<64K,80K,96K,128K,160K,192K,224K,256K>>                      <<01073>>20122000
   192,192,192,192 , 192, 192, 192, 192,        <<CST    0>>   <<01073>>20124000
   200,200,200,200 , 200, 200, 200, 200,        <<DST    1>>   <<01073>>20126000
    48, 48, 48, 48 ,  48,  48,  48,  48,        <<PCB    2>>   <<01073>>20128000
    48, 48, 48, 48 ,  48,  48,  48,  48,        <<I/O Q  3>>   <<01073>>20130000
     3,  3,  3,  3 ,   3,   3,   3,   3,        <<TBUFS  4>>   <<03007>>20132000
   200,200,200,200 , 200, 200, 200, 200,        <<CSTX   5>>   <<01073>>20134000
   512,512,512,512 , 512, 512, 512, 512,        <<ICS    6>>   <<01073>>20136000
    32, 32, 32, 32 ,  32,  32,  32,  32,        <<UCRQ   7>>   <<01073>>20138000
    32, 32, 32, 32 ,  32,  32,  32,  32,        <<BRKPT  8>>   <<01073>>20140000
    32, 32, 32, 32 ,  32,  32,  32,  32,        <<TRL    9>>   <<01073>>20142000
    48, 48, 48, 48 ,  48,  48,  48,  48,        <<RINS  10>>   <<01073>>20144000
    16, 16, 16, 16 ,  16,  16,  16,  16,        <<GRINS 11>>   <<01073>>20146000
     8,  8,  8,  8 ,   8,   8,   8,   8,        <<SBUFS 12>>   <<01073>>20148000
    24, 24, 24, 24 ,  24,  24,  24,  24,        <<CONCP 13>>   <<01073>>20150000
   192,192,192,192 , 192, 192, 192, 192,        <<MAM   14>>   <<01073>>20152000
     0,  0,  0,  0 ,   0,   0,   0,   0, << (15) TYPE-AHEAD >> <<03702>>20154000
                                         <<BUFFER SIZE--FOR >> <<03702>>20156000
                                         <<    FUTURE USE   >> <<03702>>20158000
     0,  0,  0,  0 ,   0,   0,   0,   0,        <<NU    16>>   <<01073>>20160000
     0,  0,  0,  0 ,   0,   0,   0,   0,        <<NU    17>>   <<01073>>20162000
     0,  0,  0,  0 ,   0,   0,   0,   0,        <<NU    18>>   <<01073>>20164000
     0,  0,  0,  0 ,   0,   0,   0,   0,        <<NU    19>>   <<01073>>20166000
  5120,5120,5120,5120,5120,5120,5120,5120,      <<VM    20>>   <<01073>>20168000
 1536,1536,1536,1536,1536,1536,1536,1536,      <<DIRC  21>>    <<01073>>20170000
  8192,8192,8192,8192,8192,8192,8192,8192,      <<MCSS  30>>   <<01073>>20172000
    63, 63, 63, 63 ,  63,  63,  63,  63,        <<MCSP  31>>   <<01073>>20174000
  31232,31232,31232,31232,31232,31232,31232,31232,<<MSTK32>>   <<01073>>20176000
  8192,8192,8192,8192,8192,8192,8192,8192,      <<MXDSS 33>>   <<01073>>20178000
     4,  4,  4,  4 ,   4,   4,   4,   4,        <<MXDSP 34>>   <<01073>>20180000
    16, 16, 16, 16 ,  16,  16,  16,  16,        <<MSES  40>>   <<01073>>20182000
    2,  2,  2,  2,  2,  2,  2,  2,    <<MJOB>>                 <<01073>>20184000
                                                               <<01073>>20186000
    3,  3,  3,  3,  3,  3,  3,  3,   <<LOGPROCS>>              <<03701>>20188000
   10, 10, 10, 10,  10, 10, 10, 10,  <<USERS/PROC>>            <<03701>>20190000
  128,128,128,128, 128,128,128,128,  <<DISC REQ>>              <<03701>>20192000
   64, 64, 64, 64,  64, 64, 64, 64,  <<SPECIAL REQ>>           <<03701>>20194000
   25, 25, 25, 25,  25, 25, 25, 25,  <<PRIMARY MSG TABLE>>     <<03701>>20196000
  384,384,384,384, 384,384,384,384,  <<SWAP TABLE>>            <<03701>>20198000
   25, 25, 25, 25,  25, 25, 25, 25;  <<SECONDARY MSG TABLE>>   <<03701>>20200000
   INTEGER ARRAY CMD'TAB(0:149);                               <<02509>>20202000
   INTEGER ARRAY TAPE'FMT'TAB(0:299);                          <<03604>>20204000
   INTEGER POINTER                                             <<02509>>20206000
      PNTR,                                                    <<02509>>20208000
      CTPNTR;                                                  <<02509>>20210000
   DEFINE                                                      <<02509>>20212000
      ENTRY'SIZE = TAPE'FMT'TAB.(0:8)#,                        <<02509>>20214000
      ENTRIES = TAPE'FMT'TAB.(8:8)#,                           <<02509>>20216000
      LENGTH = PNTR#,                                          <<02509>>20218000
      COREADR1 = PNTR(1)#,                                     <<02509>>20220000
      COREADR2 = PNTR(2)#,                                     <<02509>>20222000
      DISCADR1 = PNTR(3)#,                                     <<02509>>20224000
      DISCADR2 = PNTR(4)#;                                     <<02509>>20226000
   DEFINE                                                      <<02509>>20228000
      FNUM                = CMD'TAB#,                          <<02509>>20230000
      NEXT'REC            = CMD'TAB(1)#,                       <<02509>>20232000
      REC'BEFORE'INITIAL  = CMD'TAB(2)#,                       <<02509>>20234000
      NRENT'AFTER'WCS     = CMD'TAB(3)#,                       <<02509>>20236000
      NRENT'BEFORE'WCS    = CMD'TAB(4)#,                       <<02509>>20238000
      AMIGO'REC'1         = CMD'TAB(5)#,                       <<02509>>20240000
      AMIGO'REC'2         = CMD'TAB(6)#,                       <<02509>>20242000
      WCS'REC'BEFORE'INIT = CMD'TAB(7)#,                       <<02509>>20244000
      SIO'REC'BEFORE'INIT = CMD'TAB(8)#,                       <<02509>>20246000
      AMIGO'REC'BEFORE'INIT = CMD'TAB(9)#,                     <<02509>>20248000
      BEG'OF'STACK        = 40#,                               <<02509>>20250000
      REC                 = CTPNTR#,                           <<02509>>20252000
      LEN                 = CTPNTR(1)#;                        <<02509>>20254000
   SUBROUTINE SIOREAD(SIZE);                                   <<02509>>20256000
      VALUE SIZE;                                              <<02509>>20258000
      LOGICAL SIZE;                                            <<03604>>20260000
   BEGIN                                                       <<02509>>20262000
      LENGTH := SIZE;                                          <<02509>>20264000
      COREADR1 := SIOADR1;   << BANK >>                        <<03604>>20266000
      COREADR2 := SIOADR2;   <<ADDRESS>>                       <<03604>>20268000
      @PNTR := @PNTR(ENTRY'SIZE);                              <<02509>>20270000
      ENTRIES := ENTRIES+1;                                    <<02509>>20272000
      BLOCKN := BLOCKN+1;                                      <<02509>>20274000
      SIOADR := SIOADR+DOUBLE(SIZE);                           <<03604>>20276000
   END;                                                        <<02509>>20278000
  INITDUMP:                                                             20280000
          LDT(X) := LDT(DCSIZE)&LSR(1);                                 20282000
      SYSTAPE:=FOPEN(TAPEFILE,%200,%1,                         <<00425>>20284000
                      4096);                                   <<00425>>20286000
  TAPEERR:IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                         20288000
   FGETINFO(SYSTAPE,,FOPTIONS,AOPTIONS,RECSIZE,DEVTYPE,        <<00425>>20290000
            SDISCLDEV);                                        <<00425>>20292000
          IF <> THEN GOTO TAPEERR;                                      20294000
                                                               <<00425>>20298000
<< FIRST VERIFY THAT TAPE PARAMETERS ARE VALID>>               <<00425>>20300000
                                                               <<00425>>20302000
   IF FOPTIONS.(8:8)<>%200 OR                                  <<00425>>20304000
      (LOGICAL(AOPTIONS) LAND %177377)<>1 OR                   <<00425>>20306000
   DEVTYPE.RBITE<>MAGTAPETYPE AND                              <<00425>>20310000
        DEVTYPE.RBITE<>SDISC THEN                              <<00.SD>>20312000
            BEGIN                                                       20314000
              MESSAGE(87);  <<BAD TAPE OPEN PARMS>>                     20316000
              QUIT(0);                                                  20318000
      END;                                                     <<00425>>20320000
   MAGTAPE := DEVTYPE.RBITE = MAGTAPETYPE;                     <<02509>>20322000
                                                               <<02650>>20324000
<< Because STORE cannot handle it, use of a labelled >>        <<02650>>20326000
<< tape on a remote tape drive is not allowed. >>              <<02650>>20328000
                                                               <<02650>>20330000
   IF MAGTAPE AND FOPTIONS.(6:1)=1 AND  << Labelled mag tape >><<02650>>20332000
     SDISCLDEV.LBITE <> 0 THEN          << and remote device >><<02650>>20334000
      BEGIN                                                    <<02650>>20336000
      MESSAGE(87);                                             <<02650>>20338000
      QUIT(0);                                                 <<02650>>20340000
      END;                                                     <<02650>>20342000
                                                               <<00425>>20344000
<< Now, check out the record size >>                           <<02567>>20346000
                                                               <<02567>>20348000
   IF NOT MAGTAPE THEN                                         <<02567>>20350000
      MAX'RECSIZE := 4096                                      <<02567>>20352000
   ELSE                                                        <<02567>>20354000
      IF NOT GET'TAPE'INFO(SYSTAPE,MAX'RECSIZE,DENSITY)        <<02567>>20356000
         THEN FERROR(SYSTAPE,TAPEFILE);     << No return !! >> <<02567>>20358000
                                                               <<02567>>20360000
   IF NOT (256 <= RECSIZE <= MAX'RECSIZE) OR                   <<02567>>20362000
      (RECSIZE MOD 256) <> 0 THEN                              <<02567>>20364000
      BEGIN                                                    <<02567>>20366000
      MESSAGE(87);                                             <<02567>>20368000
      QUIT(0);                                                 <<02567>>20370000
      END;                                                     <<02567>>20372000
                                                               <<02567>>20374000
<< NOW SEE IF WE HAVE TO USE A SECOND TAPE TO WRITE THE   >>   <<00425>>20376000
<< SYSTEM PORTION OF THE SYSDUMP TAPE.  THE CRITERIA ARE: >>   <<00425>>20378000
<<     1) RECSIZE<1024                                    >>   <<00425>>20380000
<<     2) DEVICE TYPE=SERIAL DISC AND BUF I/O SPECIFIED   >>   <<00425>>20382000
<<                                                        >>   <<00425>>20384000
<< IF EITHER OF THESE CRITERIA ARE MET, THEN THE DUMP     >>   <<00425>>20386000
<< IS OPENED A SECOND TIME, WITH THE SAME CHARACTERISTICS >>   <<00425>>20388000
<< AS THE FIRST OPEN, EXCEPT THE RECORD SIZE IS SET TO    >>   <<00425>>20390000
<< 1024 AND IF CRITERIA 2) IS MET, THEN NOBUF I/O IS ALSO >>   <<00425>>20392000
<< SET.                                                   >>   <<00425>>20394000
                                                               <<00425>>20396000
   IF RECSIZE<1024 OR DEVTYPE.RBITE=SDISC AND                  <<00425>>20398000
      AOPTIONS.(7:1)=0 THEN <<GOT TO OPEN AGAIN>>              <<00425>>20400000
   BEGIN                                                       <<00425>>20402000
      SNDOPENDEV(ASCII(SDISCLDEV,10,SNDOPENDEV)):=" ";         <<00425>>20404000
      TAPEFNUM:=FOPEN(TAPEFILE,%2200,                          <<00425>>20406000
          1+(IF DEVTYPE.RBITE=SDISC THEN %400 ELSE             <<00520>>20408000
            LOGICAL(AOPTIONS) LAND %400),                      <<00520>>20410000
               1024,SNDOPENDEV);                               <<00425>>20412000
      IF <> THEN <<COULDN'T OPEN 2ND TIME>>                    <<00425>>20414000
      BEGIN                                                    <<00425>>20416000
         FCLOSE(SYSTAPE,0,0);                                  <<00425>>20418000
         FERROR(TAPEFNUM,TAPEFILE);                            <<00425>>20420000
      END;                                                     <<00425>>20422000
      RECSIZE := 1024;                                         <<04864>>20424000
   END ELSE TAPEFNUM:=SYSTAPE <<SYSTAPE = TAPEFNUM >>;         <<00425>>20426000
                                                               <<00425>>20428000
     IF MAGTAPE THEN                                           <<03604>>20430000
        BEGIN                                                  <<03604>>20432000
        TAPERECSIZE := IF RECSIZE > 4096 THEN 4096 ELSE        <<03604>>20434000
           RECSIZE;                                            <<03604>>20436000
        END                                                    <<03604>>20438000
     ELSE                                                      <<03604>>20440000
        TAPERECSIZE := 1024;  << SERIAL DISC >>                <<03604>>20442000
     ZEROBUF(TAPE'FMT'TAB,300);                                <<03604>>20444000
     ZEROBUF(CMD'TAB,149);                                     <<03604>>20446000
     ENTRY'SIZE := IF MAGTAPE THEN 3 ELSE 5;                   <<02509>>20448000
     BLOCKN := 0;                                              <<02509>>20450000
     @PNTR := @TAPE'FMT'TAB(ENTRY'SIZE);                       <<02509>>20452000
     FNUM := FOPEN(,0,%424);  << OPEN CHAN PGM FILE >>         <<02509>>20454000
     IF <> THEN QUIT(99);                                      <<02509>>20456000
                                                               <<00072>>20458000
          <<--------------------------------------->>          <<00072>>20460000
          <<GET ACTUAL DEVICE TYPE OF OUTPUT DEVICE>>          <<00072>>20462000
          <<--------------------------------------->>          <<00072>>20464000
     MOVEFDS( OUTDEVTYPE, LDTDSTN,      << GET DEVICE TYPE  >> <<03702>>20468000
              SDISCLDEV*LDTSIZE+LDT2,   <<    OF TAPE FILE  >> <<03702>>20470000
              1);                       <<    FROM THE LDT  >> <<03702>>20472000
     OUTDEVTYPE := OUTDEVTYPE.TYP;                             <<03702>>20474000
                                                               <<00072>>20476000
          <<----------------------------->>                    <<00072>>20478000
          <<DETERMINE TYPE OF FLOPPY DISC>>                    <<00072>>20480000
          <<----------------------------->>                    <<00072>>20482000
          IF FLOPPY THEN                                       <<00072>>20484000
             BEGIN                                             <<00072>>20486000
             TOS:=ATTACHIO(SDISCLDEV,0,0,@LBUF,REQSTAT,        <<00072>>20488000
             2,0,0,%41);                                       <<00072>>20490000
             IOERRCHECK(*,*);                                  <<00072>>20492000
             FLOP'SEC'CYL:=IF DOUBLESIDED THEN 60 ELSE 30;     <<00072>>20494000
             END;                                              <<00072>>20496000
                                                                        20498000
          <<------------------------                                    20500000
            SET UP INITIAL PROGRAM                                      20502000
          ------------------------>>                                    20504000
          SEARCH'SYSFILE( INITFILE);                           <<02509>>20508000
          INITFNUM := FOPEN(FULLNAME,%(2)10000000011,                   20510000
            %(2)11110100);                                              20512000
  INITERR:IF <> THEN FERROR(INITFNUM,INITFILE);                         20514000
          FLOCK(INITFNUM,TRUE);                                         20516000
          IF <> THEN GOTO INITERR;                                      20518000
          FREAD(INITFNUM,REC0,128);  <<INIT RECORD 0>>                  20520000
          IF <> THEN GOTO INITERR;                                      20522000
          NSEG := REC0(1);   <<# OF SEGMENTS>>                          20524000
          K := 28+(NSEG+1)&LSR(1);  <<INDEX TO DESCRIPTORS>>            20526000
          FIRSTCST := 1;    <<FIRST ENTRY USED BY INIT>>       <<03604>>20528000
          I := 0;                                                       20530000
          MAXINITSEG := 0;                                              20532000
          TOS := REC0(4);  <<FIRST SEGMENT RECORD #>>                   20534000
          DO                                                            20536000
            BEGIN    <<SCAN SEGMENT DESCRIPTORS>>                       20538000
              SEGADR(I) := S0;   <<SEGMENT RECORD #>>                   20540000
              TOS := REC0(X:=X+K).(2:14);   <<SEGMENT SIZE>>            20542000
              ASSEMBLE(DUP,DUP);                                        20544000
              SEGSIZE(I) := TOS;                                        20546000
              IF (TOS>MAXINITSEG) AND (I>=NNONSWAPSEG) THEN    <<03604>>20548000
                MAXINITSEG := S0;                                       20550000
              TOS := (TOS+127)&LSR(7);                                  20552000
              ASSEMBLE(ADD);                                            20554000
              TOS := SEGSIZE(X);                                        20556000
              TOS := 128;                                               20558000
              ASSEMBLE(DECB,DIV);                                       20560000
              STTINDEX := TOS+256;  <<INDEX TO PL IN BUFFER>>           20562000
              STTREC := TOS-2+SEGADR(I);                                20564000
              FREADDIR(INITFNUM,STT,384,DOUBLE(STTREC));  <<READ STT>>  20566000
              IF <> THEN GOTO INITERR;                                  20568000
              N := -(STT(STTINDEX).(8:8));  <<# OF ENTRIES IN STT>>     20570000
              L := 0;                                                   20572000
              WHILE (L:=L-1) >= N DO                                    20574000
                BEGIN  <<FIX UP INTRA PROGRAM REFERENCES>>              20576000
                  TOS := STT(STTINDEX+L);                               20578000
                  IF >= THEN GOTO SETLAB;  <<INTERNAL LABEL>>           20580000
                  OLDCST := S0.(8:8);                                   20582000
                  M := 0;                                               20584000
                  DO IF INTEGER(BREC0(56+M))=OLDCST THEN                20586000
                    BEGIN   <<FOUND REFERENCED SEGMENT>>                20588000
                      TOS.(8:8) := FIRSTCST+M;                          20590000
                      GOTO SETLAB;                                      20592000
                    END                                                 20594000
                  UNTIL (M:=M+1) = NSEG;                                20596000
                  DEL;                                                  20598000
                  TOS := -1;                                            20600000
  SETLAB:         STT(STTINDEX+L) := TOS;  <<RESET LABEL>>              20602000
                END;                                                    20604000
              FWRITEDIR(INITFNUM,STT,384,DOUBLE(STTREC));               20606000
              IF <> THEN GOTO INITERR;                                  20608000
            END                                                         20610000
          UNTIL (I:=I+1) = NSEG;                                        20612000
          I := 0;   <<RESET CST REMAPPING ARRAY>>                       20614000
          DO BREC0(56+I) := FIRSTCST+I UNTIL (I:=I+1)=NSEG;             20616000
          FWRITEDIR(INITFNUM,REC0,128,0D);                              20618000
          IF <> THEN GOTO INITERR;                                      20620000
          FREADDIR(INITFNUM,LBUF,128,D'L(REC0(8)))); <<ENTRY PT LIST>>  20622000
          IF <> THEN GOTO INITERR;                                      20624000
          INDEX := 0;                                                   20626000
  NEXTENTRY:                                                            20628000
          TOS := LBUF(INDEX).(4:4);   <<# OF CHARACTERS>>               20630000
          IF = THEN GOTO ENTRYDONE;                                     20632000
          IF S0=8 THEN                                                  20634000
            BEGIN   <<LOOK FOR ENTRY POINTS>>                           20636000
              IF BLBUF(INDEX&LSL(1)+1)=TAPEENTRYNAME,(8) THEN           20638000
                TAPEENTRY := LBUF(INDEX+5);                             20640000
              IF BLBUF(INDEX&LSL(1)+1)=DISCENTRYNAME,(8) THEN           20642000
                DISCENTRY := LBUF(INDEX+5);                             20644000
            END;                                                        20646000
          INDEX := TOS&LSR(1)+3+INDEX;                                  20648000
          GOTO NEXTENTRY;                                               20650000
  ENTRYDONE:                                                            20652000
                                                                        20654000
          TOS := DVCLSIZE&LSR(1);                              <<00185>>20656000
          ASSEMBLE(DUP,DUP);                                   <<00185>>20658000
          DVCLSIZE := TOS;                                     <<00185>>20660000
          LDT(DCSIZE) := TOS;                                  <<00185>>20662000
          CTAB0(DVCLSIZE') := TOS;                             <<00185>>20664000
          I := 1;                                              <<00185>>20666000
          TOS := COREEND;                                      <<00185>>20668000
          DO                                                   <<00185>>20670000
            BEGIN                                              <<00185>>20672000
              TOS := LOGICAL(TOS-SEGSIZE(I-1));                <<03604>>20674000
              COREADR(X) := DS0; <<STARTING SEGMENT ADDRESS>>  <<03604>>20676000
            END                                                <<00185>>20678000
          UNTIL (I:=I+1) > NSTARTSEG;                          <<00185>>20680000
          INITPB := TOS;    <<LOWEST INIT CORE ADDRESS>>       <<03604>>20682000
          TOS := INITZ;     << END OF INITAL'S STACK >>        <<03604>>20684000
          TOS := LOGICAL(TOS-REC0(2)-STACKSIZE-MARKERSIZE)     <<03604>>20686000
                 LAND %177770;                                 <<03604>>20688000
          INITDB := DS0;    <<DB AREA STARTING ADDRESS>>       <<03604>>20690000
          TOS := CSDEFSIZE+CSDVRTSIZE+CTAB0SIZE+               <<03604>>20692000
            CTABTSIZE+DVCLSIZE+(MVOL+1)*VTABSIZE+(HLDEV+1)*    <<00185>>20694000
            (DVRSIZE+LPDTSIZE+LDTSIZE+LDTXSIZE)+CSTAB;         <<00185>>20696000
          IF DUMPDATE<>-1 THEN TOS:=TOS+INFOSIZE+(OLDVTAB.(0:8)+1)*     20698000
            VTABSIZE;    <<ONLY DUMPED IF FILES DUMPED>>       <<00185>>20700000
          TABLESIZE := S0;  <<SIZE OF DL AREA>>                <<00185>>20702000
          ASSEMBLE(SUB);                                       <<00185>>20704000
          CTAB0(CSTABSIZE) := CSTAB;                           <<00185>>20706000
          INITDL:=DS0;                                         <<03604>>20708000
          <<----------------------                                      20712000
            GENERATE SIO PROGRAM                                        20714000
          ---------------------->>                                      20716000
          TOS := HLDEV;                                                 20718000
          ASSEMBLE(DUP,DUP);                                            20720000
          LDT.(0:8) := TOS;                                             20722000
          LPDT.(0:8) := TOS;                                            20724000
          CTAB0(HLDEV') := TOS;                                         20726000
          CTAB0(HVOL') := NVOL;                                <<RH.PV>>20728000
          VTAB.(0:8) := MVOL;                                  <<RH.PV>>20730000
          ZEROBUF(LBUF,384);                                   <<03544>>20732000
          SIOADR := D'L(ICSBASE));                             <<03604>>20736000
          SIOREAD(ICSLEN);                                     <<02509>>20738000
          SIOADR := 0D;                                        <<03604>>20740000
          SIOREAD(A0SIZE);    <<LOW CORE>>                              20742000
          SIOADR := D'L(CSTBASE));                             <<03604>>20744000
          SIOREAD(TCSTSIZE);                                   <<03604>>20746000
          SIOADR:=INITDL;                                      <<00185>>20748000
          SIOREAD(CSTAB);  <<CS DATA SEGMENT>>                          20750000
          SIOREAD((HLDEV+1)*DVRSIZE);  <<DRIVER TABLE>>                 20752000
          SIOREAD((HLDEV+1)*LPDTSIZE); <<LOGICAL PHYSICAL DEVICE TABLE>>20754000
          SIOREAD((HLDEV+1)*LDTSIZE);  <<LOGICAL DEVICE TABLE>>         20756000
          SIOREAD(DVCLSIZE);  <<DEVICE CLASS TABLE>>                    20758000
          SIOREAD((HLDEV+1)*LDTXSIZE); <<LDT EXTENSION>>       <<00.06>>20760000
          SIOREAD((MVOL+1)*VTABSIZE);  <<VOLUME TABLE>>        <<RH.PV>>20762000
          IF DUMPDATE<>-1 THEN                                          20764000
            BEGIN                                                       20766000
              TOS := (OLDVTAB.(0:8)+1)*VTABSIZE;                        20768000
              CTAB0(OLDVTABSIZE) := S0;                                 20770000
              SIOREAD(*);  <<OLD VOLUME TABLE>>                         20772000
              SIOREAD(INFOSIZE);  <<COLD LOAD INFORMATION TABLE>>       20774000
              CTAB0(OLDINFOSIZE) := INFOSIZE;                           20776000
            END                                                         20778000
          ELSE                                                          20780000
            BEGIN  <<THESE TABLES NOT DUMPED>>                          20782000
              CTAB0(OLDVTABSIZE) := 0;                                  20784000
              CTAB0(OLDINFOSIZE) := 0;                                  20786000
            END;                                                        20788000
          SIOREAD(CTABTSIZE); <<CONFIGURATION TABLES>>                  20790000
          SIOREAD(CTAB0SIZE); <<NON-CORESIZE RELATED CONFIGURATION>>    20792000
          SIOREAD(CSDVRTSIZE);                                          20794000
          SIOREAD(CSDEFSIZE);                                           20796000
          SIOADR := INITDB;                                             20800000
          SIOREAD(REC0(2));  <<INITIAL'S DB AREA>>                      20802000
          SIOREAD(MARKERSIZE);   <<INIT STACK MARKER>>                  20804000
          SVALUE := SIOADR-1D;                                 <<03604>>20808000
          ZVALUE := SIOADR+DOUBLE(STACKSIZE)-16D;              <<03604>>20810000
          TCST := 0;                                                    20812000
          MOVE TCST(1) := TCST,(TCSTSIZE-1);                            20814000
          TCST := NCST-1;                                               20816000
          TCST(1) := 4;                                                 20818000
          J := 1;                                                       20820000
          DO BEGIN                                             <<03604>>20824000
             I := J-1;                                         <<03604>>20826000
             TOS := SEGSIZE(I)&LSR(2);                         <<03604>>20828000
             ASSEMBLE(TSBC 1); << PRIV MODE >>                 <<03604>>20830000
             IF J <= NSTARTSEG THEN                            <<03604>>20832000
                BEGIN << SEGMENT STARTS OUT IN CORE >>         <<03604>>20834000
                SIOADR := COREADR(I);                          <<03604>>20836000
                DTCST(J&LSL(1)+1) := COREADR(I);               <<03604>>20838000
                SIOREAD(SEGSIZE(I)); << SIO ENTRY >>           <<03604>>20840000
                END                                            <<03604>>20842000
             ELSE                                              <<03604>>20844000
                ASSEMBLE( TSBC 0 ); << ABSENT >>               <<03604>>20846000
             TCST(J&LSL(2)) := TOS; << LEN OF SEGMENT >>       <<03604>>20848000
             END UNTIL (J:=J+1) > NSEG;                        <<03604>>20850000
          IF MAGTAPE THEN                                      <<02509>>20854000
             BEGIN <<TAPE>>                                    <<00072>>20856000
             IF CLTAPE'SIO THEN                                <<02509>>20860000
                BUILD'SIO(TAPE'FMT'TAB,CMD'TAB);               <<02509>>20862000
             IF CLTAPE'AMIGO THEN                              <<02509>>20864000
                BUILD'AMIGO(TAPE'FMT'TAB,CMD'TAB);             <<02509>>20866000
             REC'BEFORE'INITIAL := REC'BEFORE'INITIAL+COMPUTE'WCS'SIZE; 20868000
             WCS'REC'BEFORE'INIT := REC'BEFORE'INITIAL;        <<02509>>20870000
             IF CLTAPE'AMIGO THEN                              <<02509>>20872000
                BUILD'AMIGO'SKIP(TAPE'FMT'TAB,CMD'TAB);        <<02509>>20874000
             IF CLTAPE'SIO THEN                                <<02509>>20876000
                BUILD'SIO'SKIP(TAPE'FMT'TAB,CMD'TAB);          <<02509>>20878000
                                                               <<02509>>20880000
             @CTPNTR := @CMD'TAB(BEG'OF'STACK                  <<02509>>20882000
                +(NRENT'BEFORE'WCS+NRENT'AFTER'WCS)*2);        <<02509>>20884000
             TOS := NRENT'BEFORE'WCS;                          <<02509>>20886000
             WHILE <> DO                                       <<02509>>20888000
                BEGIN                                          <<02509>>20890000
                @CTPNTR := @CTPNTR(-2);                        <<02509>>20892000
                FREADDIR(FNUM,LBUF,LEN,DOUBLE(REC));           <<02509>>20894000
                WRITETAPE(LBUF,LEN,1);                         <<02509>>20896000
                TOS:=TOS-1;                                    <<02509>>20898000
                END;                                           <<02509>>20900000
             DUMP'WCS;                                         <<03005>>20902000
             @CTPNTR := @CMD'TAB(BEG'OF'STACK                  <<02509>>20904000
                +(NRENT'AFTER'WCS*2));                         <<02509>>20906000
             TOS := NRENT'AFTER'WCS;                           <<02509>>20908000
             WHILE <> DO                                       <<02509>>20910000
                BEGIN                                          <<02509>>20912000
                @CTPNTR := @CTPNTR(-2);                        <<02509>>20914000
                FREADDIR(FNUM,LBUF,LEN,DOUBLE(REC));           <<02509>>20916000
                WRITETAPE(LBUF,LEN,1);                         <<02509>>20918000
                TOS := TOS-1;                                  <<02509>>20920000
                END;                                           <<02509>>20922000
             END;  <<TAPE>>                                    <<02509>>20924000
          <<-------------------------                                   20928000
            SET UP ICS AND LOW CORE                                     20930000
          ------------------------->>                                   20932000
          ZEROBUF(LBUF,384);                                   <<03544>>20934000
          TOS := INITDB;                                       <<03604>>20936000
          LBUF(ICSQI+2) := TOS;    <<DISPATCHER DB>>           <<03604>>20938000
          LBUF(ICSQI+1) := TOS;    <<DISPATCHER BANK>>         <<03604>>20940000
          TOS := INITDB;                                       <<03604>>20942000
          LBUF(ICSQI-4) := TOS;                   <<STACK DB>> <<03604>>20944000
          LBUF(ICSQI-5) := TOS;                   <<S-BANK>>   <<03604>>20946000
          LBUF(ICSQI-7) := -TABLESIZE;            <<REL DL>>   <<03604>>20948000
          LBUF(ICSQI-8) := LOGICAL(ZVALUE-INITDB);<<REL Z>>    <<03604>>20950000
          LBUF(ICSQI-10):= LOGICAL(SVALUE-INITDB);<<REL S>>    <<03604>>20952000
          LBUF(ICSQI-18) := 1; << PDISABLED >>                 <<03604>>20954000
          WRITETAPE(LBUF,ICSLEN,1);                            <<02509>>20958000
          ZEROBUF(LBUF,384);                                   <<03544>>20960000
          LBUF := CSTBASE;   <<CST POINTER>>                   <<03604>>20962000
          TOS := ICSBASE;                                               20964000
          LBUF(5) := S0+ICSQI;                                          20966000
          LBUF(6) := TOS+ICSZI;                                <<03604>>20968000
          LBUF(8) := 1;   <<INSURE DRTBANK = 1 >>              <<03006>>20970000
          WRITETAPE(LBUF,A0SIZE,1);                            <<02509>>20974000
          WRITETAPE(TCST,TCSTSIZE,1);                          <<03604>>20976000
                                                                        20978000
          <<-------------                                               20980000
            DUMP TABLES                                                 20982000
          ------------->>                                               20984000
          WRITETAPE(CSTAB,CSTAB,1);  <<CS DATA SEGMENT>>                20986000
          WRITETAPE(DVRTAB,(HLDEV+1)*DVRSIZE,1);                        20988000
          WRITETAPE(LPDT,(HLDEV+1)*LPDTSIZE,1);                         20990000
          WRITETAPE(LDT,(HLDEV+1)*LDTSIZE,1);                           20992000
          TOS := WORDADDRESS(DVCLTAB); <<CONV TO WORD ADDRESS>><<03704>>20994000
          WRITETAPE(*,DVCLSIZE,1);                             <<03704>>20996000
          WRITETAPE(LDTX,(HLDEV+1)*LDTXSIZE,1);                <<00.06>>20998000
          WRITETAPE(VTAB,(MVOL+1)*VTABSIZE,1);                          21000000
          IF DUMPDATE <> -1 THEN                                        21002000
            BEGIN                                                       21004000
              WRITETAPE(OLDVTAB,CTAB0(OLDVTABSIZE),1);<<OLD VTAB>>      21006000
              ATTACHIO(SYSDISC,0,0,@LBUF,0,INFOSIZE,           <<03544>>21008000
                       0,INFOSECT,1);                          <<03544>>21010000
              WRITETAPE(LBUF,INFOSIZE,1);  <<COLD LOAD INFO TABLE>>     21012000
            END;                                                        21014000
          FREADDIR(CTABFNUM,LBUF,CTABTSIZE,D'L(CTABREC)));              21016000
  CTABERR:IF <> THEN FERROR(CTABFNUM,CTABFILE);                         21018000
          FCLOSE(CTABFNUM,0,0);                                         21020000
          IF <> THEN GOTO CTABERR;                                      21022000
           IF DUMPDATE <> -1 THEN                              <<00197>>21024000
             BEGIN                                             <<00197>>21026000
               FMSIR:=GETSIR(FMAVTSIR);                        <<00197>>21028000
               FSIR:=GETSIR(FLABSIR);                          <<00197>>21030000
             END;                                              <<00197>>21032000
          DSIR := GETSIR(DIRSIR);                                       21034000
          TOS := SETSYSDB;                                              21036000
          TOS := DBARRAY(LOGFILENUM);  <<CURRENT LOG FILE NUMBER>>      21038000
          TOS:=DBARRAY(DIRDISC1);                              <<00215>>21040000
          TOS:=DBARRAY(DIRDISC2);                              <<00215>>21042000
          TOS := S3;                                                    21044000
          RESETDB(*);                                                   21046000
          DIRDISCADR := TOS;                                            21048000
          CTAB0(LOGFILENUM') := TOS;                                    21050000
          DEL;                                                          21052000
          TOS := DIRSIZE(DIRSECT);  <<GET CURRENT MINIMUM SIZE>>        21054000
          ASSEMBLE(DUP,DUP);                                            21056000
          LDIRC := LOGICAL ( CTAB(DIRSECT') );                 <<DE>>   21058000
          DIRSECT := TOS;  <<MINIMUM SIZE OF DIRECTORY>>                21060000
          IF TOS > LDIRC THEN                                  <<DE>>   21062000
            BEGIN  <<RESET SIZE IN CTAB>>                               21064000
              CTAB(DIRSECT') := TOS;                                    21066000
              DEL;                                                      21068000
            END                                                         21070000
          ELSE DDEL;                                                    21072000
          IF NULL'DATE THEN                                    <<00072>>21074000
            BEGIN                                                       21076000
              RELSIR(DIRSIR,DSIR);                                      21078000
              TOS := 0;  <<NO FILES DUMPED>>                            21080000
            END                                                         21082000
          ELSE                                                          21084000
            BEGIN                                                       21086000
              SIRS := TRUE;                                             21088000
              TOS := 1;  <<FILES DUMPED>>                               21090000
            END;                                                        21092000
          CTAB0(FILESDUMPED) := TOS;                                    21094000
          IF CTAB(RINS')<>RINS OR CTAB(GRINS')<>GRINS THEN              21096000
          IF (NOT RINCHANGE) AND DUMPDATE<>-1 THEN                      21098000
            BEGIN  <<TABLE SIZE CHANGED DUE TO CORE SIZE CHANGE>>       21100000
              CTAB(RINS') := RINS;                                      21102000
              CTAB(GRINS') := GRINS;                                    21104000
            END;                                                        21106000
          MOVE LBUF(COREX*CTABSIZE) := CTAB,(CTABSIZE);                 21108000
        IF DEFAULT THEN                                        <<01210>>21110000
          BEGIN                                                <<01210>>21112000
          I := 0;                                                       21114000
          DO                                                            21116000
            BEGIN                                                       21118000
            J := 0;                                                     21120000
            K := I-128;                                                 21122000
            DO                                                          21124000
              BEGIN                                                     21126000
              K := K+128;                                               21128000
              LBUF(K) := DEFAULTS(I*8+J);   <<CTAB>>                    21130000
              END                                                       21132000
            UNTIL(J:=J+1)=8;                                            21134000
            END                                                         21136000
          UNTIL(I:=I+1)=22;                                             21138000
          I := 30;                                                      21140000
          DO                                                            21142000
            BEGIN                                                       21144000
            J := 0;                                                     21146000
            K := I-128;                                                 21148000
            DO                                                          21150000
              BEGIN                                                     21152000
              K := K+128;                                               21154000
              LBUF(K) := DEFAULTS((I-8)*8+J); <<CTAB>>                  21156000
              END                                                       21158000
            UNTIL(J:=J+1)=8;                                            21160000
            END                                                         21162000
          UNTIL(I:=I+1)=35;                                             21164000
          I := 40;                                                      21166000
          DO                                                            21168000
            BEGIN                                                       21170000
            J := 0;                                                     21172000
            K := I-128;                                                 21174000
            DO                                                          21176000
              BEGIN                                                     21178000
              K := K+128;                                               21180000
              LBUF(K) := DEFAULTS((I-13)*8+J);                          21182000
              END                                                       21184000
            UNTIL(J:=J+1)=8;                                            21186000
            END                                                         21188000
          UNTIL(I:=I+1) = 49;                                  <<03701>>21190000
          MOVE CTAB:= LBUF(COREX*CTABSIZE),(CTABSIZE);         <<03075>>21192000
          END;                                                 <<01210>>21194000
          WRITETAPE(LBUF,CTABTSIZE,1);                                  21196000
        IF DEFAULT THEN                                        <<01210>>21198000
          BEGIN                                                <<01210>>21200000
          CTAB0(MAXSPOOLF) := 20;                                       21202000
          CTAB0(LOGON) := 120;                                          21204000
          CTAB0(CPULIM) := 0;                                           21206000
          CTAB0(LOGRECSIZE) := 2;                                       21208000
          CTAB0(LOGFILESIZE) := 1023;                                   21210000
          DCTAB0(KILOSECTS) := 128D;                                    21212000
          CTAB0(EXTSSECT') := 384;                                      21214000
          CTAB0(TSLICE) := 500;                                         21216000
          CTAB0(TERMPRI) := 152;                                        21218000
          CTAB0(NORMPRI) := 160;                                        21220000
          CTAB0(CPUPRI) := 200;                                <<01.00>>21222000
          CTAB0(SSS) := 1200;  <<STANDARD STACK SIZE>>         <<01332>>21224000
          CTAB0(MITVERSION) := VERSION CAT %40 (0:8:8);        <<00932>>21226000
          CTAB0(MITUPDATE) := UPDATEL;                         <<00932>>21228000
          CTAB0(MITFIX) := FIXLEVEL;                           <<00932>>21230000
          END;                                                 <<01210>>21232000
          CTAB0(DISCENTRY') := DISCENTRY;                               21234000
          CTAB0(MAXINITSEG') := MAXINITSEG;                             21236000
          CTAB0(ID0) := 0;           << CLEAR WORD  >>         <<03006>>21238000
          CTAB0(ID0).DRTCNVRT  := 1; <<DRT CONVERSION DONE>>   <<03006>>21240000
          CTAB0(ID0).LYNXCNVRT := 1; <<TBUF CONVERSION DONE>>  <<03007>>21242000
          CTAB0(ID1) := 0;   << CONVERSION WORDS ID1-ID3 >>    <<03006>>21244000
          CTAB0(ID2) := 0;   << SO FAR UNUSED            >>    <<03006>>21246000
          CTAB0(ID3) := 0;                                     <<03006>>21248000
          CTAB0(FIXLEVEL') := FIXLEVEL;                                 21250000
          CTAB0(COLDLOADID') := COLDLOADID;                             21252000
          CTAB0(UPDATEL') := UPDATEL;                                   21254000
          CTAB0(VERSION') := VERSION CAT %40 (0:8:8);          <<00932>>21256000
          CTAB0(SERIALDISCLOAD').LOADTYPE:=IF                  <<00150>>21258000
          MAGTAPE THEN 0 ELSE 1;                               <<02509>>21260000
          CTAB0(SERIALDISCLOAD').LOADDATE:=IF                  <<00150>>21262000
          FUTURE'DATE THEN 1 ELSE 0;                           <<00150>>21264000
          CTAB0(TAPERECSIZE') := TAPERECSIZE;                  <<03604>>21266000
          WRITETAPE(CTAB0,CTAB0SIZE,1);                                 21268000
          WRITETAPE(CSDVR,CSDVRTSIZE,1);                                21270000
          WRITETAPE(CSDEF,CSDEFSIZE,1);                                 21272000
                                                                        21274000
                                                                        21282000
          <<-------------------                                         21284000
            DUMP CONFIGURATOR                                           21286000
          ------------------->>                                         21288000
          SEGTOTAPE(REC0(3),REC0(2),1);  <<WRITE DB AREA TO TAPE>>      21290000
          ZEROBUF(LBUF,384);                                   <<03544>>21292000
          TOS := REC0(9)+FIRSTCST;                                      21294000
          ASSEMBLE(TSBC 0);                                             21296000
          TOS := INITDB;                                       <<03604>>21298000
          LBUF(MARKERSIZE-1) := TOS;  <<DB>>                   <<03604>>21300000
          LBUF(X:=X-1) := TOS;      <<BANK>>                   <<03604>>21302000
          LBUF(X:=X-1) := 4;        <<DELTA Q>>                <<03604>>21304000
          LBUF(X:=X-1) := TOS; <<STATUS>>                               21306000
          LBUF(X:=X-1) := TAPEENTRY;  <<DELTA P>>                       21308000
          WRITETAPE(LBUF,MARKERSIZE,1);                        <<02509>>21312000
          X := 0;                                              <<03604>>21316000
          WHILE X < NSTARTSEG DO                               <<03604>>21318000
             BEGIN                                             <<03604>>21320000
             SEGTOTAPE(SEGADR(X),SEGSIZE(X),1);                <<03604>>21322000
             X:=X+1;                                           <<03604>>21324000
             END;                                              <<03604>>21326000
          IF NOT MAGTAPE THEN                                  <<02509>>21330000
             BEGIN                                             <<02509>>21332000
             I := 1;                                           <<02509>>21334000
             WHILE I <= BLOCKN DO                              <<02509>>21336000
                BEGIN                                          <<02509>>21338000
                TEMP := FINDSDISCGAP(SDISCLDEV,I,DISCADDRESS); <<02509>>21340000
                IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);   <<02509>>21342000
                @PNTR := @TAPE'FMT'TAB(I*ENTRY'SIZE);          <<02509>>21344000
                DISCADR1 := D1;                                <<02509>>21346000
                DISCADR2 := D2;                                <<02509>>21348000
                I := I+1;                                      <<02509>>21350000
                END;                                           <<02509>>21352000
                                                               <<03544>>21356000
             << BUILD CHANNEL PROGRAM ON SERIAL DISC.   >>     <<03544>>21358000
             << THERE ARE DIFFERENT CHANNEL PROGRAMS    >>     <<03544>>21360000
             << FOR SERIESII'III, HPIB 13037-CONTROLLED >>     <<03544>>21362000
             << DISCS, AND CS'80 DISCS.  WE DUMP OUT    >>     <<03544>>21364000
             << TWO CHANNEL PROGRAMS IN CASE THE DISC   >>     <<03544>>21366000
             << WILL BE USED ON A SERIES II/III OVER    >>     <<03544>>21368000
             << THE HPIB INTERFACE AND OVER A REGULAR   >>     <<03544>>21370000
             << SIO DISC.                               >>     <<03544>>21372000
                                                               <<03544>>21374000
             BUILD'SIO'SDISC( TAPE'FMT'TAB);                   <<03544>>21376000
             IF OUTDEVTYPE = DISC3 THEN                        <<03702>>21378000
                BUILD'CS80'SDISC( TAPE'FMT'TAB)                <<03544>>21380000
             ELSE                                              <<03544>>21382000
                BUILD'AMIGO'SDISC( TAPE'FMT'TAB);              <<03544>>21384000
                                                               <<02509>>21386000
             IF POSTSERIES3 THEN                               <<03005>>21388000
                BEGIN                                          <<03005>>21390000
                COMPUTE'WCS'SIZE;                              <<03005>>21392000
                DUMP'WCS;                                      <<03005>>21394000
                END;                                           <<03005>>21396000
             END;                                              <<02509>>21398000
                                                               <<00.SD>>21400000
        X := NSTARTSEG; <<WRITE DISC RES. SEGS OF INIT>>       <<03604>>21404000
        WHILE X < NSEG DO                                      <<03604>>21406000
           BEGIN                                               <<03604>>21408000
           SEGTOTAPE(SEGADR(X),SEGSIZE(X),0);                  <<03604>>21410000
           X:=X+1;                                             <<03604>>21412000
           END;                                                <<03604>>21414000
        FCLOSE(INITFNUM,0,0);                                  <<00.SD>>21416000
        IF <> THEN GOTO INITERR;                               <<00.SD>>21418000
                                                                        21420000
          <<--------------------------                                  21422000
            ALTER AND DUMP RIN TABLE                                    21424000
          -------------------------->>                                  21426000
          IF NULL'DATE THEN GOTO DIREOF;                       <<00072>>21428000
          @LOCRIN := @RIN;  <<OLD TABLE LOCATION>>                      21430000
          @GLORIN := @RIN+RINS&LSL(1)+2;                                21432000
          IF (NRINLEN:=((CTAB(RINS')&LSL(1)+CTAB(GRINS')*12+9)&LSR(2))  21434000
            &LSL(2))>RINLEN THEN                                        21436000
            BEGIN  <<TABLE IS NOW BIGGER>>                              21438000
              IF (N:=@RIN-@LPDT-NRINLEN+RINLEN)<0 THEN                  21440000
                BEGIN <<NOT ENOUGH ROOM FOR EXPANDED TABLE>>            21442000
                VTABINCR := -N;                                <<01590>>21444000
                MOVEDLTABLES;                                  <<01590>>21446000
                << AT THIS TIME THE ONLY EXPANDABLE TABLES   >><<01590>>21448000
                << STILL IN USE ARE DVRTAB AND BLINBUF.      >><<01590>>21450000
                << THEREFORE, EXPANDING VTAB BY N WORDS      >><<01590>>21452000
                << SHOULD PREVENT US FROM OVERWRITING THESE  >><<01590>>21454000
                << TABLES.                                   >><<01590>>21456000
                END;                                                    21458000
              @RIN := @RIN+RINLEN-NRINLEN;                              21460000
              MOVE RIN := LOCRIN,(RINS&LSL(1)+2);                       21462000
            END;                                                        21464000
          @NGLORIN := @RIN+CTAB(RINS')&LSL(1)+2;                        21466000
          IF @NGLORIN<=@GLORIN THEN                                     21468000
            MOVE NGLORIN := GLORIN,(CTAB(GRINS')*12+4)                  21470000
          ELSE                                                          21472000
            BEGIN   <<GLOBAL AREA IS NOW SMALLER>>                      21474000
              TOS := CTAB(GRINS')*12+3;                                 21476000
              ASSEMBLE(DUP,DUP);                                        21478000
              TOS := TOS+@NGLORIN;                                      21480000
              ASSEMBLE(XCH);                                            21482000
              TOS := TOS+@GLORIN;                                       21484000
              ASSEMBLE(CAB,INCA; NEG; MOVE 3);                          21486000
            END;                                                        21488000
          K := (CTAB(RINS')-RINS)&ASL(1);  <<GLOBAL RIN AREA OFFSET>>   21490000
          RIN(X) := RIN(1)+K;                                           21492000
          I := 0;                                                       21494000
          WHILE (I:=I+2)<=RINS&LSL(1) DO  <<UPDATE GLOBAL PTRS>>        21496000
          IF RIN(I).(0:2)=2 THEN RIN(X) := RIN(X)+K;                    21498000
          IF K>0 THEN                                                   21500000
            BEGIN  <<ZERO ADDITION LOCAL AND GLOBAL RIN AREA>>          21502000
              RIN(RINS&LSL(1)+2) := 0;                                  21504000
              MOVE RIN(X:=X+1) := RIN(X:=X-1),(K-1);                    21506000
            END;                                                        21508000
          GRINS := CTAB(GRINS');                                        21510000
          RINS := CTAB(RINS');                                          21512000
          COMPACTRIN;                                                   21514000
          WRITETAPE(RIN,NRINLEN,0);                            <<00.SD>>21516000
                                                                        21518000
   IF DUMPDATE = -1 THEN GOTO DIREOF;                          <<00506>>21520000
   @LIDTABTEMP:=@LIDTAB;                                       <<00506>>21522000
   IF (NEWLIDTABLEN:=CTAB(NLOGPROCS) * 33+ 33)<<ESIZE>> >      <<00506>>21524000
   LIDTABLEN THEN                                              <<00506>>21526000
      BEGIN                                                    <<00506>>21528000
      <<TABLE WAS MADE LARGER>>                                <<00506>>21530000
      IF(N:=@LIDTAB-@LPDT-NEWLIDTABLEN+LIDTABLEN) < 0 THEN     <<00506>>21532000
      BEGIN  <<NO MORE ROOM FRO EXPANDED TABLE>>               <<00506>>21534000
      IF @DVRTAB(N) < DLLEN THEN                               <<00506>>21536000
         <<NEED MORE DL SPACE>>                                <<00506>>21538000
         BEGIN                                                 <<00506>>21540000
         DLLEN:=DLSIZE(@DVRTAB(X));                            <<00506>>21542000
         IF <> THEN                                            <<00506>>21544000
            BEGIN                                              <<00506>>21546000
            MESSAGE(85);                                       <<00506>>21548000
            IF SIRS THEN                                       <<00506>>21550000
               BEGIN                                           <<00506>>21552000
               RELSIR(DIRSIR,DSIR);                            <<00506>>21554000
               RELSIR(FLABSIR,FSIR);                           <<00506>>21556000
               RELSIR(FMAVTSIR,FMSIR);                         <<00506>>21558000
               END;                                            <<00506>>21560000
            QUIT(0);                                           <<00506>>21562000
            END;                                               <<00506>>21564000
         END;                                                  <<00506>>21566000
      MOVE DVRTAB(X):=DVRTAB,((HLDEV+1)*DVRSIZE);              <<00506>>21568000
      @DVRTAB:=@DVRTAB(X);                                     <<00506>>21570000
      END;                                                     <<00506>>21572000
   @LIDTAB:=@LIDTAB+LIDTABLEN-NEWLIDTABLEN;                    <<00506>>21574000
   MOVE LIDTAB:=LIDTABTEMP,(LIDTABLEN);                        <<00506>>21576000
   I:=1;                                                       <<00506>>21578000
   DO                                                          <<00506>>21580000
   BEGIN                                                       <<00506>>21582000
      LIDTAB(LIDTABLEN+I*33-1):=-1;                            <<00506>>21584000
   END UNTIL (LIDTABLEN+(I:=I+1)*33) > NEWLIDTABLEN;           <<00506>>21586000
   LIDTAB(1):=CTAB(NLOGPROCS);                                 <<00506>>21588000
   LIDTAB(2):=LIDTAB(2)+(NEWLIDTABLEN-LIDTABLEN)/33;           <<00506>>21590000
   END;                                                        <<00506>>21592000
   WRITETAPE(LIDTAB,NEWLIDTABLEN,0);                           <<00506>>21594000
          <<----------------                                            21596000
            DUMP DIRECTORY                                              21598000
          ---------------->>                                            21600000
          DUMPDIRC (CTAB(DIRSECT'), DIRDISCADR, DIREC);        <<DE>>   21602000
  DIREOF: FCONTROL(TAPEFNUM,6,I);  <<WRITE FILE MARK>>                  21604000
          IF <> THEN GOTO TAPEERR;                                      21606000
                                                                        21608000
          <<---------------------                                       21610000
            DUMP SYSTEM LIBRARY                                         21612000
          --------------------->>                                       21614000
          @BPNOTDUMP := @NOTDUMP;                                       21616000
          TEMPSLOPEN := TRUE;                                           21618000
          FDUMP(PSLFILE);   <<DUMP SYSTEM LIBRARY>>                     21620000
          IF TEMPSLSAVED THEN                                           21622000
            BEGIN   <<PURGE TEMPSL>>                                    21624000
              TSLFNUM := FOPEN(TSLFILE,%(2)10);                         21626000
              FCLOSE(TSLFNUM,4,0);                                      21628000
              TEMPSLSAVED := FALSE;                                     21630000
            END;                                                        21632000
          SEGMENT(8) := " ";                                            21634000
                                                                        21636000
          <<----------------------                                      21638000
            DUMP SYSTEM PROGRAMS                                        21640000
          ---------------------->>                                      21642000
          X := -8;                                                      21644000
          I := 0;                                                       21646000
          DO                                                            21648000
            BEGIN    <<DUMP SYSTEM PROGRAMS>>                           21650000
              MOVE SEGMENT:=  SYSPROG(X:=X+8),(8);             <<00598>>21652000
              FDUMP(SEGMENT);                                           21654000
            END                                                         21656000
          UNTIL (I:=I+1) = NSYSPROG;                                    21658000
          IF POSTSERIES3 THEN                                  <<01402>>21660000
             BEGIN <<SYSTEM PROGRAMS UNIQUE TO SERIES'33>>     <<00454>>21662000
             X:=-8;                                            <<00150>>21664000
             I:=0;                                             <<00150>>21666000
             DO                                                <<00150>>21668000
                BEGIN                                          <<00150>>21670000
                MOVE SEGMENT:=SYSPROG'33(X:=X+8),(8);          <<00454>>21672000
                FDUMP(SEGMENT);                                <<00150>>21674000
                END                                            <<00150>>21676000
             UNTIL (I:=I+1)=NSYSPROG'33;                       <<00454>>21678000
             END;  <<SYSTEM PROGRAMS UNIQUE TO SERIES'33>>     <<00454>>21680000
             IF SERIESII'III THEN                              <<02509>>21684000
                BEGIN <<UNIQUE SYSTEM PROGRAMS>>               <<00454>>21686000
                X:=-8;                                         <<00454>>21688000
                I:=0;                                          <<00454>>21690000
                DO                                             <<00454>>21692000
                   BEGIN                                       <<00454>>21694000
                   MOVE SEGMENT:=SYSPROG'2(X:=X+8),(8);        <<00454>>21696000
                   FDUMP(SEGMENT);                             <<00454>>21698000
                   END                                         <<00454>>21700000
                UNTIL (I:=I+1)=NSYSPROG'2;                     <<00454>>21702000
                END;  <<UNIQUE SYSTEM PROGRAMS>>               <<00454>>21704000
          I := -1;                                                      21706000
          TEMP := CTAB0(NUMADVRS);                                      21708000
          X := -8;                                                      21710000
          WHILE(I:=I+1)<TEMP DO                                         21712000
            BEGIN   <<DUMP CS DRIVERS>>                                 21714000
            MOVE SEGMENT:=BCSDVR(X:=X+8),(8);                           21716000
            FDUMP(SEGMENT);                                             21718000
            END;                                                        21720000
          I := 0;                                                       21722000
          TOS := @DVRTAB(2)&LSL(1);                            <<03704>>21724000
          DO                                                            21726000
            BEGIN   <<DUMP NON-STD. DRIVERS>>                           21728000
              IF BPS0=0 THEN GOTO NEXTDP;                               21730000
              J := 0;                                                   21732000
              X := -8;                                                  21734000
              DO                                                        21736000
                BEGIN   <<CHECK FOR SYSTEM PROGRAM>>                    21738000
                  DUPLICATE;                                            21740000
                  IF * = SYSPROG(X:=X+8),(8) THEN GO NEXTDP;   <<00598>>21742000
                END                                                     21744000
              UNTIL (J:=J+1)=NSYSPROG;                                  21746000
              J:=0;                                            <<00454>>21748000
              X:=-8;                                           <<00454>>21750000
              DO                                               <<00454>>21752000
                BEGIN <<CHECK UNIQUE SYSTEM PROGRAMS>>         <<00454>>21754000
                DUPLICATE;                                     <<00454>>21756000
                IF *=SYSPROG'2(X:=X+8),(8) THEN                <<00454>>21758000
                  GOTO NEXTDP;                                 <<00454>>21760000
                END                                            <<00454>>21762000
              UNTIL (J:=J+1)=NSYSPROG'2;                       <<00454>>21764000
              J:=0;                                            <<00454>>21766000
              X:=-8;                                           <<00454>>21768000
              DO                                               <<00454>>21770000
                BEGIN <<CHECK UNIQUE SYSTEM PROGRAMS>>         <<00454>>21772000
                DUPLICATE;                                     <<00454>>21774000
                IF *=SYSPROG'33(X:=X+8),(8) THEN               <<00454>>21776000
                  GOTO NEXTDP;                                 <<00454>>21778000
                END                                            <<00454>>21780000
              UNTIL (J:=J+1)=NSYSPROG'33;                      <<00454>>21782000
              J := 0;                                          <<02026>>21784000
              DO                                                        21786000
                BEGIN   <<CHECK FOR ALREADY DUMPED>>                    21788000
                  DUPLICATE;                                            21790000
                  TOS := @DVRTAB(J*DVRSIZE+2)&LSL(1);          <<03704>>21792000
                  IF * = *,(8) THEN GOTO NEXTDP;                        21794000
                END                                                     21796000
              UNTIL (J:=J+1) = I;                                       21798000
              DUPLICATE;                                                21800000
              MOVE SEGMENT := *,(8); << TO INSURE SPEC TERMINATE CHAR>> 21802000
              FDUMP(SEGMENT);                                           21804000
  NEXTDP:     TOS := TOS+12;                                            21806000
            END                                                         21808000
          UNTIL (I:=I+1) > HLDEV;                                       21810000
          FCONTROL(TAPEFNUM,6,I);  <<WRITE FILE MARK>>                  21812000
          IF <> THEN GOTO TAPEERR;                                      21814000
                                                                        21816000
          <<-----------------                                           21818000
            DUMP USER FILES                                             21820000
          ----------------->>                                           21822000
          SETSERVICE(0);                                                21824000
         IF SIRS THEN                                          <<00208>>21826000
            BEGIN                                              <<00208>>21828000
            RELSIR(DIRSIR,DSIR);                               <<00208>>21830000
            RELSIR(FLABSIR,FSIR);                              <<00208>>21832000
            RELSIR(FMAVTSIR,FMSIR);                            <<00208>>21834000
            SIRS := FALSE;                                     <<00208>>21836000
            END;                                               <<00208>>21838000
                                                               <<02567>>21840000
<< Do KLUDGE for 6250 BPI default case >>                      <<02567>>21842000
                                                               <<02567>>21844000
   SETUP'FLAGS(SYSTAPE,DENSITY,TAPEFILE,FSTORE'FLAG,ERRNUM);   <<02567>>21846000
   IF ERRNUM <> 0 THEN                                         <<02567>>21848000
      BEGIN                                                    <<02567>>21850000
      IF ERRNUM < 0 THEN                                       <<02567>>21852000
         FERROR(SYSTAPE,TAPEFILE)  << File error.  Exits !! >> <<02567>>21854000
      ELSE                                                     <<02567>>21856000
         EVALRETURN(0,XRETPMASKFAIL);  << Cant find FEQ >>     <<02567>>21858000
      END;                                                     <<02567>>21860000
                                                               <<02567>>21862000
          IF NULL'DATE OR FUTURE'DATE THEN                     <<00072>>21864000
            MOVE STORE'FILES':="NOFILES-NOFILES";              <<04659>>21866000
                                                               <<04659>>21870000
   STORE'USER'FILES (SYSTAPE, SHOW,                            <<04659>>21872000
                     FALSE,            <<not syntax only>>     <<04659>>21874000
                     ERRNUM, ERR'SUBCLASS);                    <<04659>>21876000
                                                               <<04659>>21878000
   WHILE ERRNUM = S'ERR'SYNTAX DO                              <<04659>>21880000
      BEGIN                                                    <<04659>>21882000
      GET'FILE'SUBSET;                                         <<04659>>21884000
      SHOW:=YESANSWER(82);                                     <<04659>>21886000
      STORE'USER'FILES (SYSTAPE, SHOW,                         <<04659>>21888000
                        FALSE,         <<not syntax only>>     <<04659>>21890000
                        ERRNUM, ERR'SUBCLASS);                 <<04659>>21892000
      END;                                                     <<04659>>21894000
                                                               <<04659>>21896000
                                                               <<00072>>21898000
          <<---------------------------------------->>         <<00072>>21900000
          <<START USER FILES ON A SEPERATE FLOPPY DISC>>       <<00072>>21902000
          <<------------------------------------------>>       <<00072>>21904000
          IF FLOPPY THEN                                       <<00150>>21906000
             BEGIN                                             <<00072>>21908000
             MESSAGE(175); <<END OF SYSTEM SECTION>>           <<00072>>21910000
             NEXTREEL;                                         <<00072>>21912000
             FCONTROL(TAPEFNUM,6,I);                           <<00072>>21914000
             IF <> THEN FERROR(TAPEFNUM,TAPEFILE);             <<00072>>21916000
             FCONTROL(TAPEFNUM,6,I);                           <<00072>>21918000
             IF <> THEN FERROR(TAPEFNUM,TAPEFILE);             <<00072>>21920000
             END;                                              <<00072>>21922000
                                                               <<00072>>21924000
     END;                                                      <<01073>>21928000
$PAGE "             LIST SYSTEM FILES NOT FOUND"               <<01073>>21930000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>21932000
     PROCEDURE LIST'SYS'FILES;                                 <<01073>>21934000
     OPTION PRIVILEGED,UNCALLABLE;                             <<01073>>21936000
     BEGIN                                                     <<01073>>21938000
          IF @NOTDUMP <> @BPNOTDUMP THEN                                21940000
            BEGIN   <<LIST PROGRAMS NOT DUMPED>>                        21942000
              MESSAGE(73);                                              21944000
              TOS := @NOTDUMP;                                          21946000
  NEXTNOT:    X := BPS0-1;                                              21948000
              TOS := TOS+1;                                             21950000
              MOVE BINBUF := *, (X),1;                                  21952000
              ASSEMBLE(DELB,DUP);                                       21954000
              PRINT(INBUF,-X,0);                                        21956000
              IF TOS<>@BPNOTDUMP THEN GOTO NEXTNOT;                     21958000
            END;                                                        21960000
       IF DEFAULT THEN                                         <<01210>>21962000
         BEGIN                                                 <<01210>>21964000
          MOVE BINBUF := "TOTAL SYSTEM FILE SPACE ",2;         <<00928>>21966000
          TOS := TOS+DASCII(SYSTEMFILESPACE,10,BPS0);          <<00928>>21968000
          X := TOS-@BINBUF;                                    <<00928>>21970000
          PRINT(INBUF,-X,0);                                   <<00928>>21972000
         END;                                                  <<01210>>21974000
     END;                                                      <<01073>>21976000
$PAGE "STORE/RESTORE INTERFACE"                                <<04659>>21978000
PROCEDURE STORE'USER'FILES (SYSTAPE, SHOW, SYNTAX'ONLY,        <<04659>>21980000
                            ERROR'CODE, ERROR'SUBCLASS);       <<04659>>21982000
         VALUE   SHOW, SYSTAPE, SYNTAX'ONLY;                   <<04659>>21984000
         LOGICAL SHOW, SYNTAX'ONLY;                            <<04659>>21986000
         INTEGER ERROR'CODE, ERROR'SUBCLASS, SYSTAPE;          <<04659>>21988000
                                                               <<04659>>21990000
      <<---------------------------------------------------->> <<04659>>21992000
      << This procedure invokes STORE as a separate process.>> <<04659>>21994000
      << The list of files to store, and the list of STORE  >> <<04659>>21996000
      << options are passed via the INFO parameter.         >> <<04659>>21998000
      <<                                                    >> <<04659>>22000000
      << Two new keywords are appended to the options list: >> <<04659>>22002000
      <<    DENSITY=the tape density                        >> <<04659>>22004000
      << and                                                >> <<04659>>22006000
      <<    RECSIZE=the tape recsize.                       >> <<04659>>22008000
      << These two new options, usable only by SYSDUMP, are >> <<04659>>22010000
      << added to STORE to properly handle the problem of   >> <<04659>>22012000
      << multi-density devices like the 7976.               >> <<04659>>22014000
      <<                                                    >> <<04659>>22016000
      << If the user answered "YES" to the SYSDUMP question:>> <<04659>>22018000
      <<    LIST FILES DUMPED?                              >> <<04659>>22020000
      << then SHOW=TRUE, and we will append a ";SHOW" to    >> <<04659>>22022000
      << the STORE options list.                            >> <<04659>>22024000
      <<                                                    >> <<04659>>22026000
      << STORE communicates its success or failure via the  >> <<04659>>22028000
      << MAIL intrinsics.  A value of GOOD in the mail slot >> <<04659>>22030000
      << MAIL'OVERALL indicates a successful store.  If any >> <<04659>>22032000
      << thing went wrong, the slot MAIL'WHY tells what     >> <<04659>>22034000
      << state STORE was in at the time of the error.       >> <<04659>>22036000
      <<---------------------------------------------------->> <<04659>>22038000
                                                               <<04659>>22040000
   BEGIN                                                       <<04659>>22042000
                                                               <<04659>>22044000
   EQUATE                                                      <<04659>>22046000
      INFO'LEN    = 301,      <<# chars in INFO' array>>       <<04659>>22048000
      MAX'ITEM    = 10;       <<maximum # of items>>           <<04659>>22050000
                                                               <<04659>>22052000
   INTEGER ARRAY                                               <<04659>>22054000
      INFO        (0:INFO'LEN/2),   <<holds INFO string>>      <<04659>>22056000
      ITEMCODES   (0:MAX'ITEM),     <<used by CREATEPROCESS>>  <<04659>>22058000
      ITEMS       (0:MAX'ITEM),     <<used by CREATEPROCESS>>  <<04659>>22060000
      REPLY'MSG   (0:5);            <<holds mail reply>>       <<04659>>22062000
                                                               <<04659>>22064000
   INTEGER                                                     <<04659>>22066000
      CPERR       := 0,       <<CREATEPROCESS error code>>     <<04659>>22068000
      LDEV        := 0,       <<ldev of tape/sdisc>>           <<04659>>22070000
      LEN,                    <<length SCANned/MOVEd>>         <<04659>>22072000
      PIN         := 0,       <<PIN of STORE.PUB.SYS>>         <<04659>>22074000
      STATUS      := 0;       <<MAIL intrinsic status>>        <<04659>>22076000
                                                               <<04659>>22078000
   BYTE ARRAY                                                  <<04659>>22080000
      INFO'       (*) = INFO (0),   <<holds INFO string>>      <<04659>>22082000
      PROGNAME'   (0:8+8+8+2);      <<holds: "STORE.PUB.SYS ">><<04659>>22084000
                                                               <<04659>>22086000
   BYTE POINTER                                                <<04659>>22088000
      POPTIONS,               <<points to options list>>       <<04659>>22090000
      PT;                     <<scratch pointer>>              <<04659>>22092000
                                                               <<04659>>22094000
   DEFINE                                                      <<04659>>22096000
      DEN'OPTION  = 46 #,     <<FFILEINFO item# for DENSITY>>  <<04659>>22098000
      FAILED      = FALSE #,                                   <<04659>>22100000
      GOOD        = TRUE #,                                    <<04659>>22102000
      LDEV'OPTION = 6 #,      <<FFILEINFO item# for LDEV>>     <<04659>>22104000
      UNKNOWN'PROG'FILE = (CPERR = 6) #;                       <<04659>>22106000
                                                               <<04659>>22108000
   EQUATE                                                      <<04659>>22110000
         <<STORE "states"...>>                                 <<04659>>22112000
      WHY'GOOD       = 0,     <<no error found>>               <<04659>>22114000
      WHY'SYNTAX     = 1,     <<parsing syntax>>               <<04659>>22116000
      WHY'OPENING'FILES=2,    <<opening utility files>>        <<04659>>22118000
      WHY'INDIRECT   = 3,     <<opening indirect file>>        <<04659>>22120000
      WHY'OPENING'TAPE=4,     <<opening tape file>>            <<04659>>22122000
      WHY'SCANNING   = 5,     <<scanning files >>              <<04659>>22124000
      WHY'DOING      = 6,     <<doing actual STORE/RESTORE>>   <<04659>>22126000
                                                               <<04659>>22128000
         <<MAIL equates...>>                                   <<04659>>22130000
      MAIL'OVERALL   = 0,     <<overall result= GOOD/FAILED>>  <<04659>>22132000
      MAIL'WHY       = 1,     <<WHY error code (see below)>>   <<04659>>22134000
      MAIL'BAD       = 2,     <<mail message index>>           <<04659>>22136000
      MAIL'GOOD      = 3,     <<# of files STOREd/RESTOREd>>   <<04659>>22138000
                                                               <<04659>>22140000
      MAIL'LENGTH    = 4;     <<# of words in MAIL message>>   <<04659>>22142000
                                                               <<04659>>22144000
   LABEL                                                       <<04659>>22146000
      END'STORE'USER'FILES;                                    <<04659>>22148000
                                                               <<04659>>22150000
   <<-------->>                                                <<04659>>22152000
   <<  FAIL  >>                                                <<04659>>22154000
   <<-------->>                                                <<04659>>22156000
                                                               <<04659>>22158000
   SUBROUTINE FAIL (WHY, SUB'WHY);                             <<04659>>22160000
            VALUE   WHY, SUB'WHY;                              <<04659>>22162000
            INTEGER WHY, SUB'WHY;                              <<04659>>22164000
      BEGIN                                                    <<04659>>22166000
                                                               <<04659>>22168000
      ERROR'CODE:=WHY;                                         <<04659>>22170000
                                                               <<04659>>22172000
      ERROR'SUBCLASS:=SUB'WHY;                                 <<04659>>22174000
                                                               <<04659>>22176000
      GO END'STORE'USER'FILES;                                 <<04659>>22178000
                                                               <<04659>>22180000
      END <<FAIL SUB>>;                                        <<04659>>22182000
                                                               <<04659>>22184000
   <<---------------->>                                        <<04659>>22186000
   <<  PREPARE'INFO  >>                                        <<04659>>22188000
   <<---------------->>                                        <<04659>>22190000
                                                               <<04659>>22192000
   SUBROUTINE PREPARE'INFO;                                    <<04659>>22194000
                                                               <<04659>>22196000
      BEGIN                                                    <<04659>>22198000
                                                               <<04659>>22200000
      FILL' (INFO', INFO'LEN, CR);                             <<04659>>22202000
                                                               <<04659>>22204000
      IF NOT SYNTAX'ONLY THEN                                  <<04659>>22206000
         FFILEINFO (SYSTAPE, DEN'OPTION,  DENSITY,             <<04659>>22208000
                             LDEV'OPTION, LDEV);               <<04659>>22210000
                                                               <<04659>>22212000
            <<find first semicolon in STORE'FILES'...>>        <<04659>>22214000
                                                               <<04659>>22216000
      SCAN STORE'FILES' UNTIL CR'SEMI, 1;       <<leave addr>> <<04659>>22218000
      @POPTIONS:=TOS;                                          <<04659>>22220000
      LEN:=@POPTIONS-@STORE'FILES';                            <<04659>>22222000
                                                               <<04659>>22224000
         <<note: LEN > 0, due to code in GET'FILE'SUBSET and>> <<04659>>22226000
         <<in DUMPTAPE.>>                                      <<04659>>22228000
                                                               <<04659>>22230000
      MOVE INFO':="SYSDUMP ",2;                 <<leave addr>> <<04659>>22232000
      MOVE *:=STORE'FILES', (LEN), 2;           <<leave addr>> <<04659>>22234000
      MOVE *:=";*", 2;        <<append ";*">>                  <<04659>>22236000
      @PT:=TOS;               <<points after the ";*">>        <<04659>>22238000
                                                               <<04659>>22240000
      SCAN TAPEFILE UNTIL " ", 1;                              <<04659>>22242000
      LEN:=TOS-@TAPEFILE;     <<length of tape name>>          <<04659>>22244000
      MOVE PT:=TAPEFILE, (LEN), 2;                             <<04659>>22246000
            <<append semicolon after tape name...>>            <<04659>>22248000
      MOVE *:=";", 2;         <<leave address>>                <<04659>>22250000
      @PT:=TOS;                                                <<04659>>22252000
                                                               <<04659>>22254000
      IF SYNTAX'ONLY THEN                                      <<04659>>22256000
         BEGIN                                                 <<04659>>22258000
         MOVE PT:="SYNTAX;", 2;                                <<04659>>22260000
         @PT:=TOS;                                             <<04659>>22262000
         END;                                                  <<04659>>22264000
                                                               <<04659>>22266000
      IF SHOW THEN                                             <<04659>>22268000
         BEGIN                                                 <<04659>>22270000
         MOVE PT:="SHOW;", 2; <<leave dest addr>>              <<04659>>22272000
         @PT:=TOS;                                             <<04659>>22274000
         END;                                                  <<04659>>22276000
                                                               <<04659>>22278000
            <<append RECSIZE...>>                              <<04659>>22280000
                                                               <<04659>>22282000
      IF RECSIZE > 0 THEN                                      <<04659>>22284000
         BEGIN                                                 <<04659>>22286000
         MOVE PT:="RECSIZE=", 2;                               <<04659>>22288000
         @PT:=TOS;                                             <<04659>>22290000
         @PT:=@PT+ASCII (RECSIZE, 10, PT);                     <<04659>>22292000
         END;                                                  <<04659>>22294000
                                                               <<04659>>22296000
            <<append DENSITY...if non-zero...>>                <<04659>>22298000
                                                               <<04659>>22300000
      IF DENSITY <> 0 THEN                                     <<04659>>22302000
         BEGIN                                                 <<04659>>22304000
         MOVE PT:=";DENSITY=", 2;                              <<04659>>22306000
         @PT:=TOS;                                             <<04659>>22308000
         @PT:=@PT+ASCII (DENSITY, 10, PT);                     <<04659>>22310000
         END;                                                  <<04659>>22312000
                                                               <<04659>>22314000
            <<append LDEV...if non-zero...>>                   <<04659>>22316000
                                                               <<04659>>22318000
      IF LDEV <> 0 THEN                                        <<04659>>22320000
         BEGIN                                                 <<04659>>22322000
         MOVE PT:=";LDEV=", 2;                                 <<04659>>22324000
         @PT:=TOS;                                             <<04659>>22326000
         @PT:=@PT+ASCII (LDEV, 10, PT);                        <<04659>>22328000
         END;                                                  <<04659>>22330000
                                                               <<04659>>22332000
            <<append a semicolon...>>                          <<04659>>22334000
                                                               <<04659>>22336000
      PT:=";";                                                 <<04659>>22338000
      @PT:=@PT(1);                                             <<04659>>22340000
                                                               <<04659>>22342000
            <<append user's option list, if any...>>           <<04659>>22344000
                                                               <<04659>>22346000
      IF POPTIONS <> CR THEN                                   <<04659>>22348000
         BEGIN                                                 <<04659>>22350000
         SCAN POPTIONS UNTIL CR, 1;                            <<04659>>22352000
         LEN:=TOS-@POPTIONS;                                   <<04659>>22354000
         MOVE PT:=POPTIONS,(LEN), 2;                           <<04659>>22356000
         @PT:=TOS;                                             <<04659>>22358000
         END;                                                  <<04659>>22360000
                                                               <<04659>>22362000
      PT:=CR;                 <<append trailing return>>       <<04659>>22364000
      LEN:=@PT-@INFO';        <<length, without CR>>           <<04659>>22366000
                                                               <<04659>>22368000
      END <<PREPARE'INFO SUB>>;                                <<04659>>22370000
                                                               <<04659>>22372000
   <<--------------->>                                         <<04659>>22374000
   <<  START'STORE  >>                                         <<04659>>22376000
   <<--------------->>                                         <<04659>>22378000
                                                               <<04659>>22380000
   SUBROUTINE START'STORE;                                     <<04659>>22382000
                                                               <<04659>>22384000
      BEGIN                                                    <<04659>>22386000
                                                               <<04659>>22388000
            <<now, create the STORE process...>>               <<04659>>22390000
                                                               <<04659>>22392000
      MOVE PROGNAME' := "STORE.PUB.SYS ";                      <<04659>>22394000
                                                               <<04659>>22396000
      MOVE ITEMCODES := (  3, <<flags              >>          <<04659>>22398000
                          11, <<INFO string address>>          <<04659>>22400000
                          12, <<INFO string length >>          <<04659>>22402000
                           2, <<PARM>>                         <<04659>>22404000
                           0  <<item terminator    >>  );      <<04659>>22406000
                                                               <<04659>>22408000
      ITEMS(0) := 1;          <<flags>>                        <<04659>>22410000
      ITEMS(1) := @INFO';     <<INFO string address>>          <<04659>>22412000
      ITEMS(2) := LEN;        <<INFO string length>>           <<04659>>22414000
      ITEMS(3) := 4;          <<PARM meaning SYSDUMP>>         <<04659>>22416000
      ITEMS(4) := 0;          <<item terminator>>              <<04659>>22418000
                                                               <<04659>>22420000
      CREATEPROCESS (CPERR, PIN, PROGNAME', ITEMCODES, ITEMS); <<04659>>22422000
                                                               <<04659>>22424000
      IF < THEN               <<did it fail?>>                 <<04659>>22426000
         BEGIN                                                 <<04659>>22428000
         SCAN PROGNAME' UNTIL ".", 1;                          <<04659>>22430000
         MOVE *:=(0);         <<first period or null>>         <<04659>>22432000
               <<report the error...>>                         <<04659>>22434000
         IF UNKNOWN'PROG'FILE THEN                             <<04659>>22436000
            FAIL (S'ERR'UNKNOWN'PROGRAM, 0)                    <<04659>>22438000
         ELSE                                                  <<04659>>22440000
            FAIL (S'ERR'CREATEPROCESS, CPERR);                 <<04659>>22442000
         END                                                   <<04659>>22444000
                                                               <<04659>>22446000
      ELSE IF > THEN                                           <<04659>>22448000
         FAIL (S'ERR'CREATEPROCESS, CPERR);                    <<04659>>22450000
                                                               <<04659>>22452000
      END <<START'STORE SUB>>;                                 <<04659>>22454000
                                                               <<04659>>22456000
   <<------------------>>                                      <<04659>>22458000
   <<  WAIT'FOR'STORE  >>                                      <<04659>>22460000
   <<------------------>>                                      <<04659>>22462000
                                                               <<04659>>22464000
   SUBROUTINE WAIT'FOR'STORE;                                  <<04659>>22466000
                                                               <<04659>>22468000
      BEGIN                                                    <<04659>>22470000
                                                               <<04659>>22472000
            <<STORE.PUB.SYS created ok...activate it and    >> <<04659>>22474000
            <<wait for it to finish...>>                       <<04659>>22476000
                                                               <<04659>>22478000
      ACTIVATE (PIN, 0);          <<don't wait...keep on>>     <<04659>>22480000
                                                               <<04659>>22482000
      IF <> THEN                                               <<04659>>22484000
         FAIL (S'ERR'ACTIVATE, 0);                             <<04659>>22486000
                                                               <<04659>>22488000
      STATUS:=RECEIVEMAIL (PIN, REPLY'MSG, TRUE <<wait>>);     <<04659>>22490000
                                                               <<04659>>22492000
      IF STATUS <> 2 THEN     << 2 = got mail ok >>            <<04659>>22494000
         FAIL (S'ERR'MAIL, STATUS);                            <<04659>>22496000
                                                               <<04659>>22498000
      IF REPLY'MSG (MAIL'OVERALL) <> GOOD THEN                 <<04659>>22500000
         IF REPLY'MSG (MAIL'WHY) = WHY'SYNTAX THEN             <<04659>>22502000
            FAIL (S'ERR'SYNTAX, 0)                             <<04659>>22504000
         ELSE                                                  <<04659>>22506000
            FAIL (S'ERR'STORE'FAILED, REPLY'MSG(MAIL'WHY));    <<04659>>22508000
                                                               <<04659>>22510000
                                                               <<04659>>22512000
            <<if we get here, the STORE worked fine!>>         <<04659>>22514000
                                                               <<04659>>22516000
            <<Note that STORE has nothing left to do >>        <<04659>>22518000
            <<once it has sent MAIL to us...so we do >>        <<04659>>22520000
            <<not need to worry if it has gone away  >>        <<04659>>22522000
            <<yet.  If it has, fine; if not, our     >>        <<04659>>22524000
            <<termination will terminate it.         >>        <<04659>>22526000
                                                               <<04659>>22528000
                                                               <<04659>>22530000
      END <<WAIT'FOR'STORE SUB>>;                              <<04659>>22532000
   <<---------------------------->>                            <<04659>>22534000
                                                               <<04659>>22536000
   ERROR'CODE:=0;                                              <<04659>>22538000
   ERROR'SUBCLASS:=0;                                          <<04659>>22540000
                                                               <<04659>>22542000
   PREPARE'INFO;                                               <<04659>>22544000
                                                               <<04659>>22546000
   START'STORE;                                                <<04659>>22548000
                                                               <<04659>>22550000
   WAIT'FOR'STORE;                                             <<04659>>22552000
                                                               <<04659>>22554000
END'STORE'USER'FILES:                                          <<04659>>22556000
                                                               <<04659>>22558000
   END <<STORE'USER'FILES PROC>>;                              <<04659>>22560000
$PAGE "             SYSDUMP OUTER BLOCK"                       <<04659>>22562000
$CONTROL SEGMENT=SYSDUMP                                       <<01073>>22564000
          DEFAULT := FALSE;  << SYSDUMP ENTRY POINT >>         <<01210>>22566000
DEFAULTS: PUSH(STATUS);  << PDEFAULT ENTRY POINT >>            <<01210>>22568000
          TOS.(2:1) := 0;  <<DISABLE TRAPS>>                            22570000
          SET(STATUS);                                                  22572000
          INITIALIZATION;                                      <<01073>>22574000
          IF YESANSWER(2) THEN                                 <<01073>>22576000
           BEGIN      << TRUE IF CHANGES REQUESTED >>          <<01073>>22578000
            INITIALIZE'CH;                                     <<01073>>22580000
            DO                                                 <<01073>>22582000
             BEGIN                                             <<01073>>22584000
              TCLASS := 0;   << NO ENTRIES IN TEMPCLASS >>     <<01073>>22586000
              TCLASS(1) := 4;<< TEMPCLASS LENGTH IN BYTES >>   <<01073>>22588000
              WHILE YESANSWER(3) DO IO'CONFIG'CH;              <<01073>>22590000
             END                                               <<01073>>22592000
            UNTIL CHECKDEV;                                    <<01073>>22594000
            IF YESANSWER(24) THEN SYSTEM'TABLE'CH;             <<01073>>22596000
            IF YESANSWER(61) THEN MISC'CONFIG'CH;              <<01073>>22598000
            IF YESANSWER(75) THEN LOGGING'CH;                  <<01073>>22600000
            IF YESANSWER(35) THEN DISK'ALLOC'CH;               <<01073>>22602000
            IF YESANSWER(38) THEN SCHEDULING'CH;               <<01073>>22604000
            IF YESANSWER(39) THEN SEG'LIMIT'CH;                <<01073>>22606000
            IF YESANSWER(57) THEN SYSTEM'PROG'CH;              <<01073>>22608000
            IF YESANSWER(48) THEN SYSTEM'SL'CH;                <<01073>>22610000
            IF DEFAULT THEN BUILD'MPECHECK;                    <<01210>>22612000
           END;                                                <<01073>>22614000
          IF GETDUMPDATE THEN                                  <<01073>>22616000
           BEGIN      << TRUE IF DUMP DATE SUPPLIED >>         <<01073>>22618000
            GET'FILE'SUBSET;                                   <<01073>>22620000
            IF YESANSWER(82) THEN <<LIST FILES DUMPED?>>       <<01073>>22622000
             LISTFILES := TRUE;                                <<01073>>22624000
            END                                                <<04659>>22626000
          ELSE                                                 <<04659>>22628000
            MOVE STORE'FILES':="NOFILES-NOFILES";              <<04659>>22630000
                                                               <<04659>>22632000
          DUMPTAPE(LISTFILES);                                 <<01073>>22634000
          LIST'SYS'FILES;                                      <<01073>>22636000
         END.                                                  <<01073>>22638000
