$CONTROL USLINIT, CODE, MAP                                             00010000
                                                                        00014000
<<------------------------------------------------------------->>       00016000
<<                                                             >>       00018000
<<                    MPE Segmenter Process                    >>       00020000
<<                     SEGPROC (Moduel 02)                     >>       00022000
<<                                                             >>       00024000
<<                       Version A.01.07                       >>       00026000
<<                      January 15,  1982                      >>       00028000
<<                                                             >>       00030000
<<------------------------------------------------------------->>       00032000
                                                                        00034000
$COPYRIGHT "(C) COPYRIGHT HEWLETT-PACKARD COMPANY 1981.  ",  &          00036000
$          "THIS PROGRAM MAY BE USED WITH ONE COMPUTER ",    &          00038000
$          "SYSTEM AT A TIME AND SHALL NOT OTHERWISE BE ",   &          00040000
$          "RECORDED, TRANSMITTED OR STORED IN A RETRIEVAL ",&          00042000
$          "SYSTEM.  COPYING OR OTHER REPRODUCTION OF THIS ",&          00044000
$          "PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS ",       &          00046000
$          "PROHIBITED WITHOUT THE PRIOR WRITTEN CONSENT ",  &          00048000
$          "OF HEWLETT-PACKARD COMPANY."                                00050000
                                                                        00052000
$TITLE "       MPE SEGMENTER PROCESS - JANUARY 15, 1982"                00054000
$CONTROL MAIN = SEGPROC                                                 00056000
$CONTROL SEGMENT = SEG1                                                 00058000
                                                                        00060000
begin                                                                   00062000
$PAGE                                                                   00064000
<<------------------------------------------------------------->>       00066000
<<                                                             >>       00068000
<< Quit Codes.                                                 >>       00070000
<<                                                             >>       00072000
<<------------------------------------------------------------->>       00074000
<<                                                             >>       00076000
<<    0  End of file or I/O error.                             >>       00078000
<<    1  Illegal directory entry in USL file.                  >>       00080000
<<    2  Illegal code header in USL file.                      >>       00082000
<<    3  Insufficient DL storage.                              >>       00084000
<<    4  Unable to receive mail from SEGMENTER father process. >>       00086000
<<    5  Unable to send mail to SEGMENTER father process.      >>       00088000
<<                                                             >>       00090000
<<------------------------------------------------------------->>       00092000
                                                                        00094000
<<MISC. DECLARATIONS>>                                                  00096000
                                                                        00098000
EQUATE CCG = 0,  <<"GREATER THAN" CONDITION CODE>>                      00100000
       CCL = 1,  <<"LESS THAN" CONDITION CODE>>                         00102000
       CCE = 2;  <<"EQUAL" CONDITION CODE>>                             00104000
DEFINE SETBIT0 = ASSEMBLE(TSBC 0)#,                                     00106000
       SETBIT1 = ASSEMBLE(TSBC 1)#,                                     00108000
       SETBIT15 = ASSEMBLE(TSBC 15)#,                                   00110000
       TESTBIT1 = ASSEMBLE(TBC 1)#;                                     00112000
DEFINE TURNOFFTRAPS = PUSH(STATUS); TOS.(2:1) _ 0; SET(STATUS)#,        00114000
       TURNONTRAPS = PUSH(STATUS); TOS.(2:1) _ 1; SET(STATUS)#;         00116000
BYTE BS0 = S-0;                                                         00118000
BYTE BS1 = S-1;                                                         00120000
BYTE BS2 = S-2;                                                         00122000
BYTE BS3 = S-3;                                                         00124000
INTEGER S0 = S-0;                                                       00126000
INTEGER S1 = S-1;                                                       00128000
INTEGER S2 = S-2;                                                       00130000
INTEGER S3 = S-3;                                                       00132000
INTEGER S4 = S-4;                                                       00134000
INTEGER S5 = S-5;                                                       00136000
INTEGER S6 = S-6;                                                       00138000
INTEGER S8=S-8;                                                <<00595>>00140000
LOGICAL LS0 = S-0;                                                      00142000
LOGICAL LS1 = S-1;                                                      00144000
DOUBLE DS1 = S-1;                                                       00146000
DOUBLE DS2 = S-2;                                                       00148000
DOUBLE DS3 = S-3;                                                       00150000
DOUBLE DS4 = S-4;                                                       00152000
DOUBLE DS5 = S-5;                                                       00154000
DOUBLE DS6 = S-6;                                                       00156000
BYTE POINTER BPS0 = S-0;                                                00158000
BYTE POINTER BPS1 = S-1;                                                00160000
BYTE POINTER BPS2 = S-2;                                                00162000
BYTE POINTER BPS3 = S-3;                                                00164000
BYTE POINTER BPS4 = S-4;                                                00166000
BYTE POINTER BPS5 = S-5;                                                00168000
INTEGER POINTER PS0 = S-0;                                              00170000
INTEGER POINTER PS1 = S-1;                                              00172000
INTEGER POINTER PS2 = S-2;                                              00174000
INTEGER POINTER PS3 = S-3;                                              00176000
LOGICAL POINTER LPS0 = S-0;                                             00178000
LOGICAL POINTER LPS1 = S-1;                                             00180000
LOGICAL POINTER LPS2 = S-2;                                             00182000
DOUBLE POINTER DPS0 = S-0;                                              00184000
DOUBLE POINTER DPS1 = S-1;                                              00186000
DOUBLE POINTER DPS2 = S-2;                                              00188000
DOUBLE POINTER DPS3 = S-3;                                              00190000
INTEGER ARRAY AS0 (*) = S-0;                                            00192000
INTEGER ARRAY AS1 (*) = S-1;                                            00194000
INTEGER ARRAY AS2 (*) = S-2;                                            00196000
INTEGER ARRAY AS3 (*) = S-3;                                            00198000
INTEGER XREG = X;  <<X REGISTER>>                                       00200000
LOGICAL LXREG = X;  <<X REGISTER>>                                      00202000
INTEGER STATUS = Q-1;  <<STATUS WORD OF STACK MARKER>>                  00204000
DEFINE CONDCODE = STATUS.(6:2)#;  <<COND. CODE BITS IN STATUS>>         00206000
                                                                        00208000
<<MISC. CONSTANTS>>                                                     00210000
                                                                        00212000
INTEGER RECSIZE _ 128;  <<RECORD SIZE>>                                 00214000
DOUBLE BIGD _ %17777777777D;                                            00216000
DOUBLE P256D _ 256D;                                                    00218000
DOUBLE P128D _ 128D;                                                    00220000
DOUBLE M1D _ -1D;                                                       00222000
INTEGER P256 = P256D+1;                                                 00224000
INTEGER P384 _ 384;                                                     00226000
BYTE ARRAY NULL(0:0) _ %0;                                              00228000
INTEGER ARRAY BLANKCOMMON (0:2) _ "4COM' ";                             00230000
INTEGER ARRAY TRAPCOM' (0:4) := "8TRAPCOM' ";                  <<00.BV>>00232000
LOGICAL USERMODE;                                                       00234000
DEFINE INTERACTIVE = USERMODE#;  <<INTERACTIVE?>>                       00236000
DOUBLE USERCAP;  <<USER'S CAPABILITY>>                                  00238000
LOGICAL USERCAP1 = USERCAP;  <<USER'S FUNCTIONAL CAPABILITIES>>         00240000
LOGICAL USERCAP2 = USERCAP+1;  <<USER'S RESOURCE CAPABILITIES>>         00242000
EQUATE ENABLE'CTLY  = 17;                                      <<00.DM>>00244000
EQUATE DISABLE'CTLY = 16;                                      <<00.DM>>00246000
                                                                        00248000
<<CONFIGURATION PARAMETERS>>                                            00250000
                                                                        00252000
INTEGER ARRAY CONFIG(0:2);                                     <<00.DM>>00254000
INTEGER SDBMAXCODE1 = DB+35, <<MAX. CODE SEGMENT SIZE>>        <<00.DM>>00256000
        SDBDEFAULTSTK1 = DB+39, <<MIN. STACK SIZE>>            <<00.DM>>00258000
        SDBMAXCODE2 = DB+%105, <<MAX. CODE SEGMENT SIZE>>      <<00.DM>>00260000
        SDBDEFAULTSTK2 = DB+%110; <<MIN. STACK SIZE>>          <<00.DM>>00262000
DEFINE  SDBMAXCODE      = CONFIG(1)#,                          <<00.DM>>00264000
        SDBDEFAULTSTACK = CONFIG(2)#;                          <<00.DM>>00266000
                                                                        00268000
<<SYSTEM PARAMETERS>>                                                   00270000
                                                                        00272000
EQUATE CPCB = 4,                                                        00274000
       PCBB = 3,                                               <<00.EB>>00276000
       PCBSIZE1 = 11,                                          <<00.DM>>00278000
       PCBSIZE2 = 16,                                          <<00.DM>>00280000
       FIRSTSTT = 1;                                                    00282000
DEFINE FATHERPIN = ABSOLUTE(ABSOLUTE(CPCB)+5)&LSR(8)#;                  00284000
DEFINE PCBSIZE = CONFIG#;                                      <<00.DM>>00286000
                                                                        00288000
<<MISC. MAPS>>                                                          00290000
                                                                        00292000
BYTE ARRAY MAP10 (2:8) := 1,2,3,4,0,0,4;  <<USL TYPE TO SYM. TYPE>>     00294000
BYTE ARRAY MAP11 (1:11) := 4,2,4,2,2,2,1,6,4,6,4;  <<SYM. TAB. LENGHTS>>00296000
BYTE ARRAY MAP12 (0:8) := 3,0,1,2,1,2,0,0,2;  <<USL ENTRY LEVELS>>      00298000
LOGICAL BITMAP1 := %(2)1111111011001111;  <<ILLEGAL ENT'S FOR SL>>      00300000
LOGICAL BITMAP3 _ %(2)0000000000010110;  <<ENT'S WITH SONS>>            00302000
LOGICAL BITMAP4 := %(2)0000000100111101;  <<ENT'S WITH FATHERS>>        00304000
LOGICAL BITMAP5 _ %(2)0000000001010100;  <<ENT'S WITH CODE>>            00306000
LOGICAL BITMAP6 _ %(2)0000000011010100;  <<ENT'S WITH HEADERS>>         00308000
logical BitMap7 := %(2)1111011011000000; << ScanSegment headers<<04102>>00310000
logical BitMap9 := %(2)1111101110011110; << Headers for PREP >>         00312000
LOGICAL BITMAP10 := %(2)0000000100111100;  <<ENT'S WITH SEG. NAMES>>    00314000
LOGICAL BITMAP12 := %(2)0000000100111110;  <<SEG. COPIES NEEDED?>>      00316000
<< Status codes returned by procedures: >>                     <<04102>>00318000
                                                               <<04102>>00320000
equate                                                         <<04102>>00322000
   STATUS'OK = 0,                 << No errors detected >>     <<04102>>00324000
   STATUS'BAD = 1;                << Procedure failed >>       <<04102>>00326000
                                                               <<04781>>00328000
   EQUATE        TEMPFILE = 2,                                 <<04781>>00330000
                 SAVE     = 1,                                 <<04781>>00332000
                 DELETE   = 4,                                 <<04781>>00334000
                 NOCHANGE = 0,                                 <<04781>>00336000
                 DUP'NAME = 100;                               <<04781>>00338000
$PAGE "ERROR AND WARNING MESSAGE CODES"                                 00340000
<<********************************************************************>>00342000
<<                                                                    >>00344000
<<   Error and Warning Message Codes                                  >>00346000
<<                                                                    >>00348000
<<********************************************************************>>00350000
                                                                        00352000
equate                                                                  00354000
                                                                        00356000
   << USL file messages: >>                                             00358000
                                                                        00360000
   MSG'BADENTRY          = 0,                                           00362000
   MSG'BADHEADER         = 1,                                           00364000
   MSG'MAXDIROVERFLOW    = 2,                                           00366000
   MSG'DIROVERFLOW       = 3,                                           00368000
   MSG'INFOOVERFLOW      = 4,                                           00370000
   MSG'NOUSL             = 5,                                           00372000
   MSG'BADUSLSPEC        = 6,                                           00374000
   MSG'CANTOPENUSL       = 7,                                           00376000
   MSG'BADUSL            = 8,                                           00378000
   MSG'CANTCLOSEUSL      = 9,                                           00380000
                                                                        00382000
   << SL file messages, part 1 of 2: >>                                 00384000
                                                                        00386000
   MSG'CANTCLOSESL       = 10,                                          00388000
   MSG'FILEFULL          = 11,                                          00390000
   MSG'DUPLICATEENTRYPT  = 12,                                          00392000
   MSG'NONPROCINSEGMENT  = 13,                                          00394000
   MSG'GLOBALINSEGMENT   = 14,                                          00396000
   MSG'DUPLICATESEGMENT  = 15,                                          00398000
   MSG'NOSL              = 16,                                          00400000
   MSG'BADSLSPEC         = 17,                                          00402000
   MSG'CANTOPENSL        = 18,                                          00404000
   MSG'BADSL             = 19,                                          00406000
                                                                        00408000
   << RL file messages: >>                                              00410000
                                                                        00412000
   MSG'BADRLSPEC         = 20,                                          00414000
   MSG'NORL              = 21,                                          00416000
   MSG'BADRL             = 22,                                          00418000
   MSG'CANTCLOSERL       = 23,                                          00420000
   MSG'NOPROCENTRY       = 28,                                          00422000
   MSG'CANTOPENRL        = 30,                                          00424000
                                                                        00426000
   << Program preparation messages, part 1 of 2: >>                     00428000
                                                                        00430000
   MSG'BADPROGFILE       = 32,                                          00432000
   MSG'BADCAPSPEC        = 33,                                          00434000
   MSG'MULTIPLEEXTENTS   = 34,                                          00436000
   MSG'NOPROGTOPREP      = 35,                                          00438000
   MSG'CANTCLOSEPROGFILE = 36,                                          00440000
   MSG'CANTOPENPROGFILE  = 37,                                          00442000
   MSG'DATASEGOVERFLOW   = 38,                                          00444000
   MSG'TOOMANYCODESEGS   = 39,                                          00446000
                                                                        00448000
   << Segment preparation messages: >>                                  00450000
                                                                        00452000
   MSG'CODESEGOVERFLOW   = 40,                                          00454000
   MSG'STTOVERFLOW       = 41,                                          00456000
   MSG'NOSEGENTRY        = 42,                                          00458000
   MSG'CANTACCESSPROC    = 43,                                          00460000
   MSG'PRIVMODEREQUIRED  = 44,                                          00462000
   MSG'PARMCHECKERROR    = 45,                                   <<+08>>00464000
   MSG'FATALINPROGUNIT   = 46,                                          00466000
   MSG'WARNINGINPROGUNIT = 47,                                          00468000
   MSG'CODESEGOVFLOPOSS  = 48,                                          00470000
   MSG'FUNCTIONSINCOMPAT = 49,                                 <<04102>>00472000
   MSG'PARMCOUNTERROR    = 50,                                 <<04102>>00474000
                                                                        00476000
   << Program preparation messages, part 2 of 2: >>                     00478000
                                                                        00480000
   MSG'NOOUTERBLOCK      = 60,                                          00482000
   MSG'EXTRAOUTERBLOCKS  = 61,                                          00484000
   MSG'EXTRAOBENTRIES    = 62,                                          00486000
   MSG'EXTVARNOTGLOBAL   = 63,                                          00488000
   MSG'EXTVARINCOMPAT    = 64,                                          00490000
   MSG'COMMONOVERFLOW    = 66,                                          00492000
   MSG'COMMONSIZEERROR   = 67,                                          00494000
   MSG'NOCOMFORBLOCKDATA = 68,                                          00496000
   MSG'BDATAINCOMPATWCOM = 69,                                          00498000
   MSG'BADSTACKSIZE      = 70,                                          00500000
   MSG'BADDLSIZE         = 71,                                          00502000
   MSG'BADMAXDATA        = 72,                                          00504000
   MSG'DUPACTIVENAME     = 73,                                          00506000
   MSG'CANTPREPSYMDEBUG  = 74,                                 <<04102>>00508000
   MSG'PFILETOOSMALL     = 75,                                 <<04781>>00510000
                                                                        00512000
   << Miscellaneous messages: >>                                        00514000
                                                                        00516000
   MSG'STORAGEOVERFLOW   = 80,                                          00518000
   MSG'BADPATCH          = 81,                                          00520000
   MSG'CANTOPENSCRATCH   = 82,                                          00522000
   MSG'CANTOPENLIST      = 83,                                          00524000
   MSG'UNEXPECTEDIOERR   = 84,                                          00526000
   MSG'ITEMDIFFROMCLASS  = 86,                                          00528000
   MSG'ITEMNOTPRIMARYENT = 87,                                          00530000
   MSG'INCOMPATIBLEITEM  = 88,                                          00532000
   MSG'BADCLASS          = 89,                                          00534000
   MSG'CANTLOCATEITEM    = 93,                                          00536000
   MSG'UNEXPECTEDEOF     = 94,                                 <<04102>>00538000
   MSG'BADCOPYFACTOR     = 95,                                 <<04102>>00540000
   MSG'BADFILEACCESS     = 96,                                 <<04102>>00542000
   MSG'CANTCLOSESCRATCH  = 97,                                 <<04102>>00544000
   MSG'NOPMAP           = 98,                                  <<04584>>00546000
   MSG'REQSMCAP         = 99,                                  <<04584>>00548000
                                                                        00550000
   << SL file messages, part 2 of 2: >>                                 00552000
                                                                        00554000
   MSG'SEGMENTLOADED     = 110,                                         00556000
   MSG'EXTERNALVARINSEG  = 111,                                         00558000
   MSG'COMMONINSEG       = 112,                                         00560000
   MSG'LOGICALUNITSINSEG = 113,                                         00562000
   MSG'CANTFREEZESEG     = 114,                                <<04102>>00564000
                                                                        00566000
   << Auxiliary USL file messages: >>                                   00568000
                                                                        00570000
   MSG'NOAUXUSL          = 120,                                         00572000
   MSG'CANTOPENNEWUSL    = 121,                                <<04102>>00574000
   MSG'DUPLICATEFILENAME = 122;                                <<04102>>00576000
$PAGE "DL AREA BUFFERS AND PARAMETERS"                                  00578000
<<----------------------------------------------------------------------00580000
*                                                                      *00582000
*  DL AREA BUFFERS AND PARAMETERS                                      *00584000
*                                                                      *00586000
---------------------------------------------------------------------->>00588000
                                                                        00590000
EQUATE SYSTEMDL = 10,  <<NR. WORDS RESERVED DL AREA RESERVED FOR MPE>>  00592000
       DLINCREMENT = 512;  <<NR. WORDS BY WHICH DL IS EXPANDED>>        00594000
INTEGER POINTER DLAREA1 _ -SYSTEMDL;  <<DL USED AREA 1 POINTER>>        00596000
INTEGER POINTER DLAREA2;  <<DL USED AREA 2 POINTER>>                    00598000
INTEGER POINTER DLAVAIL;  <<DL AVAILABLE AREA POINTER>>                 00600000
$PAGE "COMMAND INTERPRETER BUFFER"                             <<00207>>00602000
<<----------------------------------------------------------------------00604000
*                                                                      *00606000
*  COMMAND INTERPRETER BUFFER                                          *00608000
*                                                                      *00610000
---------------------------------------------------------------------->>00612000
                                                                        00614000
EQUATE MAILLENGTH = 59,  <<BUFFER LENGTH>>                     <<00629>>00616000
       MAILBND = MAILLENGTH-1,  <<BUFFER BOUND>>                        00618000
       AUXMAILLENGTH = 7,  <<BUFFER LENGTH>>                   <<00629>>00620000
       AUXMAILBND = AUXMAILLENGTH-1;  <<BUFFER BOUND>>                  00622000
INTEGER ARRAY COMBUF (0:MAILBND);  <<COMMAND BUFFER>>                   00624000
INTEGER ARRAY AUXCOMBUF (0:AUXMAILBND) = DB;  <<AUX. COMMAND BUFFER>>   00626000
INTEGER NUM0 = AUXCOMBUF;                                               00628000
INTEGER NUM1 = AUXCOMBUF+1;                                             00630000
INTEGER NUM2 = AUXCOMBUF+2;                                             00632000
INTEGER NUM3 = AUXCOMBUF+3;                                             00634000
INTEGER NUM4 = AUXCOMBUF+4;                                             00636000
INTEGER NUM5 = AUXCOMBUF+5;                                             00638000
INTEGER NUM6 = AUXCOMBUF+6;                                    <<00629>>00640000
INTEGER ARRAY STRING1 (*) = COMBUF(7);                         <<00629>>00642000
BYTE ARRAY BSTRING1 (*) = COMBUF(7);                           <<00629>>00644000
INTEGER ARRAY STRING2 (*) = COMBUF(15);                        <<00629>>00646000
BYTE ARRAY BSTRING2 (*) = COMBUF(15);                          <<00629>>00648000
BYTE ARRAY BFNAME1 (*) = COMBUF(23);                           <<00629>>00650000
BYTE ARRAY BFNAME2 (*) = COMBUF(41);                           <<00629>>00652000
                                                                        00654000
INTEGER COMMAND = NUM0;                                                 00656000
INTEGER ERRORNR = NUM0;                                                 00658000
INTEGER INDEX = NUM1;                                                   00660000
INTEGER FILESIZE = NUM1;                                                00662000
INTEGER INITSTACK = NUM1;                                               00664000
INTEGER NREXTENTS = NUM2;                                               00666000
INTEGER INITDL = NUM2;                                                  00668000
LOGICAL FLAGS = NUM3;                                                   00670000
INTEGER INITMAXDATA = NUM4;                                             00672000
INTEGER CAPABILITY = NUM5;                                              00674000
INTEGER INITPATCH = NUM6;                                      <<00629>>00676000
INTEGER ARRAY NAME (*) = STRING1;                                       00678000
BYTE ARRAY BNAME (*) = BSTRING1;                                        00680000
INTEGER ARRAY SEGNAME (*) = STRING2;                                    00682000
BYTE ARRAY BSEGNAME (*) = BSTRING2;                                     00684000
BYTE ARRAY BFILENAME (*) = BFNAME1;                                     00686000
BYTE ARRAY RLIBFNAME (*) = BFNAME2;                                     00688000
BYTE ARRAY PROGNAME(*)=BFNAME1,                                <<04584>>00690000
           SEG'PROCNAME(*)=BFNAME2;                            <<04584>>00692000
LOGICAL SETSYSTEM = NUM1,                                      <<04584>>00694000
        SETUNCOND = NUM2,                                      <<04584>>00696000
        SETOFF    = NUM4;                                      <<04584>>00698000
EQUATE NOERROR = -1,                                                    00700000
       SOFTERROR = 1,                                                   00702000
       HARDERROR = 0;                                                   00704000
DEFINE ALLOCATESEG = FLAGS.(0:1)#,  <<PERM. ALLOCATE SEGMENT?>>         00706000
       CORESEG = FLAGS.(1:1)#,  <<CORE RESIDENT SEGMENT?>>              00708000
       SYSTEMSEG = FLAGS.(2:1)#,  <<SYSTEM SEGMENT?>>                   00710000
       NoSym     = Flags.(9:1)#,  << PREP without sym debug? >><<04102>>00712000
       FPMAP = FLAGS.(8:1)#,                                   <<04102>>00714000
       NOFPMAP = FLAGS.(7:1)#,                                 <<04102>>00716000
       CHECKSUMSPECIFIED = FLAGS.(6:1)#,                       <<04257>>00718000
       LDSEG = FLAGS.(10:1)#, <<LOADED SEGMENT>>               <<00.EB>>00720000
       INHIBITFILEEQ = FLAGS.(11:1)#,  <<INHIBIT FILE EQUATION?>>       00722000
       CLASS = INTEGER(FLAGS.(12:2))#,  <<ENTRY CLASS>>                 00724000
       ZERODB = FLAGS.(14:1)#,                                          00726000
       LIST = FLAGS#;                                                   00728000
EQUATE SEGCLASS = 0,                                                    00730000
       UNITCLASS = 1,                                                   00732000
       ENTRYCLASS = 2;                                                  00734000
SWITCH COMSWITCH _ ADDRL,ADDSL,AUXUSL,BUILDRL,BUILDSL,BUILDUSL,CEASE,   00736000
       COPY,EXIT',HIDE,LISTRL,LISTSL,LISTUSL,NEWSEG,PREPARE,            00738000
       PURGERBM,PURGERL,PURGESL,REVEAL,RL,SL,USE,USL,DEBUG',   <<00207>>00740000
       COPYSL,COPYUSL,CLEANSL,CLEANUSL',PREPARE,LISTAUX,       <<04584>>00742000
       SHOW,LISTPMAP,SETFPMAP;                                 <<04584>>00744000
$PAGE "LIST FILE BUFFERS AND PARAMETERS"                       <<00207>>00746000
<<----------------------------------------------------------------------00748000
*                                                                      *00750000
* LIST FILE BUFFERS AND PARAMETERS                                     *00752000
*                                                                      *00754000
---------------------------------------------------------------------->>00756000
                                                                        00758000
INTEGER LISTFNUM _ 0;  <<FILE NR.>>                                     00760000
BYTE ARRAY LISTDESIG (0:7) _ "SEGLIST ";  <<FILE DESIGNATOR>>           00762000
INTEGER LISTWIDTH;  <<LINE WIDTH>>                                      00764000
ARRAY LINE (0:65) _ 66("  ");  <<LINE BUFFER>>                          00766000
BYTE ARRAY BLINE (*) = LINE;                                            00768000
$PAGE "SEGMENT AND PROGRAM PREPARATION ARRAYS AND PARAMENTERS" <<00207>>00770000
<<----------------------------------------------------------------------00772000
*                                                                      *00774000
*  SEGMENT AND PROGRAM PREPARATION ARRAYS AND PARAMETERS               *00776000
*                                                                      *00778000
---------------------------------------------------------------------->>00780000
                                                                        00782000
<<SYMBOL TABLE>>                                                        00784000
                                                                        00786000
INTEGER POINTER STABLE;  <<SYMBOL TABLE POINTER>>                       00788000
INTEGER POINTER SYMBOL;  <<SYMBOL TABLE HASH LIST HEADS>>               00790000
INTEGER USEDSYMBOL;  <<NR. WORDS USED FOR SYMBOL ENTRIES>>              00792000
                                                                        00794000
<<SYMBOL TABLE ENTRY PARAMETERS>>                                       00796000
                                                                        00798000
INTEGER POINTER SYMP;  <<POINTS TO FIRST WORD OF SYM. TAB. ENTRY>>      00800000
INTEGER POINTER SYMP1;  <<POINTS TO WORD FOLLOWING ENTRY NAME>>         00802000
INTEGER POINTER SYMP2;  <<SECONDARY POINTER>>                           00804000
INTEGER SYMNW;  <<NR. WORDS IN SYM. TAB. ENTRY>>                        00806000
INTEGER SYMNC;  <<NR. CHAR'S IN SYM. TAB. ENTRY NAME>>                  00808000
INTEGER SYMNAMENW;  <<NR. WORDS FOR SYM. TAB. ENTRY NAME>>              00810000
INTEGER SYMTYPE;  <<SYM. TAB. ENTRY TYPE NUMBER>>                       00812000
                     << 11111          1 >>                    <<04102>>00816000
                     << 5432109876543216 >>                    <<04102>>00818000
equate SymAny     = %(2)1111111111111111;                      <<04554>>00820000
equate SymOb      = %(2)0000000000000110;                      <<04102>>00822000
equate SymProc    = %(2)0000001110011000;                      <<04102>>00824000
equate SymGlobal  = %(2)0000000000100000;                      <<04102>>00826000
equate SymCommon  = %(2)0000000001000000;                      <<04102>>00828000
equate SymRlProc  = %(2)0000111110000000;                      <<04102>>00830000
DEFINE SNW = SYMP.(0:10)#,  <<NR. WORDS IN ENTRY>>             <<01124>>00832000
       STYPE = SYMP.(10:6)#,  <<ENTRY TYPE NR.>>               <<01124>>00834000
       SHL = SYMP(1)#,  <<HASH LIST POINTER>>                           00836000
       SUNCALLABLE = (LOGICAL(SYMP(2).(1:1)))#,  <<UNCALLABLE?>>        00838000
       SPRIVILEGED = (LOGICAL(SYMP(2).(2:1)))#,  <<PRIV. INST.?>>       00840000
       SHIDDEN = (LOGICAL(SYMP(2).(3:1)))#,  <<HIDDEN ENTRY POINT?>>    00842000
       SNC = SYMP(2).(4:4)#,  <<NR. CHAR'S IN NAME>>                    00844000
       SNAME = SYMP(2)#,  <<ENTRY NAME>>                                00846000
       SPLABEL = SYMP1#,  <<PROC. ENTRY PT. P-LABEL>>                   00848000
       SSTTNR = SYMP1.(0:8)#,  <<PROC. ENTRY PT. STT NR.>>              00850000
       SSEGNR = SYMP1.(8:8)#,  <<PROC. ENTRY PT. SEG. NR.>>             00852000
       SGTN = SYMP1#,  <<GLOB. VAR. DATA DESCRIPTOR>>                   00854000
       SSACA = SYMP1#,  <<S.A. OF COMMON ARRAY>>                        00856000
       SXNL = SYMP1#,  <<NR. P-LABELS FOR EXTERNAL PROC.>>              00858000
       SSACODE = SYMP1(1)#,  <<S.A. OF PROG. UNIT>>                     00860000
       SXSTTNR = SYMP1(1)#,  <<STT NR. OF P-LABEL FOR PROC.>>           00862000
       SGDBA = SYMP1(1)#,  <<GLOB. VAR. PRIM. DB ADDRESS>>              00864000
       SNWCA = SYMP1(1)#,  <<NR. WORDS IN COMMON ARRAY>>                00866000
       SSAPUST = SYMP1(2)#,  <<S.A. OF PUST>>                           00868000
       SRLINDEX = SYMP1(2)#,  <<RL TABLE ENTRY INDEX>>                  00870000
       SSASDB = SYMP1(3)#,  <<S.A. OF SEC. DB ARRAY>>                   00872000
       SRLCODE = SYMP2(-2)#,  <<NR. WORDS IN RL CODE MODULE>>           00874000
       SRLFATAL = (LOGICAL(SYMP2(-2).(0:1)))#,  <<FATAL ERROR?>>        00876000
       SRLWARNING = (LOGICAL(SYMP2(-2).(1:1)))#,  <<NON-FATAL ERROR?>>  00878000
       SRLNWC = SYMP2(-2).(2:14)#,  <<NR. WORDS CODE MODULE>>           00880000
       SRLENTRY = SYMP2(-1)#,  <<RL CODE MODULE ENTRY ADDRESS>>         00882000
       SXLPLABEL = SYMP2(-1)#,  <<LAST P-LABEL FOR EXTERNAL PROC.>>     00884000
       SXLSTTNR = SYMP2(-1).(0:8)#,  <<STT NR. OF LAST P-LABEL>>        00886000
       SXLSEGNR = SYMP2(-1).(8:8)#,  <<SEG. NR. OF LAST P-LABEL>>       00888000
       SPARMS = SYMP2#,  <<PROC. PARM. INFO>>                           00890000
       SXPARMS = SYMP2#;  <<EXTERNAL PROC. PARM. INFO>>                 00892000
                                                                        00894000
<<PATCH TABLE>>                                                         00896000
                                                                        00898000
INTEGER POINTER PTABLE;  <<PATCH TABLE POINTER>>                        00900000
INTEGER POINTER PATCH;  <<PATCH TABLE RECORD LIST HEADS>>               00902000
INTEGER USEDPATCH _ 0;  <<NR. WORDS IN PATCH TABLE>>                    00904000
                                                                        00906000
<<PATCH TABLE ENTRY PARAMETERS>>                                        00908000
                                                                        00910000
INTEGER POINTER PATCHP;  <<PATCH ENTRY POINTER>>                        00912000
DOUBLE POINTER PATCHDP = PATCHP;                                        00914000
                                                                        00916000
<<RL PROCEDURE TABLE>>                                                  00918000
                                                                        00920000
INTEGER POINTER RLTABLE;  <<RL TABLE POINTER>>                          00922000
INTEGER POINTER RLENTP;  <<RL ENTRY POINTER>>                           00924000
DOUBLE POINTER RLENTDP = RLENTP;                                        00926000
INTEGER NRRLENT _ 0;  <<NR. ENTRIES IN RL TABLE>>                       00928000
                                                               <<04780>>00930000
<<RL SEGMENT ENTRY, USED TO GENERATE ERROR MSG  >>             <<04780>>00932000
<<WHEN SEGMENT NAME IS NEEDED TO OUTPUT         >>             <<04780>>00934000
                                                               <<04780>>00936000
BYTE ARRAY RLSEG'(0:9):=0,0,0,0    <<DON'T CARE>>              <<04780>>00938000
                        ,5,"RLSEG";                            <<04780>>00940000
INTEGER ARRAY RLSEG(*) = RLSEG';                               <<04780>>00942000
                                                                        00944000
<<COMMON DATA LABEL TABLE>>                                             00946000
                                                                        00948000
INTEGER POINTER COMMON;  <<COMMON HASH LIST HEADS>>                     00950000
INTEGER POINTER COMTAB;  <<COMMON DATA LABEL TABLE>>                    00952000
DOUBLE POINTER COMTABD = COMTAB;                                        00954000
                                                                        00956000
<<COMMON TABLE ENTRY PARAMETERS>>                                       00958000
                                                                        00960000
EQUATE BND4 = 18,  <<COMMON DATA LABEL TABLE BOUND>>                    00962000
       COMHASH = BND4+1;  <<HASHING DIVISOR>>                           00964000
INTEGER POINTER COMP;  <<ENTRY POINTER>>                                00966000
DOUBLE POINTER COMPD = COMP;  <<ENTRY POINTER>>                         00968000
INTEGER NRCOMENT;  <<NR. OF COMMON TABLE ENTRIES>>                      00970000
                                                                        00972000
<<LOGICAL UNIT TABLE>>                                                  00974000
                                                                        00976000
LOGICAL POINTER LOGICALUNITS;  <<LOGICAL UNIT BIT ARRAY>>               00978000
LOGICAL LUSPECIFIED;  <<LOGICAL UNIT SPECIFIED?>>                       00980000
                                                                        00982000
<<TRACE PARAMETERS>>                                                    00984000
                                                                        00986000
EQUATE NWSTLTPREFACE = 17;  <<NR. WORDS IN STLT PREFACE>>               00988000
INTEGER SASTLT;  <<S.A. OF STLT>>                                       00990000
INTEGER NWSTLT;  <<NR. WORDS IN STLT>>                                  00992000
INTEGER OBPUSTADR;  <<O. B. PUST ADDRESS>>                              00994000
INTEGER POINTER PUSTBUF;  <<PUST BUFFER>>                               00996000
DOUBLE POINTER PUSTDBUF = PUSTBUF;                                      00998000
INTEGER NWPUSTBUF;  <<NR. WORDS IN PUST BUFFER>>                        01000000
                                                                        01002000
<<STT ARRAY>>                                                           01004000
                                                                        01006000
INTEGER POINTER STT;  <<STT FOR CODE SEGMENT>>                          01008000
integer array SttPpCount(0:152); << # private procs in each seg<<02817>>01010000
                                                                        01012000
<<SEGMENT PREPARATION PARAMETERS>>                                      01014000
                                                                        01016000
INTEGER PREPERROR;    << NR OF ERRORS DURING PREP >>           <<01.DM>>01018000
LOGICAL SEGFLAGS;                                                       01020000
DEFINE SEGPRIVILEGED = SEGFLAGS.(0:1)#,  <<PRIV. INST. IN SEG.?>>       01022000
       SEGWARNING = SEGFLAGS.(1:1)#,  <<NON-FATAL ERROR IN SEGMENT?>>   01024000
       SEGPRINTED = SEGFLAGS.(2:1)#;  <<SEGMENT NAME PRINTED?>>         01026000
LOGICAL PROGRAMFILE;  <<PREPARATION FOR PROGRAM FILE?>>                 01028000
INTEGER SEGFNUM;  <<FILE NR. HOLDING SEGMENT>>                          01030000
INTEGER SEGRECD;  <<FIRST REC. NR. OF SEGMENT>>                         01032000
INTEGER SEGLEN;  <<CODE SEGMENT LENGTH>>                                01034000
INTEGER SYMTABADR;  <<SAVE SYM. TAB. ENTRY ADR.>>                       01036000
INTEGER OBADR;  <<FILE ADDRESS OF OUTER BLOCK ENTRY>>                   01038000
INTEGER OBSYMTABADR;  <<SYMBOL TABLE ADDRESS OF O.B. ENTRY>>            01040000
INTEGER CSTNR;  <<NEXT AVAILABLE LOGICAL CST NUMBER>>                   01042000
INTEGER STTNR;  <<NEXT AVAILABLE STT NUMBER>>                           01044000
integer SttPpNr;  << Next available private proc STT number >> <<02817>>01046000
INTEGER NWPDB;  <<NR. WORDS IN PRIMARY DB>>                             01048000
INTEGER NWSDB;  <<NR. WORDS IN SECONDARY DB>>                           01050000
double  PmapNw;              << # words used by internal PMAP  <<04102>>01052000
                             << records.                       <<04102>>01054000
INTEGER OBSTACKEST;  <<O.B. STACK ESTIMATE>>                            01056000
INTEGER PROCSTACKEST;  <<LARGEST PROC. STACK ESTIMATE>>                 01058000
INTEGER SDBADR;  <<S.A. OF SEC. DB ARRAY>>                              01060000
INTEGER FORMATADR;  <<S.A. OF FORMAT AREA>>                             01062000
INTEGER UNITADR;  <<S.A. OF CODE MODULE IN SEGMENT>>                    01064000
LOGICAL POINTER DIRTYDATA;  <<DIRTY DATA SEGMENT RECORDS>>              01066000
   LOGICAL OVERFLOWFLAG;                                       <<02816>>01068000
logical SymDBug;             << true if PREPing with TOOLBOX   <<04102>>01070000
                             <<   symbolic debug.              <<04102>>01072000
logical SISeen;              << true if a TOOLBOX SI header    <<04102>>01074000
                             << was found during pass 1.       <<04102>>01076000
integer ToolboxId;           << Last TOOLBOX ID assigned >>    <<04102>>01078000
$PAGE "RL LIBRARY FILE BUFFERS AND PARAMTERS"                  <<00207>>01080000
<<----------------------------------------------------------------------01082000
*                                                                      *01084000
*  RL LIBRARY FILE BUFFERS AND PARAMETERS                              *01086000
*                                                                      *01088000
---------------------------------------------------------------------->>01090000
                                                                        01092000
INTEGER RLIBFNUM _ 0;  <<FILE NR.>>                                     01094000
LOGICAL RLIBEQUALRL;  <<RL LIBRARY AND RL FILE SAME?>>                  01096000
                                                                        01098000
<<RECORD 0 BUFFER>>                                                     01100000
                                                                        01102000
INTEGER POINTER RLIBREC0;  <<RECORD 0 BUFFER>>                          01104000
DEFINE RLIBLID = RLIBREC0#;  <<LOADER ID>>                              01106000
                                                                        01108000
<<DIRECTORY BUFFER>>                                                    01110000
                                                                        01112000
INTEGER POINTER RLIBDIR;  <<DIRECTORY BUFFER>>                          01114000
                                                                        01116000
<<ENTRY PARAMETERS>>                                                    01118000
                                                                        01120000
INTEGER POINTER RLIBP;  <<POINTS TO FIRST WORD OF ENTRY>>               01122000
INTEGER POINTER RLIBP1;  <<SECONDARY POINTER>>                          01124000
DOUBLE POINTER RLIBDP1 = RLIBP1;                                        01126000
DEFINE RLIBNAME = RLIBP#,  <<ENTRY POINT NAME>>                         01128000
       RLIBUNCALLABLE = (LOGICAL(RLIBP.(1:1)))#,  <<ENTRY UNCALLABLE?>> 01130000
       RLIBPRIVILEGED = (LOGICAL(RLIBP.(2:1)))#,  <<PRIV. INST.?>>      01132000
       RLIBINFO = RLIBDP1#,  <<S.A. INFO BLOCK>>                        01134000
       RLIBENTRY = RLIBP1(2)#,  <<S.A. OF ENTRY POINT>>                 01136000
       RLIBCODE = RLIBP1(3)#,  <<CODE MODULE DESCRIPTOR>>               01138000
       RLIBFATAL = (LOGICAL(RLIBP1(3).(0:1)))#,  <<FATAL ERROR?>>       01140000
       RLIBWARNING = (LOGICAL(RLIBP1(3).(1:1)))#,  <<NON-FATAL ERROR?>> 01142000
       RLIBNWC = RLIBP1(3).(2:14)#,  <<NR. WORDS IN CODE MODULE>>       01144000
       RLIBPARMS = RLIBP1(4)#;  <<PARM. INFO>>                          01146000
$PAGE "UTILITY BUFFERS AND VARIABLES"                          <<00207>>01148000
<<----------------------------------------------------------------------01150000
*                                                                      *01152000
*  UTILITY BUFFERS AND VARIABLES                                       *01154000
*                                                                      *01156000
---------------------------------------------------------------------->>01158000
                                                                        01160000
<<UTILITY BUFFERS>>                                                     01162000
                                                                        01164000
INTEGER ARRAY BUF(0:255);  <<DOUBLE RECORD DISC BUFFER>>                01166000
BYTE ARRAY BBUF (*) = BUF;                                              01168000
DOUBLE ARRAY DBUF(*) = BUF;                                             01170000
INTEGER ARRAY BUF1(*) = BUF(128);  <<SECOND HALF OF BUFFER>>            01172000
                                                                        01174000
<<UTILITY VARIABLES>>                                                   01176000
                                                                        01178000
LOGICAL FLAG;  <<UTILITY FLAG>>                                         01180000
INTEGER I;  <<UTILITY INTEGER>>                                         01182000
LOGICAL CTLY;  <<CONTROL Y FLAG>>                              <<00.DM>>01184000
INTEGER INFNUM;  <<FILE NUMBER OF $STDINX>>                    <<00.DM>>01186000
                                                                        01188000
<<----------------------------------------------------------------------01190000
*                                                                      *01192000
*  THE FOLLOWING ARE THE BUFFERS AND STATE INFORMATION USED BY THE     *01194000
*  MASTER BUFFERING PROCEDURES.  THERE ARE TWO SETS OF BUFFERS, ONE    *01196000
*  FOR CODE SEGMENTS AND THE OTHER IS FOR THE GLOBAL AREA OF THE       *01198000
*  PROGRAM FILE.                                                       *01200000
*                                                                      *01202000
---------------------------------------------------------------------->>01204000
                                                                        01206000
<<CODE BUFFER SET>>                                                     01208000
                                                                        01210000
INTEGER TFNUM1;  <<TARGET FILE NR.>>                                    01212000
INTEGER ARRAY TBUF1(0:127);  <<TARGET FILE RECORD BUFFER>>              01214000
INTEGER TRECD1;  <<CURRENT TARGET RECORD NUMBER>>                       01216000
INTEGER TDISP1;  <<CURRENT TARGET RECORD BYTE DISPLACEMENT>>            01218000
                                                                        01220000
<<DATA BUFFER SET>>                                                     01222000
                                                                        01224000
INTEGER ARRAY TBUF2(0:127);  <<TARGET FILE RECORD BUFFER>>              01226000
INTEGER TRECD2;  <<CURRENT TARGET RECORD NUMBER>>                       01228000
INTEGER TDISP2;  <<CURRENT TARGET RECORD BYTE DISPLACEMENT>>            01230000
$PAGE "MISCELLANEOUS SCRATCH FILES AND BUFFERS"                <<04102>>01232000
<< PMAP Scratch File >>                                        <<04102>>01234000
                                                               <<04102>>01236000
integer array PmapBuf(0:130);                                  <<04102>>01238000
define                                                         <<04102>>01240000
   PmapFileNr  = PmapBuf(128)#,                                <<04102>>01242000
   PmapRecNr   = PmapBuf(129)#,   << Record in buffer >>       <<04102>>01244000
   PmapBufDisp = PmapBuf(130)#;   << Next word in buffer >>    <<04102>>01246000
                                                               <<04102>>01248000
<< TOOLBOX Symbol Item (SI) Headers Scratch File >>            <<04102>>01250000
integer array SIBuf(0:130);                                    <<04102>>01252000
define                                                         <<04102>>01254000
   SIFileNr  = SIBuf(128)#,                                    <<04102>>01256000
   SIRecNr   = SIBuf(129)#,       << Record in buffer >>       <<04102>>01258000
   SIBufDisp = SIBuf(130)#;       << Next word in buffer >>    <<04102>>01260000
                                                               <<04102>>01262000
<< File names used by TOOLBOX son process creation: >>         <<04102>>01264000
                                                               <<04102>>01266000
byte    array TboxFiles(0:35)                                  <<04102>>01268000
              := "SEGTMP00  SEGTMP01  SEGSYM.PUB.SYS  ";       <<04102>>01270000
                                                               <<04102>>01272000
define                                                         <<04102>>01274000
   PmapScratch = TboxFiles#,      << Name of PMAP scratch file <<04102>>01276000
   SIScratch   = TboxFiles(10)#,  << Name of SI scratch file >><<04102>>01278000
   SEGSYM      = TboxFiles(20)#;  << Name of son process prog ><<04102>>01280000
$PAGE "INTERNAL PMAP RECORDS"                                           01282000
EQUATE   NRPMAPTYPE     = 3,                                   <<04102>>01284000
         SEGPMAPLEN     = 2,  << LENGTH OF PMAP RECORDS >>     <<04102>>01286000
         PRIENTPMAPLEN  = 7,  << EXCLUDING NAMES        >>     <<04102>>01288000
         SECENTPMAPLEN  = 3;                                   <<04102>>01290000
INTEGER ARRAY TYPETABLE(0:NRPMAPTYPE);                         <<04102>>01292000
DEFINE   TYPETABLELEN = TYPETABLE(0)#,                         <<04102>>01294000
         SEGTYPELEN   = TYPETABLE(1)#,                         <<04102>>01296000
         PRITYPELEN   = TYPETABLE(2)#,                         <<04102>>01298000
         SECTYPELEN   = TYPETABLE(3)#;                         <<04102>>01300000
INTEGER NAMENW;                                                <<04102>>01302000
DEFINE IPMAP'TYPE       = PMAPRECORD.(0:4)#;                   <<04102>>01304000
EQUATE PMAPSEGTYPE      = 0,                                   <<04102>>01306000
       PMAPPROCTYPE     = 1,                                   <<04102>>01308000
       PMAPSECTYPE      = 2;                                   <<04102>>01310000
DEFINE IPMAP'NAMENUMCH  = PMAPRECORD.(4:4)#,<< NOTE:MOVE NAME>><<04102>>01312000
       IPMAP'NAME       = PMAPRECORD#,<<BEFORE MOVE TYPE     >><<04102>>01314000
       IPMAP'STTLEN     = PMAPRECORD(NAMENW).(0:8)#,           <<04102>>01316000
       IPMAP'SEGNUM     = PMAPRECORD(NAMENW).(8:8)#,           <<04102>>01318000
       IPMAP'SEGLEN     = PMAPRECORD(NAMENW+1)#,               <<04102>>01320000
                                                               <<04102>>01322000
       IPMAP'FLAGS      = PMAPRECORD(NAMENW)#,                 <<04102>>01324000
         IPMAP'HIDDEN   = PMAPRECORD(NAMENW).(0:1)#,           <<04102>>01326000
       IPMAP'PROCSTART  = PMAPRECORD(NAMENW+1)#,               <<04102>>01328000
       IPMAP'PROCLEN    = PMAPRECORD(NAMENW+2)#,               <<04102>>01330000
       IPMAP'PROCENTRY  = PMAPRECORD(NAMENW+3)#,               <<04102>>01332000
       IPMAP'TBOXLINK1  = PMAPRECORD(NAMENW+4)#,               <<04102>>01334000
       IPMAP'TBOXLINK2  = PMAPRECORD(NAMENW+5)#,               <<04102>>01336000
       IPMAP'TBOXID     = PMAPRECORD(NAMENW+6)#,               <<04102>>01338000
                                                               <<04102>>01340000
       IPMAP'SECENTRY   = PMAPRECORD(NAMENW+1)#,               <<04102>>01342000
       IPMAP'SECENTNUM  = PMAPRECORD(NAMENW+2)#;               <<04102>>01344000
                                                                        01346000
EQUATE  MAXPMAPRECLEN=15;                                      <<04102>>01348000
INTEGER SYSFPMAP;                                              <<04584>>01350000
INTEGER JSFPMAP;                                               <<04584>>01352000
$PAGE "USL FILE BUFFERS AND PARAMTERS"                         <<00207>>01354000
<<----------------------------------------------------------------------01356000
*                                                                      *01358000
*  USL FILE BUFFERS AND PARAMETERS                                     *01360000
*                                                                      *01362000
---------------------------------------------------------------------->>01364000
                                                                        01366000
EQUATE USLFILECODE = 1024,  <<USL FILE CODE>>                           01368000
       USLFILEID = 1,  <<VERSION NR.>>                                  01370000
       MINUSL = 5,  <<MIN. NR. REC'S IN USL FILE>>                      01372000
       MAXUSL = 32727,  <<MAX. NR. REC'S IN USL FILE>>                  01374000
       USLFHI = 33,  <<INDEX OF FIRST HASH LIST>>                       01376000
       BIGGESTHEAD= 1023,  <<LARGEST HEADER LENGTH>>                    01378000
       BND3 = 1151,  <<ENTRY/HEADER BOUND>>                             01380000
       MAXDIR = BND3+1,  <<DIRECTORY/ENTRY BUFFER LENGTH>>              01382000
       MAXHEAD = BND3+1,  <<INFO/HEADER BUFFER LENGTH>>                 01384000
       USLDLBUFS = 128+MAXDIR+MAXHEAD;  <<DL BUFFER SET LENGTH>>        01386000
                                                                        01388000
INTEGER USLFNUM _ 0;  <<FILE NR.>>                                      01390000
INTEGER NUSLFNUM:=0; <<NEW USL FILE # FOR COPYUSL>>            <<00207>>01392000
                                                                        01394000
<<STATE WORD>>                                                          01396000
                                                                        01398000
LOGICAL USLSTATE := 0;                                                  01400000
DEFINE USLBUFALLOC = USLSTATE.(0:1)#,  <<DL BUFFERS ALLOCATED?>>        01402000
       USLREC0MOD = USLSTATE.(2:1)#,  <<RECORD 0 MODIFIED?>>            01406000
       USLDIRINCORE = USLSTATE.(3:1)#,  <<DIRECTORY IN CORE?>>          01408000
       USLDIRMOD = USLSTATE.(4:1)#,  <<DIRECTORY MODIFIED?>>            01410000
       USLINFOINCORE = USLSTATE.(5:1)#,  <<INFO IN CORE?>>              01412000
       USLINFOMOD = USLSTATE.(6:1)#,  <<INFO MODIFIED?>>       <<00660>>01414000
       USLCLOSECODE = USLSTATE.(7:3)#; <<FCLOSE CODE>>         <<00660>>01416000
INTEGER STATECHANGED := 0;  <<USL OR AUXUSL STATE?>>                    01418000
                                                                        01420000
<<USL FILE RECORD 0>>                                                   01422000
                                                                        01424000
INTEGER POINTER USLREC0;  <<USL FILE RECORD 0>>                         01426000
DOUBLE POINTER USLDREC0 = USLREC0;                                      01428000
DEFINE USLLID = USLREC0#,  <<LOADER ID>>                                01430000
       USLNE = USLREC0(1)#,  <<NR. DIRECTORY ENTRIES>>                  01432000
       USLDL = USLREC0(2)#,  <<DIRECTORY LENGTH>>                       01434000
       USLTDG = USLREC0(3)#,  <<TOTAL DIRECTORY GARBAGE>>               01436000
       USLNDG = USLREC0(4)#,  <<NR. DIRECTORY GARBAGE ENTRIES>>         01438000
       USLBDL = USLREC0(5)#,  <<S.A. BLOCK DATA LIST>>                  01440000
       USLIPL = USLREC0(6)#,  <<S.A. INTERUPT PROC. LIST>>              01442000
       USLSL = USLREC0(7)#,  <<S.A. SEGMENT LIST>>                      01444000
       USLFL = USLDREC0(4)#,  <<FILE LENGTH>>                           01446000
       USLFL2= USLREC0(9)#,    <<SECOND WORD OF FILE LENGTH>>  <<00207>>01448000
       USLSAAD = USLREC0(10)#,  <<S.A. DIR. AVAIL. BLOCK>>              01450000
       USLADL = USLREC0(11)#,  <<DIR. AVAIL. BLOCK LENGTH>>             01452000
       USLSAI = USLDREC0(6)#,  <<S.A. INFO BLOCK>>                      01454000
       USLIL = USLDREC0(7)#,  <<INFO BLOCK LENGTH>>                     01456000
       USLIL2 = USLREC0(15)#,  <<SECOND HALF>>                          01458000
       USLSAAI = USLDREC0(8)#,  <<S.A. INFO AVAIL. BLOCK>>              01460000
       USLAIL = USLDREC0(9)#,  <<INFO AVAIL. BLOCK LENGTH>>             01462000
       USLAIL2= USLREC0(19)#,                                  <<00207>>01464000
       USLTIG = USLDREC0(10)#,  <<TOTAL INFO GARBAGE>>                  01466000
       USLTIG2= USLREC0(21)#,                                  <<00207>>01468000
       USLNIG = USLREC0(22)#;  <<NR. INFO GARBAGE ENTRIES>>             01470000
                                                                        01472000
<<USL DIRECTORY/ENTRY BUFFER>>                                          01474000
                                                                        01476000
INTEGER POINTER DIR;  <<USL DIRECTORY/ENTRY BUFFER>>                    01478000
INTEGER DIRADR;  <<FILE ADR. OF FIRST WORD IN DIRECTORY BUFFER>>        01480000
                                                                        01482000
<<USL ENTRY PARAMETERS>>                                                01484000
                                                                        01486000
INTEGER ENTFILEADR;  <<FILE ADDRESS OF CURRENT ENTRY>>                  01488000
INTEGER POINTER ENTP;  <<POINTS TO FIRST WORD OF ENTRY>>                01490000
INTEGER POINTER ENTP1;  <<POINTS TO WORD FOLLOWING ENTRY NAME>>         01492000
DOUBLE POINTER ENTDP1 = ENTP1;                                          01494000
INTEGER POINTER ENTP2;  <<POINTS TO PARM. INFO>>                        01496000
INTEGER POINTER BDP;  <<POINTS TO FIRST WORD OF B.D. SUB-ENTRY>>        01498000
INTEGER ENTNW;  <<NUMBER OF WORDS IN ENTRY>>                            01500000
INTEGER ENTTYPE;  <<ENTRY TYPE>>                                        01502000
EQUATE USLANY = -1,  <<ANY USL ENTRY>>                                  01504000
       USLSEG = 0,  <<ANY USL SEGMENT ENTRY>>                           01506000
       USLNONSEG = 1;  <<ANY USL NON-SEGMENT ENTRY>>                    01508000
DEFINE SEGMENTNAME = (ENTTYPE = 1)#,                                    01510000
       PRIMARYOB = (ENTTYPE = 2)#,                                      01512000
       SECONDARYOB = (ENTTYPE = 3)#,                                    01514000
       PRIMARYPROC = (ENTTYPE = 4)#,                                    01516000
       SECONDARYPROC = (ENTTYPE = 5)#,                                  01518000
       INTERUPTPROC = (ENTTYPE = 6)#,                                   01520000
       BLOCKDATA = (ENTTYPE = 7)#,                                      01522000
       SECPARMPROC = (ENTTYPE = 8)#;                                    01524000
INTEGER ENTNC;  <<NR. CHAR'S IN ENTRY NAME>>                            01526000
INTEGER ENTNAMENW;  <<NR. WORDS IN ENTRY NAME>>                         01528000
INTEGER ENTHASH;  <<ENTRY NAME HASH CODE>>                              01530000
INTEGER ENTPARMLEN;  <<NR. WORDS FOR PARM INFO>>                        01532000
DEFINE EDESCRIP = ENTP#,  <<DESCRIPTOR WORD>>                           01534000
       ENW = ENTP.(1:10)#,  <<NR. WORDS IN ENTRY>>                      01536000
       ELINKS = ENTDP1#,  <<BROTHER AND SON LINKS>>                     01538000
       ETYPE = ENTP.(11:5)#,  <<ENTRY TYPE NR.>>                        01540000
       EHL = ENTP(1)#,  <<HASH LINK>>                                   01542000
       ACTIVE = (NOT LOGICAL(ENTP(2).(0:1)))#,                          01544000
       INACTIVE = (LOGICAL(ENTP(2).(0:1)))#,                            01546000
       CALLABLE' = (LOGICAL(ENTP(2).(1:1)))#,  <<UNCALLABLE?>>          01548000
       PRIVLEDGED = (LOGICAL(ENTP(2).(2:1)))#,  <<PRIV. INST.?>>        01550000
       HIDDEN = (LOGICAL(ENTP(2).(3:1)))#,  <<HIDDEN ENTRY?>>           01552000
       EACTIVITYBIT = ENTP(2).(0:1)#,  <<ACTIVITY BIT>>                 01554000
       EIT = ENTP(2).(1:2)#,  <<INT. PROC. TYPE NR.>>                   01556000
       ENC = ENTP(2).(4:4)#,  <<NR. CHAR'S IN NAME>>                    01558000
       ENAME = ENTP(2)#,  <<ENTRY NAME>>                                01560000
       EBL = ENTP1#,  <<BROTHER LINK>>                                  01562000
       ESL = ENTP1(1)#,  <<SON LINK>>                                   01564000
       EPUSEPA = EntP1(1)#, << Secondary entry point address >><<04102>>01566000
       EPUSA = ENTP1(2)#,  <<PROG. UNIT STARTING ADR.>>                 01568000
       ESAC1 = ENTP1(3)#,  <<S.A. OF CODE MODULE (FIRST HALF)>>         01570000
       ESAC2 = ENTP1(4)#,  <<S.A. OF CODE MODULE (SECOND HALF)>>        01572000
       ECODE = ENTP1(5)#,  <<CODE MODULE DESCRIPTOR>>                   01574000
       FATALERROR = (LOGICAL(ENTP1(5).(0:1)))#,  <<FATAL ERROR?>>       01576000
       WARNING = (LOGICAL(ENTP1(5).(1:1)))#,  <<NON-FATAL ERROR?>>      01578000
       ENWC = ENTP1(5).(2:14)#,  <<NR. WORDS IN CODE MODULE>>           01580000
       ESTACKEST = ENTP1(6)#,  <<STACK SIZE ESTIMATE>>                  01582000
       ETPDB = ENTP1(7)#,  <<TOTAL PRIM. DB ALLOCATED>>                 01584000
       ETSDB = ENTP1(8)#,  <<TOTAL SEC. DB ALLOCATED>>                  01586000
       ENWPUST = ENTP1(9)#,  <<NR. WORDS IN PUST>>                      01588000
       ENWSDB = ENTP1(10)#,  <<NR. WORDS IN SEC. DB ARRAY>>             01590000
       ENWO = ENTP1(10)#,  <<NR. WORDS IN OWN ARRAY>>                   01592000
       ENWD = ENTP1(10)#,  <<NR. WORDS IN DATA ARRAY>>                  01594000
       EPARMS = ENTP2#,  <<PARAMETER INFO BLOCK>>                       01596000
       EHEADNW = ENTHEADP.(1:10)#,  <<NR. WORDS IN HEADER>>             01598000
       EHEADTYPE = ENTHEADP.(11:5)#;  <<HEADER TYPE NR.>>               01600000
                                                                        01602000
<<HEADER SET PARAMETERS>>                                               01604000
                                                                        01606000
INTEGER POINTER ENTHEADSETP;  <<POINTS TO FIRST WORD OF HEADER SET>>    01608000
INTEGER POINTER ENTHEADP;  <<POINTS TO CURRENT DESCRIPTOR WORD>>        01610000
DOUBLE POINTER ENTHEADDP = ENTHEADP;                                    01612000
DOUBLE ENTHEADADR;  <<FILE ADR. (REL. SAI) OF CURRENT HEADER>>          01614000
DOUBLE ENTCODEADR;  <<FILE ADR. (REL. SAI) OF CODE MODULE>>             01616000
INTEGER ENTNWCODE;  <<NR. WORDS IN CODE MODULE>>                        01618000
                                                                        01620000
<<USL INFO/HEADER BUFFER>>                                              01622000
                                                                        01624000
INTEGER POINTER HEAD;  <<USL INFO/HEADER BUFFER>>                       01626000
DOUBLE INFOADR;  <<FILE ADR. (REL. SAI) OF FIRST WORD IN HEADER BUFFER>>01628000
                                                                        01630000
<<USL HEADER PARAMETERS>>                                               01632000
                                                                        01634000
DOUBLE HEADFILEADR;  <<FILE ADDRESS OF CURRENT HEADER>>                 01636000
INTEGER HEADRECD;  <<FIRST RECORD CONTAINING CURRENT HEADER>>           01638000
INTEGER POINTER HEADP;  <<POINTS TO FIRST WORD OF HEADER>>              01640000
DOUBLE POINTER HEADDP = HEADP;                                          01642000
INTEGER HEADNW;  <<NUMBER OF WORDS IN HEADER>>                          01644000
INTEGER HEADTYPE;  <<HEADER TYPE NUMBER>>                               01646000
DEFINE HNW = HEADP.(1:10)#,  <<NR. WORDS IN HEADER>>                    01648000
       HTYPE = HEADP.(11:5)#;  <<HEADER TYPE NR.>>                      01650000
$PAGE "AUXILIARY USL FILE BUFFERS AND PARAMETERS"              <<00207>>01652000
<<----------------------------------------------------------------------01654000
*                                                                      *01656000
*  AUXILIARY USL FILE BUFFERS AND PARAMETERS                           *01658000
*                                                                      *01660000
---------------------------------------------------------------------->>01662000
                                                                        01664000
<<STATE WORD>>                                                          01666000
                                                                        01668000
LOGICAL XUSLSTATE := 0;                                                 01670000
DEFINE XUSLBUFALLOC = XUSLSTATE.(0:1)#,  <<DL BUFFERS ALLOCATED?>>      01672000
       XUSLREC0MOD = XUSLSTATE.(2:1)#,  <<RECORD 0 MODIFIED?>>          01676000
       XUSLDIRINCORE = XUSLSTATE.(3:1)#,  <<DIRECTORY IN CORE?>>        01678000
       XUSLDIRMOD = XUSLSTATE.(4:1)#,  <<DIRECTORY MODIFIED?>>          01680000
       XUSLINFOINCORE = XUSLSTATE.(5:1)#,  <<INFO IN CORE?>>            01682000
       XUSLINFOMOD = XUSLSTATE.(6:1)#,  <<INFO MODIFIED?>>     <<00660>>01684000
       XUSLCLOSECODE = XUSLSTATE.(7:3)#; <<FCLOSE CODE>>       <<00660>>01686000
                                                                        01688000
INTEGER XUSLFNUM := 0;  <<FILE NR.>>                                    01690000
                                                                        01692000
<<RECORD 0>>                                                            01694000
                                                                        01696000
INTEGER POINTER XUSLREC0;  <<RECORD 0 BUFFER>>                          01698000
DOUBLE POINTER XUSLDREC0 = XUSLREC0;                                    01700000
DEFINE XUSLLID = XUSLREC0#,  <<LOADER ID>>                              01702000
       XUSLNE = XUSLREC0(1)#,  <<NR. DIRECTORY ENTRIES>>                01704000
       XUSLDL = XUSLREC0(2)#,  <<DIRECTORY LENGTH>>                     01706000
       XUSLTDG = XUSLREC0(3)#,  <<TOTAL DIRECTORY GARBAGE>>             01708000
       XUSLNDG = XUSLREC0(4)#,  <<NR. DIRECTORY GARBAGE ENTRIES>>       01710000
       XUSLBDL = XUSLREC0(5)#,  <<S.A. BLOCK DATA LIST>>                01712000
       XUSLIPL = XUSLREC0(6)#,  <<S.A. INTERUPT PROC. LIST>>            01714000
       XUSLSL = XUSLREC0(7)#,  <<S.A. SEGMENT LIST>>                    01716000
       XUSLFL = XUSLDREC0(4)#,  <<FILE LENGTH (IN WORDS)>>              01718000
       XUSLSAAD = XUSLREC0(10)#,  <<S.A. DIRECTORY AVAIL. BLOCK>>       01720000
       XUSLADL = XUSLREC0(11)#,  <<DIR. AVAIL. BLOCK LENGTH>>           01722000
       XUSLSAI = XUSLDREC0(6)#,  <<S.A. INFO BLOCK>>                    01724000
       XUSLIL = XUSLDREC0(7)#,  <<INFO BLOCK LENGTH>>                   01726000
       XUSLIL2 = XUSLREC0(15)#,  <<SECOND HALF>>                        01728000
       XUSLSAAI = XUSLDREC0(8)#,  <<S.A. INFO AVAIL. BLOCK>>            01730000
       XUSLAIL = XUSLDREC0(9)#,  <<INFO BLOCK AVAIL. LENGTH>>           01732000
       XUSLTIG = XUSLDREC0(10)#,  <<TOTAL INFO GARBAGE>>                01734000
       XUSLNIG = XUSLDREC0(11)#;  <<NR. INFO GARBAGE ENTRIES>>          01736000
                                                                        01738000
<<DIRECTORY/ENTRY BUFFER>>                                              01740000
                                                                        01742000
INTEGER POINTER XDIR;  <<DIRECTORY/ENTRY BUFFER>>                       01744000
INTEGER XDIRADR;  <<FILE ADR. OF FIRST WORD IN BUFFER>>                 01746000
                                                                        01748000
<<ENTRY PATAMETERS>>                                                    01750000
                                                                        01752000
INTEGER POINTER XENTP;  <<POINTS TO FIRST WORD OF ENTRY>>               01754000
INTEGER POINTER XENTP1;  <<POINTS TO WORD FOLLOWING ENTRY NAME>>        01756000
DOUBLE POINTER XENTDP1 = XENTP1;                                        01758000
INTEGER POINTER XENTP2;  <<POINTS TO PARM. INFO>>                       01760000
DEFINE XENAME = XENTP(2)#,  <<ENTRY NAME>>                              01762000
       XESAC1 = XENTP1(3)#,  <<S.A. OF CODE MODULE (FIRST HALF)>>       01764000
       XESAC2 = XENTP1(4)#;  <<S.A. OF CODE MODULE (SECOND HALF)>>      01766000
                                                                        01768000
<<INFO/HEADER BUFFER>>                                                  01770000
                                                                        01772000
INTEGER POINTER XHEAD;  <<INFO/HEADER BUFFER>>                          01774000
DOUBLE XINFOADR;  <<FILE ADR. (REL. SAI) OF FIRST WORD IN BUFFER>>      01776000
                                                                        01778000
<<HEADER PARAMETERS>>                                                   01780000
                                                                        01782000
INTEGER POINTER XHEADP;  <<POINTS TO FIRST WORD OF HEADER>>             01784000
$PAGE "DEFINITIONS USED BY USLCOPY"                            <<00207>>01786000
COMMENT                                                        <<00207>>01788000
--------------------------------------------------------       <<00207>>01790000
*                                                      *       <<00207>>01792000
*     DEFINITIONS FOR USLCOPY                          *       <<00207>>01794000
*                                                      *       <<00207>>01796000
-------------------------------------------------------;       <<00207>>01798000
                                                               <<00207>>01800000
                                                               <<00207>>01802000
DEFINE NEWDL=   NEWREC0(2) #,                                  <<00666>>01806000
       NEWFL=   DNEWREC0(4) #,                                 <<00207>>01808000
       NEWSAAD= NEWREC0(10) #,                                 <<00207>>01810000
       NEWADL=  NEWREC0(11) #,                                 <<00207>>01812000
       NEWSAI=  DNEWREC0(6) #,                                 <<00207>>01814000
       NEWIL=   DNEWREC0(7) #,                                 <<00207>>01816000
       NEWSAAI= DNEWREC0(8) #,                                 <<00207>>01818000
       NEWAIL=  DNEWREC0(9) #;                                 <<00207>>01820000
$PAGE "PROGRAM FILE BUFFERS AND PARAMETERS"                    <<00207>>01822000
<<----------------------------------------------------------------------01824000
*                                                                      *01826000
*  PROGRAM FILE BUFFERS AND PARAMETERS                                 *01828000
*                                                                      *01830000
---------------------------------------------------------------------->>01832000
                                                                        01834000
EQUATE PROGFILECODE = 1029,  <<PROGRAM FILE CODE>>                      01836000
       MAXCST = 152,  <<MAX. NR. OF CODE SEGMENTS>>                     01838000
       MAXCODE = 16380,  <<MAX. CODE SEGMENT SIZE>>                     01840000
       MAXDATA = 32758,  <<MAX. DATA SEGMENT SIZE>>                     01842000
       DEFAULTSTACK = 800,  <<DEFAULT STACK SIZE>>                      01844000
       DEFAULTDL = 0,  <<DEFAULT DL SIZE>>                              01846000
       DEFAULTMAXDATA = -1,  <<DEFAULT MAX. DATA SEGMENT SIZE>>         01848000
       PROGDLBUFS1 = 256+95+128+256+16+7+19+512,  <<DL BUFFER SET>>     01850000
       PROGDLBUFS2 = 128+128;  <<DL BUFFER SET>>                        01852000
                                                                        01854000
INTEGER PROGFNUM _ 0;  <<FILE NR.>>                                     01856000
                                                                        01858000
<<PROGRAM FILE RECORD 0>>                                               01860000
                                                                        01862000
INTEGER POINTER PROG0;  <<PROGRAM FILE RECORD 0>>                       01864000
BYTE POINTER PMAP;  <<CST RE-MAPPING ARRAY>>                            01866000
INTEGER POINTER PDESCRIP;  <<SEGMENT DESCRIPTOR ARRAY>>                 01868000
DEFINE PFLAGS = PROG0#,  <<FLAG WORD>>                                  01870000
       PFATAL = PROG0.(0:1)#,  <<FATAL ERROR?>>                         01872000
       PWARNING = PROG0.(1:1)#,  <<NON-FATAL ERROR?>>                   01874000
       PZERODB = PROG0.(2:1)#,  <<ZERO DB?>>                            01876000
       PMODE = PROG0.(3:1)#,  <<ANY SEGMENT PRIVILEGED?>>               01878000
       PCAP = PROG0.(6:10)#,  <<CAPABILITY BITS>>                       01880000
       PNS = PROG0(1)#,  <<NR. SEGMENTS>>                               01882000
       PGS = PROG0(2)#,  <<GLOBAL AREA SIZE>>                           01884000
       PSAG = PROG0(3)#,  <<REC. NR. OF GLOBAL AREA>>                   01886000
       PSAS = PROG0(4)#,  <<REC. NR. OF SEGMENT SET>>                   01888000
       PISS = PROG0(5)#,  <<INIT. STACK SIZE>>                          01890000
       PIDL = PROG0(6)#,  <<INIT. DL SIZE>>                             01892000
       PMAXD = PROG0(7)#,  <<MAX. DATA SEGMENT SIZE>>                   01894000
       PSAE = PROG0(8)#,  <<REC. NR. OF ENTRY POINT LIST>>              01896000
       PSSEG = PROG0(9)#,  <<STARTING SEGMENT NR.>>                     01898000
       PSADR = PROG0(10)#,  <<PRIM. ENTRY PT. PB ADR.>>                 01900000
       PSASTLT = PROG0(11)#,  <<S.A. OF STLT>>                          01902000
       PSAFLUT = PROG0(12)#,  <<S.A. OF FLUT>>                          01904000
       PSAX = PROG0(13)#,  <<REC. NR. OF EXTERNAL LIST>>                01906000
       PSSTT = PROG0(14)#;  <<PRIM. ENTRY PT. STT NR.>>                 01908000
DEFINE PSATRAPCOM = PROG0 (15)#;  <<S.A. OF TRAPCOM'>>         <<00.BV>>01910000
define PsaPmap = Prog0(16)#;     << First PMAP sector >>       <<04102>>01912000
define PsaSym  = Prog0(17)#;     << 1st sector of TOOLBOX SIs ><<04102>>01914000
DEFINE PPATCH = PROG0(18).(0:1)#,                              <<04257>>01916000
       PCKSUM = PROG0(18).(1:1)#;                              <<04257>>01918000
DEFINE TOTALCKSUM = PROG0(19)#;                                <<04257>>01920000
$PAGE "SL FILE BUFFERS AND PARAMETERS"                         <<00207>>01922000
<<----------------------------------------------------------------------01924000
*                                                                      *01926000
*  SL FILE BUFFERS AND PARAMETERS                                      *01928000
*                                                                      *01930000
---------------------------------------------------------------------->>01932000
                                                                        01934000
EQUATE SLFILECODE = 1031,  <<SL FILE CODE>>                             01936000
       SLFILEID = 3,  <<SL VERSION NR.>>                                01938000
       MINSL = 4,  <<MIN. NR. REC'S IN SL FILE>>                        01940000
       MAXSL = 32767,  <<MAX. NR. REC'S IN SL FILE>>                    01942000
       MINSLEL = 3,  <<MIN. NR. REC'S IN SL EXTENT>>                    01944000
       SLDLBUFS1 = 128+128+128+128+128+16+16+16,  <<DL BUFFER SET>>     01946000
       SLDLBUFS2 = 95+128+256;  <<DL BUFFER SET LENGTH>>                01948000
                                                                        01950000
INTEGER SPLFNUM _ 0;  <<FILE NR.>>                                      01952000
DOUBLE SLKEY;  <<SL FILE KEY>>                                          01954000
LOGICAL REALSL;  <<REAL SL FILE OR SCRATCH?>>                           01956000
INTEGER SCRATCHFNUM _ 0;  <<FILE NR.>>                                  01958000
INTEGER OSPLFNUM:=0; <<OLD SL FILE NUMBER>>                    <<00465>>01960000
                                                                        01962000
<<STATE WORD>>                                                          01964000
                                                                        01966000
LOGICAL SLSTATE := 0;                                                   01968000
DEFINE SLBUFALLOC = SLSTATE.(0:1)#,  <<DL BUFFERS ALLOCATED?>>          01970000
       SLNEW = SLSTATE.(1:1)#,  <<NEW SL?>>                             01972000
       SLREC0MOD = SLSTATE.(2:1)#;  <<RECORDS 0,1 MODIFIED?>>           01974000
                                                                        01976000
<<RECORDS 0,1 BUFFERS>>                                                 01978000
                                                                        01980000
INTEGER POINTER SPLREC0;  <<SL FILE RECORD 0>>                          01982000
INTEGER POINTER SPLREC1;  <<SL FILE RECORD 1>>                          01984000
DEFINE SPLLID = SPLREC0#,  <<LOADER ID>>                                01986000
       SPLFL = SPLREC0(1)#,  <<FILE LENGTH (IN RECORDS)>>               01988000
       SPLEL = SPLREC0(2)#,  <<EXTENT LENGTH>>                          01990000
       SPLLastToolboxId = SPLREC0(3)#,                         <<04102>>01992000
       SPLNS = SPLREC0(4)#,  <<NR. SEGMENTS IN FILE>>                   01994000
       SPLFRTL = SPLREC0(7)#,  <<S.A. OF FREE REF. TAB. ENTRY LIST>>    01996000
       SPLNRT = SPLREC0(9)#,  <<NR. REF. TAB. ENTRIES ALLOCATED>>       01998000
       SLNS = SPLREC0(11)#;  <<NR. SECTIONS>>                           02000000
EQUATE SPLFHI = 33;  <<INDEX OF FIRST HASH BUCKET HEAD>>                02002000
                                                                        02004000
<<STORAGE BIT MAP BUFFER>>                                              02006000
                                                                        02008000
INTEGER POINTER SLMAP;  <<SECTION BIT MAP BUFFER>>                      02010000
INTEGER SLMAPRECD;  <<REC. NR. OF MAP IN BUFFER>>                       02012000
LOGICAL SLMAPMODIFIED;  <<MAP MODIFIED?>>                               02014000
                                                                        02016000
<<DIRECTORY BUFFER>>                                                    02018000
                                                                        02020000
INTEGER POINTER SPLDIR;  <<DIRECTORY BUFFER>>                           02022000
DOUBLE POINTER SPLDDIR = SPLDIR;                                        02024000
INTEGER SPLRECD;  <<REC. NR. IN DIRECTORY BUFFER>>                      02026000
INTEGER SPLPREVRECD;  <<REC. NR. THAT POINTS TO CURRENT RECORD>>        02028000
INTEGER SLNEXTRECD;  <<REC. NR. POINTED TO BY CURRENT RECORD>>          02030000
INTEGER SLRECDUSED;  <<NR. WORDS OF RECORD USED FOR ENTRIES>>           02032000
INTEGER BUCKETINDEX;  <<RECORD 0 INDEX OF HASH LIST>>                   02034000
LOGICAL LIBENTRYMODIFIED;  <<DIRECTORY ENTRY MODIFIED>>                 02036000
                                                                        02038000
<<ENTRY PARAMETERS>>                                                    02040000
                                                                        02042000
INTEGER POINTER SPLP;  <<POINTS TO FIRST WORD OF ENTRY>>                02044000
INTEGER POINTER SPLP1;  <<POINTS TO WORD FOLLOWING ENTRY NAME>>         02046000
DEFINE SLUNCALLABLE = (LOGICAL(SPLP.(1:1)))#,  <<ENTRY UNCALLABLE?>>    02048000
       SLNC = SPLP.(4:4)#,  <<NR. CHAR'S IN NAME>>                      02050000
       SLNAME = SPLP#,  <<ENTRY POINT NAME>>                            02052000
       SLPLABEL = SPLP1#,  <<ENTRY POINT P-LABEL>>                      02054000
       SLSTTNR = SPLP1.(0:8)#,  <<STT NR. OF ENTRY POINT>>              02056000
       SLSEGNR = SPLP1.(8:8)#,  <<SEG. NR. OF ENTRY POINT>>             02058000
       SLPARMS = SPLP1(1)#,  <<PARM. INFO OF ENTRY POINT>>              02060000
       SLPCHECK = SPLP1(1).(0:2)#;  <<PARM. CHECKING LEVEL>>            02062000
INTEGER SPLNW;  <<NR. WORDS IN ENTRY>>                                  02064000
INTEGER SPLNC;  <<NR. CHAR'S IN ENTRY NAME>>                            02066000
INTEGER SPLNAMENW;  <<NR. WORDS FOR ENTRY NAME>>                        02068000
                                                                        02070000
<<REFERENCE TABLE BUFFER>>                                              02072000
                                                                        02074000
INTEGER POINTER RTBUF;  <<REFERENCE TABLE BUFFER>>                      02076000
INTEGER RTRECD;  <<CURRENT REFERENCE TABLE RECORD>>                     02078000
                                                                        02080000
<<REFERENCE TABLE ENTRY PARAMETERS>>                                    02082000
                                                                        02084000
INTEGER POINTER RTP;  <<REF. TAB. ENTRY POINTER>>                       02086000
DEFINE SLPRIVILEGED = LOGICAL(RTP.(0:1))#,  <<PRIV. INST. IN SEG.?>>    02088000
       SLRSL = RTP.(2:14)#,  <<SEGMENT LENGTH>>                         02090000
       SLRSA = RTP(1)#,  <<S.A. OF SEGMENT>>                            02092000
       SLRNR = RTP(2)#,  <<NR. REC'S FOR SEG. AND EXT. LIST>>           02094000
       SLRFLAGS = RTP(3)#,  <<SEGMENT FLAGS>>                           02096000
       SLRDELETEDBIT = RTP(3).(0:1)#,  <<SEG. DELETED BIT>>             02098000
       DELETEDSEG = LOGICAL(RTP(3).(0:1))#,  <<SEGMENT DELETED?>>       02100000
       SLRSATISBIT = RTP(3).(1:1)#,  <<EXT. SATISFIED BIT>>             02102000
       SATISFIEDSEG = LOGICAL(RTP(3).(1:1))#,  <<SATISFIED SEG.?>>      02104000
       SLRALLOCBIT = RTP(3).(4:1)#,  <<PERM. ALLOCATED BIT>>            02106000
       SLALLOCATED = LOGICAL(RTP(3).(4:1))#,  <<PERM. ALLOC. SEG.?>>    02108000
       SLRCOREBIT = RTP(3).(5:1)#,  <<CORE RESIDENT BIT>>               02110000
       SLRESIDENT = LOGICAL(RTP(3).(5:1))#,  <<CORE RES. SEG.?>>        02112000
       SLSYSTEM = LOGICAL(RTP(3).(6:1))#,  <<SYSTEM SEGMENT?>>          02114000
       SLRNRENTPTS = RTP(3).(9:7)#,  <<NR. ENTRY POINTS>>               02116000
       SLRPmapRec = RTP(4)#,      << Address of PMAP area >>   <<04102>>02118000
       SLRSIRec   = RTP(5)#,      << Address of SI area >>     <<04102>>02120000
       SLRPATCH = RTP(6).(0:1)#,                               <<04257>>02122000
       SLRCKSUM = RTP(6).(1:1)#,                               <<04257>>02124000
       SLRSEGNAME= RTP(8)#,  <<SEGMENT NAME>>                           02126000
       SLRREFEDSEGS = RTP(16)#;  <<REF. SEG. BIT MAP>>                  02128000
LOGICAL RTMODIFIED;  <<REFERENCE TABLE ENTRY MODIFIED?>>                02130000
                                                                        02132000
<<STT BUFFER>>                                                          02134000
                                                                        02136000
INTEGER POINTER STTP;  <<PL ENTRY POINTER>>                             02138000
INTEGER SLSTTRECD;  <<REC. NR. OF STT, ETC.>>                           02140000
INTEGER SLSTTNW;  <<STT, ETC. LENGTH>>                                  02142000
LOGICAL SLSTTMODIFIED;  <<STT, ETC. MODIFIED?>>                         02144000
                                                                        02146000
<<STT MAP BUFFER>>                                                      02148000
                                                                        02150000
BYTE POINTER SLSTTMAP;  <<STT MAP ARRAY>>                               02152000
                                                                        02154000
<<EXTERNAL ENTRY PARAMETERS>>                                           02156000
                                                                        02158000
INTEGER POINTER SLXP;  <<ENTRY POINTER>>                                02160000
INTEGER POINTER SLXP1;  <<SECONDARY ENTRY POINTER>>                     02162000
DEFINE SLXSATISBIT = SLXP.(0:1)#,  <<EXTERNAL SATISFIED BIT>>           02164000
       SLSATISEXTN = LOGICAL(SLXP.(0:1))#,  <<EXTERNAL SATISFIED?>>     02166000
       SLXNAME = SLXP#,  <<EXTERNAL NAME>>                              02168000
       SLXPLABEL = SLXP1#,  <<EXTERNAL P-LABEL>>                        02170000
       SLXSTTNR = SLXP1.(0:8)#,  <<EXTERNAL STT NR.>>                   02172000
       SLXSEGNR = SLXP1.(8:8)#,  <<EXTERNAL SEG. NR.>>                  02174000
       SLXPARMS = SLXP1(1)#,  <<EXTERNAL PARM. INFO>>                   02176000
       SLXPCHECK = SLXP1(1).(0:2)#;  <<PARM. CHECK LEVEL>>              02178000
INTEGER SLXNC;  <<NR. CHAR'S IN NAME>>                                  02180000
INTEGER SLXNW;  <<NR. WORDS IN ENTRY>>                                  02182000
                                                                        02184000
<<SEGMENT BINDING PARAMETERS>>                                          02186000
                                                                        02188000
LOGICAL SEGSADDED;  <<SEGMENTS ADDED?>>                                 02190000
LOGICAL POINTER ADDEDSEGS;  <<ADDED SEGMENT NR'S>>                      02192000
LOGICAL SEGSDELETED;  <<SEGMENTS DELETED?>>                             02194000
LOGICAL POINTER DELETEDSEGS;  <<DELETED SEGMENT NR'S>>                  02196000
LOGICAL SEGSMODIFIED;  <<SEGMENTS MODIFIED?>>                           02198000
LOGICAL POINTER MODIFIEDSEGS;  <<MODIFIED SEGMENT NR'S>>                02200000
                                                                        02202000
$PAGE "RL FILE BUFFERS AND PARAMTERS"                          <<00207>>02204000
<<----------------------------------------------------------------------02206000
*                                                                      *02208000
*  RL FILE BUFFERS AND PARAMETERS                                      *02210000
*                                                                      *02212000
---------------------------------------------------------------------->>02214000
                                                                        02216000
EQUATE RLFILECODE = 1028,  <<RL FILE CODE>>                             02218000
       RLFILEID = 3,  <<VERSION NR.>>                                   02220000
       MINRL = 4,  <<MIN. NR. REC'S IN RL FILE>>                        02222000
       MAXRL = 32767,  <<MAX. NR. REC'S IN RL FILE>>                    02224000
       RLFHI = 33,  <<RECORD 0 INDEX OF FIRST HASH LIST>>               02226000
       RLPROCTABLEN = 64,  <<PROCEDURE TABLE LENGTH>>                   02228000
       RLDLBUFS1 = 128+128+128+RLPROCTABLEN,  <<DL BUFFER SET LENGTH>>  02230000
       RLDLBUFS2 = 256;  <<DL BUFFER SET LENGTH>>                       02232000
                                                                        02234000
INTEGER RLFNUM _ 0;  <<FILE NR.>>                                       02236000
                                                                        02238000
<<STATE WORD>>                                                          02240000
                                                                        02242000
LOGICAL RLSTATE := 0;                                                   02244000
DEFINE RLBUFALLOC = RLSTATE.(0:1)#,  <<DL BUFFERS ALLOCATED?>>          02246000
       RLNEW = RLSTATE.(1:1)#,  <<NEW RL?>>                             02248000
       RLREC0MOD = RLSTATE.(2:1)#;  <<RECORD 0 MODIFIED?>>              02250000
                                                                        02252000
<<RECORD 0 BUFFER>>                                                     02254000
                                                                        02256000
INTEGER POINTER RLREC0;  <<RL FILE RECORD 0>>                           02258000
DOUBLE POINTER RLDREC0 = RLREC0;                                        02260000
DEFINE RLLID = RLREC0#,  <<LOADER ID>>                                  02262000
       RLFL = RLREC0(1)#,  <<FILE LENGTH (IN RECORDS)>>                 02264000
       RLNS = RLREC0(2)#,  <<NR. SECTIONS>>                             02266000
       RLSAXL = RLDREC0(2)#;  <<S.A. OF EXTERNAL LIST>>                 02268000
                                                                        02270000
<<STORAGE BIT MAP BUFFER>>                                              02272000
                                                                        02274000
INTEGER POINTER RLMAP;  <<SECTION BIT MAP BUFFER>>                      02276000
INTEGER RLMAPRECD;  <<REC. NR. OF MAP IN BUFFER>>                       02278000
LOGICAL RLMAPMODIFIED;  <<MAP MODIFIED?>>                               02280000
                                                                        02282000
<<DIRECTORY BUFFER>>                                                    02284000
                                                                        02286000
INTEGER POINTER RLDIR;  <<DIRECTORY BUFFER>>                            02288000
DOUBLE POINTER RLDDIR = RLDIR;                                          02290000
DEFINE RLDIRLINK = RLDIR#,  <<NEXT REC. NR.>>                           02292000
       RLDIRUSED = RLDIR(1)#;  <<NR. WORDS USED>>                       02294000
INTEGER RLRECD;  <<REC. NR. IN BUFFER>>                                 02296000
INTEGER RLPREVRECD;  <<REC. NR. THAT POINTS TO CURRENT REC.>>           02298000
INTEGER RLNEXTRECD;  <<REC. NR. POINTED TO BY CURRENT REC.>>            02300000
INTEGER RLBUCKET;  <<RECORD 0 INDEX OF CURRENT HASH LIST>>              02302000
LOGICAL RLENTRYMODIFIED;  <<BUFFER MODIFIED FLAG>>                      02304000
                                                                        02306000
<<ENTRY PARAMETERS>>                                                    02308000
                                                                        02310000
INTEGER POINTER RLP;  <<POINTS TO FIRST WORD OF ENTRY>>                 02312000
INTEGER POINTER RLP1;  <<POINTS TO WORD FOLLOWING NAME>>                02314000
DOUBLE POINTER RLDP1 = RLP1;                                            02316000
DEFINE RLNAME = RLP#,  <<ENTRY POINT NAME>>                             02318000
       RLPRIMARY = (NOT LOGICAL(RLP.(0:1)))#,  <<PRIMARY ENTRY POINT?>> 02320000
       RLSECONDARY = (LOGICAL(RLP.(0:1)))#,  <<SECONDARY ENTRY POINT?>> 02322000
       RLUNCALLABLE = (LOGICAL(RLP.(1:1)))#,  <<UNCALLABLE ENTRY?>>     02324000
       RLPRIVILEGED = (LOGICAL(RLP.(2:1)))#,  <<PRIV. INST. IN CODE?>>  02326000
       RLINFO = RLDP1#,  <<S.A. INFO BLOCK>>                            02328000
       RLSA = RLP1(2)#,  <<S.A. OF ENTRY POINT>>                        02330000
       RLCODE = RLP1(3)#,  <<CODE MODULE DESCRIPTOR>>                   02332000
       RLFATAL = (LOGICAL(RLP1(3).(0:1)))#,  <<FATAL ERROR IN CODE?>>   02334000
       RLWARNING = (LOGICAL(RLP1(3).(1:1)))#,  <<NON-FATAL ERROR?>>     02336000
       RLNWC = RLP1(3).(2:14)#,  <<NR. WORDS IN CODE MODULE>>           02338000
       RLPARMS = RLP1(4)#;  <<PARM. INFO>>                              02340000
INTEGER ARRAY RLARRAY(0:7);                                             02342000
DEFINE RLNC=RLARRAY(0)#, <<NR.CHAR'S IN NAME>>                          02344000
       RLNAMENW=RLARRAY(1)#, <<NR. WORD IN NAME>>                       02346000
       RLNW=RLARRAY(2)#; <<NR. WORD IN ENTRY>>                          02348000
<<EXTERNAL BUFFER>>                                                     02350000
                                                                        02352000
INTEGER POINTER RLEXTNBUF;  <<EXTERNAL BUFFER>>                         02354000
DEFINE RLEXTNRECD = RLARRAY(3)#; <<FIRST REC. NR. IN BUF>>              02356000
LOGICAL RLEXTNMOD;  <<ENTRY MODIFIED?>>                                 02358000
DEFINE NRRLEXTNRECDS = RLARRAY(4)#;<<REC. CAPACITY OF BUF>>             02360000
DOUBLE RLHEADADR;  <<FILE ADR. OF CURRENT HEADER>>                      02362000
DEFINE RLHEADNW=RLARRAY(5)#; <<NR. WORD IN CUR HEADER>>                 02364000
                                                                        02366000
<<EXTERNAL ENTRY PARAMETERS>>                                           02368000
                                                                        02370000
INTEGER POINTER RLXP;  <<ENTRY POINTER>>                                02372000
DOUBLE POINTER RLXDP = RLXP;  <<ENTRY POINTER>>                         02374000
INTEGER POINTER RLXP1;  <<SECONDARY ENTRY POINTER>>                     02376000
DEFINE RLXLINK = RLXDP#,  <<S.A. OF NEXT HEADER SET>>                   02378000
       RLXTPDB = RLXP(2)#,  <<NR. WORDS OF PRIMARY DB>>                 02380000
       RLXTSDB = RLXP(3)#,  <<NR. WORDS OF SECONDARY DB>>               02382000
       RLXNWSDB = RLXP(4)#,  <<NR. WORDS IN SEC. DB ARRAY>>             02384000
       RLXNWPUST = RLXP(5)#;  <<NR. WORDS IN PUST>>                     02386000
DEFINE RLXCODE = RLXP(-5)#,  <<CODE MODULE DESCRIPTOR>>                 02388000
       RLXINFO = RLXDP(-2)#,  <<S.A. OF INFO BLOCK>>                    02390000
       RLXSA = RLXP(-2)#,  <<S.A. OF ENTRY POINT>>                      02392000
       RLXNAME = RLXP#,  <<EXTERNAL NAME>>                              02394000
       RLXSATISFIEDBIT = RLXP.(0:1)#,  <<SATISFIED BIT>>                02396000
       RLXSATISFIED = LOGICAL(RLXP.(0:1))#,  <<EXTERNAL SATISFIED?>>    02398000
       RLXNC = RLXP.(4:4)#,  <<NR. CHAR'S IN NAME>>                     02400000
       RLXPARMS = RLXP1#;  <<PARM INFO OF EXTERNAL>>                    02402000
                                                                        02404000
<<PROCEDURE BINDING PARAMETERS>>                                        02406000
                                                                        02408000
INTEGER POINTER RLPROCTAB;  <<PROCEDURE TABLE>>                         02410000
DEFINE  NRPROCSADDED = RLARRAY(6)#, <<NR. PROC. ADDED>>                 02412000
        NRPROCSDELETED = RLARRAY(7)#; << DELETED >>                     02414000
LOGICAL CLEANUPRLDIR;  <<UNDELETED ENTRY POINTS REMAINING?>>            02416000
$PAGE "PROCEDURE DECLARATIONS"                                 <<00207>>02418000
<<----------------------------------------------------------------------02420000
*                                                                      *02422000
*  PROCEDURE DECLARATIONS                                              *02424000
*                                                                      *02426000
---------------------------------------------------------------------->>02428000
                                                                        02430000
intrinsic Activate;                                            <<04102>>02432000
intrinsic CreateProcess;                                       <<04102>>02434000
intrinsic Kill;                                                <<04102>>02436000
INTEGER PROCEDURE ADDEDPROC (INFOADR);                                  02438000
   VALUE INFOADR;                                                       02440000
   DOUBLE INFOADR;                                                      02442000
   OPTION FORWARD;                                                      02444000
PROCEDURE ADDENTRY (SIZE);                                              02446000
   VALUE SIZE;                                                          02448000
   INTEGER SIZE;                                                        02450000
   OPTION FORWARD;                                                      02452000
PROCEDURE ADDHASHLIST;                                                  02454000
   OPTION FORWARD;                                                      02456000
PROCEDURE ADDHEADER (SIZE);                                             02458000
   VALUE SIZE;                                                          02460000
   INTEGER SIZE;                                                        02462000
   OPTION FORWARD;                                                      02464000
PROCEDURE ADDTODIRECTORY (SIZE);                                        02466000
   VALUE SIZE;                                                          02468000
   INTEGER SIZE;                                                        02470000
   OPTION FORWARD;                                                      02472000
PROCEDURE ADDTOINFO (SIZE);                                             02474000
   VALUE SIZE;                                                          02476000
   INTEGER SIZE;                                                        02478000
   OPTION FORWARD;                                                      02480000
INTEGER PROCEDURE ADJUSTUSLF (FNUM,NRRECS);                             02482000
   VALUE FNUM,NRRECS;                                                   02484000
   INTEGER FNUM,NRRECS;                                                 02486000
   OPTION EXTERNAL;                                                     02488000
PROCEDURE ALLOCATECOMMON;                                               02490000
   OPTION FORWARD;                                                      02492000
PROCEDURE APPLYBLOCKDATAS;                                              02494000
   OPTION FORWARD;                                                      02496000
PROCEDURE APPENDSTT(CODERECD);                                 <<04257>>02498000
   VALUE CODERECD;                                             <<04257>>02500000
   INTEGER CODERECD;                                           <<04257>>02502000
   OPTION FORWARD;                                                      02504000
INTRINSIC ASCII;                                                        02506000
PROCEDURE AWAKE (PCBINDEX,OLDWAIT,NEWWAIT);                             02508000
   VALUE PCBINDEX,OLDWAIT,NEWWAIT;                                      02510000
   INTEGER PCBINDEX,OLDWAIT,NEWWAIT;                                    02512000
   OPTION EXTERNAL;                                                     02514000
PROCEDURE BINDSEGS;                                                     02516000
   OPTION FORWARD;                                                      02518000
PROCEDURE BLANKLINE;                                                    02520000
   OPTION FORWARD;                                                      02522000
LOGICAL PROCEDURE BLOCKDATARESET;                                       02524000
   OPTION FORWARD;                                                      02526000
PROCEDURE BUFFERDATABYTES (DBADR,BUF,LENGTH,TIMES);                     02528000
   VALUE DBADR,LENGTH,TIMES;                                            02530000
   LOGICAL DBADR,LENGTH;                                                02532000
   BYTE ARRAY BUF;                                                      02534000
   INTEGER TIMES;                                                       02536000
   OPTION FORWARD;                                                      02538000
PROCEDURE BUFFERDATAWORDS (DBADR,BUF,LENGTH,TIMES);                     02540000
   VALUE DBADR,LENGTH,TIMES;                                            02542000
   LOGICAL DBADR,LENGTH;                                                02544000
   INTEGER ARRAY BUF;                                                   02546000
   INTEGER TIMES;                                                       02548000
   OPTION FORWARD;                                                      02550000
LOGICAL PROCEDURE CALENDAR;                                    <<00629>>02552000
   OPTION EXTERNAL;                                            <<00629>>02554000
PROCEDURE CHANGESTATE;                                                  02556000
   OPTION FORWARD;                                                      02558000
PROCEDURE CLEANUPLIBBUF;                                                02560000
   OPTION FORWARD;                                                      02562000
PROCEDURE CLEANUPRLBUF;                                                 02564000
   OPTION FORWARD;                                                      02566000
PROCEDURE CLEANUPRLEXTNBUF;                                             02568000
   OPTION FORWARD;                                                      02570000
PROCEDURE CLEANUPRTBUF;                                                 02572000
   OPTION FORWARD;                                                      02574000
INTEGER PROCEDURE CLEANUSL(USLFNUM,FILENAME);                  <<00207>>02576000
  VALUE USLFNUM;                                               <<00207>>02578000
  INTEGER USLFNUM;                                             <<00207>>02580000
  BYTE ARRAY FILENAME;                                         <<00207>>02582000
  OPTION EXTERNAL;                                             <<00207>>02584000
PROCEDURE CLEARBIT (BITARRAY,BITNUMBER);                                02586000
   VALUE BITNUMBER;                                                     02588000
   INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;                           02590000
   OPTION FORWARD;                                                      02592000
PROCEDURE CLEARLINE;                                                    02594000
   OPTION FORWARD;                                                      02596000
DOUBLE PROCEDURE CLOCK;                                        <<00629>>02598000
   OPTION EXTERNAL;                                            <<00629>>02600000
PROCEDURE CLOSERL;                                                      02604000
   OPTION FORWARD;                                                      02606000
PROCEDURE CLOSESL;                                                      02608000
   OPTION FORWARD;                                                      02610000
PROCEDURE CLOSEUSL;                                                     02612000
   OPTION FORWARD;                                                      02614000
INTEGER PROCEDURE COMPOSEFLUT;                                          02616000
   OPTION FORWARD;                                                      02618000
PROCEDURE COMPOSESTLT;                                                  02620000
   OPTION FORWARD;                                                      02622000
PROCEDURE COPYFAMILY;                                                   02624000
   OPTION FORWARD;                                                      02626000
PROCEDURE COREBUF1 (BUFFER,LENGTH);                                     02630000
   VALUE LENGTH;                                                        02632000
   INTEGER ARRAY BUFFER;                                                02634000
   INTEGER LENGTH;                                                      02636000
   OPTION FORWARD;                                                      02638000
LOGICAL PROCEDURE CORRECTCLASS;                                         02640000
   OPTION FORWARD;                                                      02642000
PROCEDURE CREATECOMENT (DLABEL,TYPE);                                   02644000
   VALUE DLABEL,TYPE;                                                   02646000
   LOGICAL DLABEL,TYPE;                                                 02648000
   OPTION FORWARD;                                                      02650000
PROCEDURE CREATEPATCHENT (TYPE,ADR);                                    02652000
   VALUE TYPE,ADR;                                                      02654000
   INTEGER TYPE,ADR;                                                    02656000
   OPTION FORWARD;                                                      02658000
PROCEDURE CREATESEGENTRY (NAME);                                        02660000
   INTEGER ARRAY NAME;                                                  02662000
   OPTION FORWARD;                                                      02664000
PROCEDURE CREATESYMENT (TYPE,NAME,PARMS);                               02666000
   VALUE TYPE;                                                          02668000
   INTEGER TYPE; BYTE ARRAY NAME; INTEGER ARRAY PARMS;                  02670000
   OPTION FORWARD;                                                      02672000
PROCEDURE DEBUG;                                                        02674000
   OPTION EXTERNAL;                                                     02676000
INTEGER PROCEDURE DELETEDPROC (INFOADR);                                02678000
   VALUE INFOADR;                                                       02680000
   DOUBLE INFOADR;                                                      02682000
   OPTION FORWARD;                                                      02684000
PROCEDURE DELETELIBENTRY;                                               02686000
   OPTION FORWARD;                                                      02688000
PROCEDURE DELETERLENTRY;                                                02690000
   OPTION FORWARD;                                                      02692000
DOUBLE PROCEDURE DELTA(X,F);                                   <<00207>>02694000
   VALUE X,F;                                                  <<00207>>02696000
   DOUBLE X,F;                                                 <<00207>>02698000
   OPTION FORWARD;                                             <<00207>>02700000
INTEGER PROCEDURE DLSIZE (NRWORDS);                                     02702000
   VALUE NRWORDS;                                                       02704000
   INTEGER NRWORDS;                                                     02706000
   OPTION EXTERNAL;                                                     02708000
PROCEDURE DNTOA (NUM,BASE,BA);                                          02710000
   VALUE NUM,BASE;                                                      02712000
   DOUBLE NUM;                                                          02714000
   INTEGER BASE;                                                        02716000
   BYTE ARRAY BA;                                                       02718000
   OPTION FORWARD;                                                      02720000
PROCEDURE EJECTPAGE;                                                    02722000
   OPTION FORWARD;                                                      02724000
PROCEDURE EMITPLABEL;                                                   02726000
   OPTION FORWARD;                                                      02728000
PROCEDURE ENTRYPOINT (SAENTRY);                                         02730000
   VALUE SAENTRY;                                                       02732000
   INTEGER SAENTRY;                                                     02734000
   OPTION FORWARD;                                                      02736000
PROCEDURE ERROR (NUM);                                                  02738000
   VALUE NUM; INTEGER NUM;                                              02740000
   OPTION FORWARD;                                                      02742000
PROCEDURE ERRORI(NUM, NPARM);                                  <<00207>>02744000
   VALUE NUM, NPARM;                                           <<00207>>02746000
   INTEGER NUM, NPARM;                                         <<00207>>02748000
   OPTION FORWARD;                                             <<00207>>02750000
PROCEDURE ERRORN (NUM,NPARM);                                           02752000
   VALUE NUM,NPARM;                                                     02754000
   INTEGER NUM; DOUBLE NPARM;                                           02756000
   OPTION FORWARD;                                                      02758000
PROCEDURE ERRORS (NUM,SPARM);                                           02760000
   VALUE NUM;                                                           02762000
   INTEGER NUM;                                                         02764000
   BYTE ARRAY SPARM;                                                    02766000
   OPTION FORWARD;                                                      02768000
PROCEDURE EXPANDSYMENT (PNTR,NRWORDS);                                  02770000
   VALUE PNTR,NRWORDS;                                                  02772000
   INTEGER POINTER PNTR; INTEGER NRWORDS;                               02774000
   OPTION FORWARD;                                                      02776000
PROCEDURE FCHECK (FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);               02778000
   VALUE FILENUM;                                                       02780000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              02782000
   DOUBLE BLKNUM;                                                       02784000
   OPTION VARIABLE,EXTERNAL;                                            02786000
PROCEDURE FCLOSE (FILENUM,DISPOSITION,SECCODE);                         02788000
   VALUE FILENUM,DISPOSITION,SECCODE;                                   02790000
   INTEGER FILENUM,DISPOSITION,SECCODE;                                 02792000
   OPTION EXTERNAL;                                                     02794000
PROCEDURE FCONTROL (FILENUM,CONTROL,PARM);                              02796000
   VALUE FILENUM,CONTROL;                                               02798000
   INTEGER FILENUM,CONTROL;                                             02800000
   LOGICAL PARM;                                                        02802000
   OPTION EXTERNAL;                                                     02804000
INTEGER PROCEDURE FEOF (FILENUM);                                       02806000
   VALUE FILENUM;                                                       02808000
   INTEGER FILENUM;                                                     02810000
   OPTION FORWARD;                                                      02812000
PROCEDURE FERROR (FILENUM);                                             02814000
   VALUE FILENUM;                                                       02816000
   INTEGER FILENUM;                                                     02818000
   OPTION FORWARD;                                                      02820000
PROCEDURE FGETINFO (FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,         02822000
      DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,         02824000
      PHYSCOUNT,BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABEL,CREATORID,         02826000
      DISKADR);                                                         02828000
   VALUE FILENUM;                                                       02830000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,         02832000
      USERLABEL;                                                        02834000
   BYTE ARRAY FILENAME,CREATORID;                                       02836000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      02838000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;                 02840000
   OPTION VARIABLE,EXTERNAL;                                            02842000
PROCEDURE FINDDIRSPACE (HASHCODE,LENGTH);                               02844000
   VALUE HASHCODE,LENGTH;                                               02846000
   INTEGER HASHCODE,LENGTH;                                             02848000
   OPTION FORWARD;                                                      02850000
PROCEDURE FINDRLDIRSPACE (HASHCODE,NRWORDS);                            02852000
   VALUE HASHCODE,NRWORDS;                                              02854000
   INTEGER HASHCODE,NRWORDS;                                            02856000
   OPTION FORWARD;                                                      02858000
DOUBLE PROCEDURE FINDRLSPACE (NRWORDS,RECFLAG);                         02860000
   VALUE NRWORDS,RECFLAG;                                               02862000
   INTEGER NRWORDS;                                                     02864000
   LOGICAL RECFLAG;                                                     02866000
   OPTION FORWARD;                                                      02868000
INTEGER PROCEDURE FINDSLSPACE (NRRECS);                                 02870000
   VALUE NRRECS;                                                        02872000
   INTEGER NRRECS;                                                      02874000
   OPTION FORWARD;                                                      02876000
PROCEDURE FIXUPRL;                                                      02878000
   OPTION FORWARD;                                                      02880000
PROCEDURE FIXUPSL (REFIX);                                              02882000
   VALUE REFIX;                                                         02884000
   LOGICAL REFIX;                                                       02886000
   OPTION FORWARD;                                                      02888000
PROCEDURE FLOCK (FILENUM,FLAG);                                         02890000
   VALUE FILENUM,FLAG;                                                  02892000
   INTEGER FILENUM;                                                     02894000
   LOGICAL FLAG;                                                        02896000
   OPTION EXTERNAL;                                                     02898000
INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS,AOPTIONS,RECSIZE,      02900000
      DEVICE,FORMMSG,RECMODE,BLOCKFACTOR,NUMBUFFERS,FILESIZE,           02902000
      NUMEXTENTS,INITALLOC,FILECODE);                                   02904000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,      02906000
      FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                           02908000
   BYTE ARRAY FILEDESIGNATOR,DEVICE,FORMMSG;                            02910000
   LOGICAL FOPTIONS,AOPTIONS;                                           02912000
   INTEGER RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,NUMEXTENTS,           02914000
      INITALLOC,FILECODE;                                               02916000
   DOUBLE FILESIZE;                                                     02918000
   OPTION VARIABLE,EXTERNAL;                                            02920000
PROCEDURE FPOINT (FILENUM,RECNUM);                                      02922000
   VALUE FILENUM,RECNUM;                                                02924000
   INTEGER FILENUM;                                                     02926000
   DOUBLE RECNUM;                                                       02928000
   OPTION EXTERNAL;                                                     02930000
PROCEDURE FREADDIR (FILENUM,TARGET,TCOUNT,RECNUM);                      02932000
   VALUE FILENUM,TCOUNT,RECNUM;                                         02934000
   INTEGER FILENUM,TCOUNT;                                              02936000
   ARRAY TARGET;                                                        02938000
   DOUBLE RECNUM;                                                       02940000
   OPTION EXTERNAL;                                                     02942000
PROCEDURE FREADDIR' (FILENUM,TARGET,RECNUM);                            02944000
   VALUE FILENUM,RECNUM;                                                02946000
   INTEGER FILENUM,RECNUM;                                              02948000
   INTEGER ARRAY TARGET;                                                02950000
   OPTION FORWARD;                                                      02952000
PROCEDURE FREADMR''(FILENUM,TARGET,COUNT,RECNUM);                       02954000
   VALUE FILENUM,COUNT,RECNUM;                                          02956000
   INTEGER FILENUM,COUNT,RECNUM;                                        02958000
   INTEGER ARRAY TARGET;                                                02960000
   OPTION FORWARD;                                                      02962000
PROCEDURE FRENAME(FILENUM, NEWFILEREFERENCE);                  <<00207>>02964000
   VALUE FILENUM; INTEGER FILENUM;                             <<00207>>02966000
   BYTE ARRAY NEWFILEREFERENCE;                                <<00207>>02968000
   OPTION EXTERNAL;                                            <<00207>>02970000
PROCEDURE FUNLOCK (FILENUM);                                            02972000
   VALUE FILENUM;                                                       02974000
   INTEGER FILENUM;                                                     02976000
   OPTION EXTERNAL;                                                     02978000
PROCEDURE FWRITE (FILENUM,TARGET,TCOUNT,CONTROL);                       02980000
   VALUE FILENUM,TCOUNT,CONTROL;                                        02982000
   INTEGER FILENUM,TCOUNT;                                              02984000
   ARRAY TARGET;                                                        02986000
   LOGICAL CONTROL;                                                     02988000
   OPTION EXTERNAL;                                                     02990000
PROCEDURE FWRITEDIR (FILENUM,TARGET,TCOUNT,RECNUM);                     02992000
   VALUE FILENUM,TCOUNT,RECNUM;                                         02994000
   INTEGER FILENUM,TCOUNT;                                              02996000
   ARRAY TARGET;                                                        02998000
   DOUBLE RECNUM;                                                       03000000
   OPTION EXTERNAL;                                                     03002000
PROCEDURE FWRITEDIR' (FILENUM,TARGET,RECNUM);                           03004000
   VALUE FILENUM,RECNUM;                                                03006000
   INTEGER FILENUM,RECNUM;                                              03008000
   INTEGER ARRAY TARGET;                                                03010000
   OPTION FORWARD;                                                      03012000
PROCEDURE FWRITEMR''(FILENUM,TARGET,COUNT,RECNUM);                      03014000
   VALUE FILENUM,COUNT,RECNUM;                                          03016000
   INTEGER FILENUM,COUNT,RECNUM;                                        03018000
   INTEGER ARRAY TARGET;                                                03020000
   OPTION FORWARD;                                                      03022000
PROCEDURE GETBROTHER;                                                   03024000
   OPTION FORWARD;                                                      03026000
PROCEDURE GETDIR;                                                       03028000
   OPTION FORWARD;                                                      03030000
PROCEDURE GETENTRY (FILEADR);                                           03032000
   VALUE FILEADR;                                                       03034000
   INTEGER FILEADR;                                                     03036000
   OPTION FORWARD;                                                      03038000
LOGICAL PROCEDURE GETFAMILY (FATHERADR);                                03040000
   VALUE FATHERADR;                                                     03042000
   INTEGER FATHERADR;                                                   03044000
   OPTION FORWARD;                                                      03046000
PROCEDURE GETFATHER;                                                    03048000
   OPTION FORWARD;                                                      03050000
PROCEDURE GETHEADER (CODEFLAG,FILEADR);                                 03052000
   VALUE CODEFLAG,FILEADR;                                              03054000
   LOGICAL CODEFLAG;                                                    03056000
   DOUBLE FILEADR;                                                      03058000
   OPTION FORWARD;                                                      03060000
PROCEDURE GETINFO;                                                      03062000
   OPTION FORWARD;                                                      03064000
INTEGER PROCEDURE GETJCW;                                               03066000
   OPTION EXTERNAL;                                                     03068000
LOGICAL PROCEDURE GETNEXTDESCRIP;                                       03070000
   OPTION FORWARD;                                                      03072000
LOGICAL PROCEDURE GETNEXTHEADER (CODEFLAG,BITMAP);                      03074000
   VALUE CODEFLAG,BITMAP;                                               03076000
   LOGICAL CODEFLAG,BITMAP;                                             03078000
   OPTION FORWARD;                                                      03080000
LOGICAL PROCEDURE GETNEXTLIBENTRY;                                      03082000
   OPTION FORWARD;                                                      03084000
LOGICAL PROCEDURE GETNEXTLIBRECD;                                       03086000
   OPTION FORWARD;                                                      03088000
LOGICAL PROCEDURE GETNEXTRLENTRY;                                       03090000
   OPTION FORWARD;                                                      03092000
LOGICAL PROCEDURE GETNEXTRLEXTN;                                        03094000
   OPTION FORWARD;                                                      03096000
LOGICAL PROCEDURE GETNEXTRLHEADER;                                      03098000
   OPTION FORWARD;                                                      03100000
LOGICAL PROCEDURE GETNEXTRLRECD;                                        03102000
   OPTION FORWARD;                                                      03104000
LOGICAL PROCEDURE GETNEXTSLEXTN;                                        03106000
   OPTION FORWARD;                                                      03108000
PROCEDURE GETPRIVMODE;                                                  03110000
   OPTION EXTERNAL;                                                     03112000
PROCEDURE GETRECDDISP (FILEADR,RECD,DISP);                              03114000
   VALUE FILEADR;                                                       03116000
   DOUBLE FILEADR; INTEGER RECD,DISP;                                   03118000
   OPTION FORWARD;                                                      03120000
PROCEDURE GETREFTABENTRY (ENTRYNR);                                     03122000
   VALUE ENTRYNR;                                                       03124000
   INTEGER ENTRYNR;                                                     03126000
   OPTION FORWARD;                                                      03128000
PROCEDURE GETRLMAP (SECTIONNR);                                         03130000
   VALUE SECTIONNR;                                                     03132000
   INTEGER SECTIONNR;                                                   03134000
   OPTION FORWARD;                                                      03136000
PROCEDURE GETSEGENTRY;                                                  03138000
   OPTION FORWARD;                                                      03140000
PROCEDURE GETSLMAP (SECTIONNR);                                         03142000
   VALUE SECTIONNR;                                                     03144000
   INTEGER SECTIONNR;                                                   03146000
   OPTION FORWARD;                                                      03148000
PROCEDURE GETSON;                                                       03150000
   OPTION FORWARD;                                                      03152000
PROCEDURE GETUSERMODE;                                                  03154000
   OPTION EXTERNAL;                                                     03156000
PROCEDURE INITLOADCACHE;                                       <<00807>>03158000
   OPTION EXTERNAL;                                            <<00807>>03160000
INTEGER PROCEDURE HASH (NAME);                                          03162000
   BYTE ARRAY NAME;                                                     03164000
   OPTION FORWARD;                                                      03166000
PROCEDURE HEADER1P (RLFLAG);                                            03168000
   VALUE RLFLAG;                                                        03170000
   LOGICAL RLFLAG;                                                      03172000
   OPTION FORWARD;                                                      03174000
PROCEDURE HEADER2P;                                                     03176000
   OPTION FORWARD;                                                      03178000
PROCEDURE HEADER3P;                                                     03180000
   OPTION FORWARD;                                                      03182000
PROCEDURE HEADER4P;                                                     03184000
   OPTION FORWARD;                                                      03186000
PROCEDURE HEADER7P;                                                     03188000
   OPTION FORWARD;                                                      03190000
PROCEDURE HEADER9P;                                                     03192000
   OPTION FORWARD;                                                      03194000
PROCEDURE HEADER11P;                                                    03196000
   OPTION FORWARD;                                                      03198000
PROCEDURE HEADER9S;                                                     03200000
   OPTION FORWARD;                                                      03202000
PROCEDURE HEADER10S;                                                    03204000
   OPTION FORWARD;                                                      03206000
INTEGER PROCEDURE INITUSLF (USLFNUM,REC0);                     <<C+.06>>03208000
    VALUE USLFNUM; INTEGER USLFNUM;                            <<C+.06>>03210000
    INTEGER ARRAY REC0;                                        <<C+.06>>03212000
    OPTION EXTERNAL;                                           <<C+.06>>03214000
PROCEDURE INSERTRL;                                                     03216000
   OPTION FORWARD;                                                      03218000
PROCEDURE INSERTSL;                                                     03220000
   OPTION FORWARD;                                                      03222000
PROCEDURE LISTRL';                                                      03224000
   OPTION FORWARD;                                                      03226000
PROCEDURE LISTSL';                                                      03228000
   OPTION FORWARD;                                                      03230000
PROCEDURE LISTUSL';                                                     03232000
   OPTION FORWARD;                                                      03234000
LOGICAL PROCEDURE LOADEDSLSEG (SLKEY,SEGNR);                            03236000
   VALUE SLKEY,SEGNR;                                                   03238000
   DOUBLE SLKEY;                                                        03240000
   INTEGER SEGNR;                                                       03242000
   OPTION EXTERNAL;                                                     03244000
PROCEDURE LOADSLSTT;                                                    03246000
   OPTION FORWARD;                                                      03248000
PROCEDURE LOCKSEG(EN,TEST,PINX);                               <<00.EB>>03250000
   VALUE EN,TEST,PINX;                                         <<00.EB>>03252000
   INTEGER EN,PINX;                                            <<00.EB>>03254000
   LOGICAL TEST;                                               <<00.EB>>03256000
   OPTION EXTERNAL;                                            <<00.EB>>03258000
PROCEDURE MAKEPATCHES;                                                  03260000
   OPTION FORWARD;                                                      03262000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       03264000
   VALUE NRWORDS;                                                       03266000
   INTEGER NRWORDS;                                                     03268000
   OPTION FORWARD;                                                      03270000
PROCEDURE MASTERBUF (TFNUM,SFNUM,TBUF,TRECD,TDISP,                      03272000
                     FLAG,ADR,BUFFER,LENGTH);                           03274000
   VALUE TFNUM,SFNUM,FLAG,ADR,LENGTH;                                   03276000
   INTEGER TFNUM,SFNUM,TRECD,TDISP,LENGTH;                              03278000
   INTEGER ARRAY TBUF,BUFFER;                                           03280000
   DOUBLE ADR;                                                          03282000
   LOGICAL FLAG;                                                        03284000
   OPTION FORWARD;                                                      03286000
INTEGER PROCEDURE MESSAGE (NR,BUF);                                     03288000
   VALUE NR;                                                            03290000
   INTEGER NR;                                                          03292000
   BYTE ARRAY BUF;                                                      03294000
   OPTION FORWARD;                                                      03296000
INTEGER PROCEDURE MIN2(A,B);                                            03298000
   VALUE A,B;                                                           03300000
   INTEGER A,B;                                                         03302000
   OPTION FORWARD;                                                      03304000
INTEGER PROCEDURE MIN3(A,B,C);                                          03306000
   VALUE A,B,C;                                                         03308000
   INTEGER A,B,C;                                                       03310000
   OPTION FORWARD;                                                      03312000
PROCEDURE MOVEINFO (NRRECORDS);                                         03314000
   VALUE NRRECORDS;                                                     03316000
   INTEGER NRRECORDS;                                                   03318000
   OPTION FORWARD;                                                      03320000
PROCEDURE NTOA (NUM,BASE,BA);                                           03322000
   VALUE NUM,BASE;                                                      03324000
   INTEGER NUM,BASE;                                                    03326000
   BYTE ARRAY BA;                                                       03328000
   OPTION FORWARD;                                                      03330000
PROCEDURE OLDFILE( NAME, ERRNUM);                              <<00648>>03332000
   VALUE ERRNUM;                                               <<00648>>03334000
   BYTE ARRAY NAME;                                            <<00648>>03336000
   INTEGER ERRNUM;                                             <<00648>>03338000
   OPTION FORWARD;                                             <<00648>>03340000
PROCEDURE OPENRL (NEWFILE);                                             03344000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      03346000
   OPTION FORWARD;                                                      03348000
PROCEDURE OPENSL (NEWFILE);                                             03350000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      03352000
   OPTION FORWARD;                                                      03354000
PROCEDURE OPENUSL (NEWFILE);                                            03356000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      03358000
   OPTION FORWARD;                                                      03360000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                   <<00595>>03362000
   INTEGER ARRAY FORMALP,ACTUALP,PARMS;                        <<00595>>03364000
   OPTION FORWARD;                                                      03366000
INTEGER PROCEDURE PARMLEN (PARMS);                                      03368000
   INTEGER ARRAY PARMS;                                                 03370000
   OPTION FORWARD;                                                      03372000
INTEGER PROCEDURE PHYSICALCST(PIN,SEGMENTNR);                  <<00.EB>>03374000
   VALUE PIN,SEGMENTNR;                                        <<00.EB>>03376000
   INTEGER PIN,SEGMENTNR;                                      <<00.EB>>03378000
   OPTION EXTERNAL;                                            <<00.EB>>03380000
PROCEDURE PREPAREPROGRAM;                                               03382000
   OPTION FORWARD;                                                      03384000
PROCEDURE PREPARERL (CODERECD);                                         03386000
   VALUE CODERECD;                                                      03388000
   INTEGER CODERECD;                                                    03390000
   OPTION FORWARD;                                                      03392000
PROCEDURE PREPARESEGMENT (SEGADR,CODEFNUM,CODERECD);                    03394000
   VALUE SEGADR,CODEFNUM,CODERECD;                                      03396000
   INTEGER SEGADR,CODEFNUM,CODERECD;                                    03398000
   OPTION FORWARD;                                                      03400000
PROCEDURE PRINT (MESSAGE,LENGTH,CONTROL);                               03402000
   VALUE LENGTH,CONTROL;                                                03404000
   ARRAY MESSAGE;                                                       03406000
   INTEGER LENGTH,CONTROL;                                              03408000
   OPTION EXTERNAL;                                                     03410000
PROCEDURE PRINTERROR (ERROR,NERROR,SERROR1,SERROR2);           <<00595>>03412000
   VALUE ERROR,NERROR;                                                  03414000
   INTEGER ERROR;                                                       03416000
   DOUBLE NERROR;                                                       03418000
   BYTE ARRAY SERROR1,SERROR2;                                 <<00595>>03420000
   OPTION FORWARD;                                                      03422000
PROCEDURE PRINTFILERROR(ERROR,NERROR,SERROR1,SERROR2);         <<00595>>03424000
   VALUE ERROR,NERROR;                                                  03426000
   INTEGER ERROR;                                                       03428000
   DOUBLE NERROR;                                                       03430000
   BYTE ARRAY SERROR1,SERROR2;                                 <<00595>>03432000
   OPTION FORWARD;                                                      03434000
PROCEDURE PRINTLINE;                                                    03436000
   OPTION FORWARD;                                                      03438000
PROCEDURE PRINTWARNING (ERROR,NERROR,SERROR1,SERROR2);         <<00595>>03440000
   VALUE ERROR,NERROR;                                                  03442000
   INTEGER ERROR;                                                       03444000
   DOUBLE NERROR;                                                       03446000
   BYTE ARRAY SERROR1,SERROR2;                                 <<00595>>03448000
   OPTION FORWARD;                                                      03450000
DOUBLE PROCEDURE PROCTIME;                                              03452000
   OPTION EXTERNAL;                                                     03454000
PROCEDURE PUTDIR;                                                       03456000
   OPTION FORWARD;                                                      03458000
PROCEDURE PUTINFO;                                                      03460000
   OPTION FORWARD;                                                      03462000
PROCEDURE QUIT (NUM);                                                   03464000
   VALUE NUM;                                                           03466000
   INTEGER NUM;                                                         03468000
   OPTION EXTERNAL;                                                     03470000
LOGICAL PROCEDURE RECEIVEMAIL (PIN,BUFFER,WAITFLAG);                    03472000
   VALUE PIN,WAITFLAG;                                                  03474000
   LOGICAL PIN,WAITFLAG;                                                03476000
   INTEGER ARRAY BUFFER;                                                03478000
   OPTION EXTERNAL;                                                     03480000
PROCEDURE REMOVEFAMILY (FATHERADR);                                     03482000
   VALUE FATHERADR;                                                     03484000
   INTEGER FATHERADR;                                                   03486000
   OPTION FORWARD;                                                      03488000
PROCEDURE REMOVERL;                                                     03490000
   OPTION FORWARD;                                                      03492000
PROCEDURE REMOVESL;                                                     03494000
   OPTION FORWARD;                                                      03496000
PROCEDURE REPAIRRECORD (FNUM,FILEADR,NEWWORD);                          03498000
   VALUE FNUM,FILEADR,NEWWORD;                                          03500000
   INTEGER FNUM,NEWWORD; DOUBLE FILEADR;                                03502000
   OPTION FORWARD;                                                      03504000
PROCEDURE REPAIRRECORD' (FNUM,RECD,DISP,NEWWORD);                       03506000
   VALUE FNUM,RECD,DISP,NEWWORD;                                        03508000
   INTEGER FNUM,RECD,DISP,NEWWORD;                                      03510000
   OPTION FORWARD;                                                      03512000
PROCEDURE RESETCONTROL;                                        <<00.DM>>03514000
   OPTION EXTERNAL;                                            <<00.DM>>03516000
PROCEDURE RESETDB (PARM);                                               03518000
   VALUE PARM;                                                          03520000
   INTEGER PARM;                                                        03522000
   OPTION EXTERNAL;                                                     03524000
PROCEDURE RETURNRLSPACE (ADR,NRWORDS);                                  03526000
   VALUE ADR,NRWORDS;                                                   03528000
   DOUBLE ADR;                                                          03530000
   INTEGER NRWORDS;                                                     03532000
   OPTION FORWARD;                                                      03534000
PROCEDURE RETURNSLSPACE (RECD,NRRECS);                                  03536000
   VALUE RECD,NRRECS;                                                   03538000
   INTEGER RECD,NRRECS;                                                 03540000
   OPTION FORWARD;                                                      03542000
PROCEDURE RLENTRYPARMS;                                                 03544000
   OPTION FORWARD;                                                      03546000
PROCEDURE SAVERLMAP;                                                    03548000
   OPTION FORWARD;                                                      03550000
PROCEDURE SAVESLMAP;                                                    03552000
   OPTION FORWARD;                                                      03554000
PROCEDURE SCANRL;                                                       03556000
   OPTION FORWARD;                                                      03558000
PROCEDURE SCANSEGMENT (SEGADR);                                         03560000
   VALUE SEGADR;                                                        03562000
   INTEGER SEGADR;                                                      03564000
   OPTION FORWARD;                                                      03566000
LOGICAL PROCEDURE SEARCHCOMMON (DLABEL,TYPE);                           03568000
   VALUE DLABEL,TYPE;                                                   03570000
   LOGICAL DLABEL,TYPE;                                                 03572000
   OPTION FORWARD;                                                      03574000
LOGICAL PROCEDURE SEARCHRL (NAME);                                      03576000
   INTEGER ARRAY NAME;                                                  03578000
   OPTION FORWARD;                                                      03580000
LOGICAL PROCEDURE SEARCHRLTAB (INFOADR);                                03582000
   VALUE INFOADR;                                                       03584000
   DOUBLE INFOADR;                                                      03586000
   OPTION FORWARD;                                                      03588000
INTEGER PROCEDURE SEARCHSEGNAME (NAME);                                 03590000
   BYTE ARRAY NAME;                                                     03592000
   OPTION FORWARD;                                                      03594000
LOGICAL PROCEDURE SEARCHSPL (NAME);                                     03596000
   INTEGER ARRAY NAME;                                                  03598000
   OPTION FORWARD;                                                      03600000
LOGICAL PROCEDURE SEARCHSYM (NAME,TYPE);                                03602000
   VALUE TYPE;                                                          03604000
   integer array Name; logical Type;                                    03606000
   OPTION FORWARD;                                                      03608000
LOGICAL PROCEDURE SEARCHUSL (NAME,INDEX,TYPE,MODE');           <<03026>>03610000
   VALUE INDEX,TYPE,MODE';                                     <<03026>>03612000
   LOGICAL MODE';                                              <<03026>>03614000
   INTEGER ARRAY NAME; INTEGER INDEX,TYPE;                              03616000
   OPTION FORWARD,VARIABLE;                                    <<03026>>03618000
LOGICAL PROCEDURE SENDMAIL (PIN,COUNT,BUFFER,WAITFLAG);                 03622000
   VALUE PIN,COUNT,WAITFLAG;                                            03624000
   LOGICAL PIN,COUNT,WAITFLAG;                                          03626000
   INTEGER ARRAY BUFFER;                                                03628000
   OPTION EXTERNAL;                                                     03630000
PROCEDURE SETACTIVITY (ADFLAG);                                         03632000
   VALUE ADFLAG;                                                        03634000
   LOGICAL ADFLAG;                                                      03636000
   OPTION FORWARD;                                                      03638000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  03640000
   VALUE BITNUMBER;                                                     03642000
   INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;                           03644000
   OPTION FORWARD;                                                      03646000
PROCEDURE SETJCW (PARM);                                                03648000
   VALUE PARM;                                                          03650000
   INTEGER PARM;                                                        03652000
   OPTION EXTERNAL;                                                     03654000
INTEGER PROCEDURE SETSYSDB;                                             03656000
   OPTION EXTERNAL;                                                     03658000
PROCEDURE SETUPLIBBUF;                                                  03660000
   OPTION FORWARD;                                                      03662000
PROCEDURE SETUPRLBUF;                                                   03664000
   OPTION FORWARD;                                                      03666000
PROCEDURE SETUPRLEXTNBUF (EXTNADR);                                     03668000
   VALUE EXTNADR;                                                       03670000
   DOUBLE EXTNADR;                                                      03672000
   OPTION FORWARD;                                                      03674000
PROCEDURE SETUPRLHEADERS (ADR);                                         03676000
   VALUE ADR;                                                           03678000
   DOUBLE ADR;                                                          03680000
   OPTION FORWARD;                                                      03682000
PROCEDURE SPLENTRYPARMS;                                                03686000
   OPTION FORWARD;                                                      03688000
INTEGER PROCEDURE STACKSIZE (NRWORDS);                                  03690000
   VALUE NRWORDS;                                                       03692000
   INTEGER NRWORDS;                                                     03694000
   OPTION EXTERNAL;                                                     03696000
PROCEDURE STORESLSTT;                                                   03698000
   OPTION FORWARD;                                                      03700000
INTEGER PROCEDURE SUMBITS (BITARRAY);                                   03702000
   INTEGER ARRAY BITARRAY;                                              03704000
   OPTION FORWARD;                                                      03706000
PROCEDURE SYMENTPARMS;                                                  03708000
   OPTION FORWARD;                                                      03710000
PROCEDURE SYSTEMDEBUG;                                                  03712000
   OPTION EXTERNAL;                                                     03714000
PROCEDURE TERMINATE;                                                    03716000
   OPTION EXTERNAL;                                                     03718000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         03720000
   VALUE BITNUMBER;                                                     03722000
   INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;                           03724000
   OPTION FORWARD;                                                      03726000
INTEGER PROCEDURE THISCPU;                                     <<00.DM>>03728000
   OPTION EXTERNAL;                                            <<00.DM>>03730000
DOUBLE PROCEDURE TIMER;                                                 03732000
   OPTION EXTERNAL;                                                     03734000
PROCEDURE TRANSCLOSURE;                                                 03736000
   OPTION FORWARD;                                                      03738000
PROCEDURE UNLINKFAMILY (FATHERADR);                                     03740000
   VALUE FATHERADR;                                                     03742000
   INTEGER FATHERADR;                                                   03744000
   OPTION FORWARD;                                                      03746000
PROCEDURE USLCOPY;                                             <<00207>>03748000
   OPTION FORWARD;                                             <<00207>>03750000
PROCEDURE USLENTRYPARMS;                                                03752000
   OPTION FORWARD;                                                      03754000
PROCEDURE WARN (NUM);                                                   03756000
   VALUE NUM;                                                           03758000
   INTEGER NUM;                                                         03760000
   OPTION FORWARD;                                                      03762000
PROCEDURE WARNS (NUM,SPARM);                                            03764000
   VALUE NUM;                                                           03766000
   INTEGER NUM;                                                         03768000
   BYTE ARRAY SPARM;                                                    03770000
   OPTION FORWARD;                                                      03772000
PROCEDURE WHO (MODE,CAPABILITY,LATTR,USERN,GROUPN,ACCTN,HOMEN,TERMN);   03774000
   LOGICAL MODE,TERMN;                                                  03776000
   DOUBLE CAPABILITY,LATTR;                                             03778000
   BYTE ARRAY USERN,GROUPN,ACCTN,HOMEN;                                 03780000
   OPTION VARIABLE,EXTERNAL;                                            03782000
PROCEDURE XCONTRAP( PLABEL, OLDPLABEL);                        <<00.DM>>03784000
   VALUE PLABEL;                                               <<00.DM>>03786000
   INTEGER PLABEL, OLDPLABEL;                                  <<00.DM>>03788000
   OPTION EXTERNAL;                                            <<00.DM>>03790000
PROCEDURE PMAPCBINIT(FNUM,PMAPCB,STATUS);                      <<04584>>03792000
   VALUE FNUM;                                                 <<04584>>03794000
   INTEGER FNUM,STATUS;                                        <<04584>>03796000
   INTEGER ARRAY PMAPCB;                                       <<04584>>03798000
   OPTION EXTERNAL;                                            <<04584>>03800000
PROCEDURE PMAPFINDSEGNUM(SEGNUM,PMAPCB,STATUS);                <<04584>>03802000
   VALUE SEGNUM;                                               <<04584>>03804000
   INTEGER SEGNUM,STATUS;                                      <<04584>>03806000
   INTEGER ARRAY PMAPCB;                                       <<04584>>03808000
   OPTION EXTERNAL;                                            <<04584>>03810000
LOGICAL PROCEDURE GETIPMAPREC(BUF,PTR,SCAN',PMAPCB,STATUS);    <<04584>>03812000
   VALUE SCAN';                                                <<04584>>03814000
   INTEGER SCAN',STATUS;                                       <<04584>>03816000
   INTEGER ARRAY BUF,PMAPCB;                                   <<04584>>03818000
   INTEGER POINTER PTR;                                        <<04584>>03820000
   OPTION EXTERNAL;                                            <<04584>>03822000
PROCEDURE BUILDNAMEBLOCK(BLOCK,BLOCKLEN,STRING,STRLEN,STA);    <<04584>>03824000
   VALUE BLOCKLEN,STRLEN;                                      <<04584>>03826000
   INTEGER BLOCKLEN,STRLEN,STA;                                <<04584>>03828000
   BYTE ARRAY BLOCK,STRING;                                    <<04584>>03830000
   OPTION VARIABLE,EXTERNAL;                                   <<04584>>03832000
LOGICAL PROCEDURE NAMESMATCH(NAME1,NAME2);                     <<04584>>03834000
   BYTE ARRAY NAME1,NAME2;                                     <<04584>>03836000
   OPTION EXTERNAL;                                            <<04584>>03838000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FERROR"                  <<00207>>03840000
$ CONTROL SEGMENT = SEG3                                                03842000
PROCEDURE FERROR (FILENUM);                                             03844000
   <<THIS PROCEDURE CHECKS THE FILE SYSTEM ERROR AND PRINTS A MESSAGE>> 03846000
   VALUE FILENUM;                                                       03848000
   INTEGER FILENUM;                                                     03850000
   BEGIN                                                                03852000
   BYTE ARRAY FILETYPE (0:15);                                          03854000
   TOS _ 84;  <<EOF ERROR NR.>>                                         03856000
   TOS _ 0D; FCHECK(FILENUM,S0);  <<FILE SYS. ERROR NR.>>               03858000
   TOS _ 0;  <<FOR RESULT OF MESSAGE>>                                  03860000
   IF FILENUM = USLFNUM THEN                                            03862000
      BEGIN                                                             03864000
      TOS := 200;                                                       03866000
      IF LOGICAL(STATECHANGED) THEN TOS := TOS+1;  <<AUX. USL?>>        03868000
      GO L1                                                             03870000
      END;                                                              03872000
   IF FILENUM = XUSLFNUM THEN                                           03874000
      BEGIN                                                             03876000
      TOS := 201;                                                       03878000
      IF LOGICAL(STATECHANGED) THEN TOS := TOS-1;  <<USL FILE?>>        03880000
      GO L1                                                             03882000
      END;                                                              03884000
   IF FILENUM = SPLFNUM THEN BEGIN TOS _ 202; GO L1 END;                03886000
   IF FILENUM = RLFNUM THEN BEGIN TOS _ 203; GO L1 END;                 03888000
   IF FILENUM = RLIBFNUM THEN BEGIN TOS _ 204; GO L1 END;               03890000
   IF FILENUM = PROGFNUM THEN BEGIN TOS _ 205; GO L1 END;               03892000
   IF FILENUM = LISTFNUM THEN BEGIN TOS _ 206; GO L1 END;               03894000
   IF FILENUM=OSPLFNUM THEN BEGIN TOS:=208; GO L1 END;         <<00465>>03896000
   IF FILENUM=NUSLFNUM THEN BEGIN TOS:=209; GO L1 END;         <<00207>>03898000
   TOS _ 207;  <<SCRATCH FILE>>                                         03900000
   L1:                                                                  03902000
   FILETYPE _ MESSAGE(*,FILETYPE(1));                                   03904000
   PRINTFILERROR(*,*,FILETYPE,NULL);                           <<00595>>03906000
   <<********************************************************>><<01.DM>>03908000
   << PRESERVE ANY INFORMATION IN CORE THAT MAY BE DESTROYED >><<01.DM>>03910000
   << BY ABORTING.  NOTE: WE WILL NOT TRY TO SAVE THE INFO   >><<01.DM>>03912000
   << OF THE FILE THAT GOT THE ERROR SINCE THIS COULD BUT US >><<01.DM>>03914000
   << INTO AN ENDLESS LOOP.                                  >><<01.DM>>03916000
   <<********************************************************>><<01.DM>>03918000
   IF FILENUM <> SPLFNUM THEN CLOSESL;                         <<01.DM>>03920000
   IF FILENUM <> RLFNUM THEN CLOSERL;                          <<01.DM>>03922000
   IF FILENUM <> USLFNUM THEN                                  <<01.DM>>03924000
      BEGIN                                                    <<01.DM>>03926000
      IF LOGICAL(STATECHANGED) THEN CHANGESTATE; <<ORIG>>      <<01.DM>>03928000
      CLOSEUSL;                                                <<01.DM>>03930000
      END;                                                     <<01.DM>>03932000
   QUIT(0)                                                              03934000
   END;                                                                 03936000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FEOF"                    <<00207>>03938000
$ CONTROL SEGMENT = SEG3                                                03940000
INTEGER PROCEDURE FEOF (FILENUM);                                       03942000
   <<RETURNS THE END-OF-FILE RECORD NUMBER FOR THE SPECIFIED FILE>>     03944000
   VALUE FILENUM;                                                       03946000
   INTEGER FILENUM;                                                     03948000
   BEGIN                                                                03950000
   TOS _ 0D;                                                            03952000
   FGETINFO(FILENUM,,,,,,,,,,DS1);  <<GET EOF>>                         03954000
   FEOF _ TOS                                                           03956000
   END;                                                                 03958000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FREADDIR'"               <<00207>>03960000
$ CONTROL SEGMENT = SEG3                                                03962000
PROCEDURE FREADDIR' (FILENUM,TARGET,RECNUM);                            03964000
   <<INTERFACE TO FREADDIR: ADDS THE RECORD SIZE OF 128 WORDS AND       03966000
     CONVERTS THE RECORD NUMBER TO DOUBLE>>                             03968000
   VALUE FILENUM,RECNUM;                                                03970000
   INTEGER FILENUM,RECNUM; INTEGER ARRAY TARGET;                        03972000
   BEGIN                                                                03974000
   FREADDIR(FILENUM,TARGET,128,DOUBLE(LOGICAL(RECNUM)));                03976000
   IF <> THEN FERROR(FILENUM)  <<ERROR?>>                               03978000
   END;                                                                 03980000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FWRITEDIR'"              <<00207>>03982000
$ CONTROL SEGMENT = SEG3                                                03984000
PROCEDURE FWRITEDIR' (FILENUM,TARGET,RECNUM);                           03986000
   <<INTERFACE TO FWRITEDIR: ADDS THE RECORD SIZE OF 128 WORDS AND      03988000
     CONVERTS THE RECORD NUMBER TO DOUBLE>>                             03990000
   VALUE FILENUM,RECNUM;                                                03992000
   INTEGER FILENUM,RECNUM; INTEGER ARRAY TARGET;                        03994000
   BEGIN                                                                03996000
   FWRITEDIR(FILENUM,TARGET,128,DOUBLE(LOGICAL(RECNUM)));               03998000
   IF <> THEN FERROR(FILENUM)  <<ERROR?>>                               04000000
   END;                                                                 04002000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FREADMR''"               <<00207>>04004000
$ CONTROL SEGMENT = SEG3                                                04006000
PROCEDURE FREADMR''(FILENUM,TARGET,COUNT,RECNUM);                       04008000
   <<INTERFACE TO FILE SYSTEM MULIT-RECORD READ>>                       04010000
   VALUE FILENUM,COUNT,RECNUM;                                          04012000
   INTEGER FILENUM,COUNT,RECNUM;                                        04014000
   INTEGER ARRAY TARGET;                                                04016000
   BEGIN                                                                04018000
   ENTRY FREADMR';                                                      04020000
   TOS := FILENUM;  <<FILE NR.>>                                        04022000
   TOS := @TARGET;  <<BUFFER ADR.>>                                     04024000
   TOS := COUNT;  <<WORD COUNT>>                                        04026000
   IF = THEN GO GETOUT;  <<ZERO COUNT?>>                                04028000
   FREADDIR(*,*,*,DOUBLE(LOGICAL(RECNUM)));                             04030000
   IF > THEN  <<EOF?>>                                                  04032000
      BEGIN                                                             04034000
      COUNT _ (FEOF(FILENUM)-RECNUM)&LSL(7);  <<ADJ. COUNT>>            04036000
      GO READ                                                           04038000
      END;                                                              04040000
   GO READCHECK;                                                        04042000
                                                                        04044000
   FREADMR': READ:                                                      04046000
   FREADDIR(FILENUM,TARGET,COUNT,DOUBLE(LOGICAL(RECNUM)));              04048000
                                                                        04050000
   READCHECK:                                                           04052000
   IF <> THEN FERROR(FILENUM);  <<ERROR?>>                              04054000
                                                                        04056000
   GETOUT:                                                              04058000
   END;                                                                 04060000
$PAGE "GENERAL PURPOSE PROCEDURES  -  FWRITEMR''"              <<00207>>04062000
$ CONTROL SEGMENT = SEG3                                                04064000
PROCEDURE FWRITEMR''(FILENUM,TARGET,COUNT,RECNUM);                      04066000
   <<INTEGFACE TO FILE SYSTEM MULTI-RECORD WRITE>>                      04068000
   VALUE FILENUM,COUNT,RECNUM;                                          04070000
   INTEGER FILENUM,COUNT,RECNUM;                                        04072000
   INTEGER ARRAY TARGET;                                                04074000
   BEGIN                                                                04076000
   ENTRY FWRITEMR';                                                     04078000
   COUNT _ MIN2(FEOF(FILENUM)-RECNUM,COUNT&LSR(7))&LSL(7);              04080000
                                                                        04082000
   FWRITEMR':                                                           04084000
   FWRITEDIR(FILENUM,TARGET,COUNT,DOUBLE(LOGICAL(RECNUM)));             04086000
   IF <> THEN FERROR(FILENUM)  <<ERROR?>>                               04088000
   END;                                                                 04090000
$PAGE "GENERAL PURPOSE PROCEDURES  -  CLEANLINE"               <<00207>>04092000
$ CONTROL SEGMENT = SEG3                                                04094000
PROCEDURE CLEARLINE;                                                    04096000
   <<CLEARS THE LIST BUFFER>>                                           04098000
   BEGIN                                                                04100000
   TOS _ @LINE; PS0 _ "  ";                                             04102000
   ASSEMBLE(DUP,INCB); TOS _ 65; ASSEMBLE(MOVE 3)                       04104000
   END;                                                                 04106000
$PAGE "GENERAL PURPOSE PROCEDURES  -  BLANKLINE"               <<00207>>04108000
$ CONTROL SEGMENT = SEG3                                                04110000
PROCEDURE BLANKLINE;                                                    04112000
   <<PRINTS A BLANK LINE ON THE LIST DEVICE AND CLEARS THE LIST BUFFER>>04114000
   BEGIN                                                                04116000
   IF LIST THEN                                                         04118000
      BEGIN                                                             04120000
      FWRITE(LISTFNUM,LINE,0,0);                                        04122000
      IF <> THEN FERROR(LISTFNUM)  <<ERROR?>>                           04124000
      END;                                                              04126000
   CLEARLINE                                                            04128000
   END;                                                                 04130000
$PAGE "GENERAL PURPOSE PROCEDURES  -  PRINTLINE"               <<00207>>04132000
$ CONTROL SEGMENT = SEG3                                                04134000
PROCEDURE PRINTLINE;                                                    04136000
   <<PRINTS THE CONTENTS OF THE LIST BUFFER ON THE LIST DEVICE AND      04138000
     CLEARS THE LIST BUFFER>>                                           04140000
   BEGIN                                                                04142000
   IF LIST THEN                                                         04144000
      BEGIN                                                             04146000
      TOS _ LISTFNUM;                                                   04148000
      TOS _ @LINE;                                                      04150000
      TOS _ @BLINE(71);  <<POINTER TO LAST CHAR.>>                      04152000
      IF BPS0 = " " THEN                                                04154000
         BEGIN                                                          04156000
         ASSEMBLE(DUP,DECB);                                            04158000
         TOS _ -71;                                                     04160000
         ASSEMBLE(CMPB 2)                                               04162000
         END;                                                           04164000
      TOS _ -(TOS-@BLINE+1);  <<NEG. NR. CHAR'S>>                       04166000
      IF S0 < LISTWIDTH THEN  <<TRUNCATE LINE?>>                        04168000
         BEGIN                                                          04170000
         DEL;                                                           04172000
         TOS _ LISTWIDTH                                                04174000
         END;                                                           04176000
      FWRITE(*,*,*,0);                                                  04178000
      IF <> THEN FERROR(LISTFNUM)  <<ERROR?>>                           04180000
      END;                                                              04182000
   CLEARLINE                                                            04184000
   END;                                                                 04186000
$PAGE "GENERAL PURPOSE PROCEDURES  -  EJECTPAGE"               <<00207>>04188000
$ CONTROL SEGMENT = SEG3                                                04190000
PROCEDURE EJECTPAGE;                                                    04192000
   <<EJECTS THE PAGE ON THE LIST DEVICE>>                               04194000
   BEGIN                                                                04196000
   IF LIST THEN                                                         04198000
      BEGIN                                                             04200000
      TOS _ LISTFNUM; TOS _ 0; TOS _ 0;                                 04202000
      FWRITE(*,*,*,%61);                                                04204000
      IF <> THEN FERROR(LISTFNUM)  <<ERROR?>>                           04206000
      END                                                               04208000
   END;                                                                 04210000
$PAGE "GENERAL PURPOSE PROCEDURES  -  MIN2"                    <<00207>>04212000
$ CONTROL SEGMENT = SEG3                                                04214000
INTEGER PROCEDURE MIN2(A,B);                                            04216000
   <<RETURNS THE MINIMUM ARGUMENT>>                                     04218000
   VALUE A,B;                                                           04220000
   INTEGER A,B;                                                         04222000
   MIN2 _ IF A < B THEN A ELSE B;                                       04224000
$PAGE "GENERAL PURPOSE PROCEDURES  -  MIN3"                    <<00207>>04226000
$ CONTROL SEGMENT = SEG3                                                04228000
INTEGER PROCEDURE MIN3(A,B,C);                                          04230000
   <<RETURNS THE MINIMUM ARGUMENT>>                                     04232000
   VALUE A,B,C;                                                         04234000
   INTEGER A,B,C;                                                       04236000
   MIN3 _ IF (A < B) AND (A < C) THEN A ELSE MIN2(B,C);                 04238000
$PAGE "GENERAL PURPOSE PROCEDURES  -  TESTBIT"                 <<00207>>04240000
$ CONTROL SEGMENT = SEG3                                                04242000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         04244000
   VALUE BITNUMBER; INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;          04246000
   BEGIN                                                                04248000
   TOS _ BITNUMBER.(0:12)+@BITARRAY;                                    04250000
   TOS _ PS0;                                                           04252000
   XREG _ BITNUMBER.(12:4);                                             04254000
   ASSEMBLE(CSL 1,X);                                                   04256000
   TESTBIT _ TOS                                                        04258000
   END;                                                                 04260000
$PAGE "GENERAL PURPOSE PROCEDURES  -  CLEARBIT"                <<00207>>04262000
$ CONTROL SEGMENT = SEG3                                                04264000
PROCEDURE CLEARBIT (BITARRAY,BITNUMBER);                                04266000
   <<CLEARS THE BIT SPECIFIED BY BITNUMBER IN THE BIT ARRAY             04268000
     SPECIFIED BY BITARRAY>>                                            04270000
   VALUE BITNUMBER;                                                     04272000
   INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;                           04274000
   BEGIN                                                                04276000
   TOS _ BITNUMBER.(0:12)+@BITARRAY;                                    04278000
   TOS _ PS0;                                                           04280000
   XREG _ BITNUMBER;                                                    04282000
   ASSEMBLE(TRBC 0,X);                                                  04284000
   PS1 _ TOS                                                            04286000
   END;                                                                 04288000
$PAGE "GENERAL PURPOSE PROCEDURES  -  SETBIT"                  <<00207>>04290000
$ CONTROL SEGMENT = SEG3                                                04292000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  04294000
   <<SETS THE BIT SPECIFIED BY BITNUMBER IN THE BIT ARRAY               04296000
     SPECIFIED BY BITARRAY>>                                            04298000
   VALUE BITNUMBER;                                                     04300000
   INTEGER ARRAY BITARRAY; INTEGER BITNUMBER;                           04302000
   BEGIN                                                                04304000
   TOS _ BITNUMBER.(0:12)+@BITARRAY;                                    04306000
   TOS _ PS0;                                                           04308000
   XREG _ BITNUMBER;                                                    04310000
   ASSEMBLE(TSBC 0,X);                                                  04312000
   PS1 _ TOS                                                            04314000
   END;                                                                 04316000
$PAGE "GENERAL PURPOSE PROCEDURES  -  SUMBITS"                 <<00207>>04318000
$ CONTROL SEGMENT = SEG3                                                04320000
INTEGER PROCEDURE SUMBITS (BITARRAY);                                   04322000
   <<RETURNS THE NUMBER OF BITS SET IN A 16 WORD BIT MAP>>              04324000
   INTEGER ARRAY BITARRAY;                                              04326000
   BEGIN                                                                04328000
   INTEGER BITCOUNT = SUMBITS;                                          04330000
   TOS _ 15;                                                            04332000
   DO BEGIN                                                             04334000
      TOS _ BITARRAY(S0);                                               04336000
      WHILE <> DO                                                       04338000
         BEGIN                                                          04340000
         ASSEMBLE(SCAN 0);                                              04342000
         BITCOUNT _ BITCOUNT+1                                          04344000
         END;                                                           04346000
      ASSEMBLE(DEL,DECA)                                                04348000
      END UNTIL <                                                       04350000
   END;                                                                 04352000
$PAGE "GENERAL PURPOSE PROCEDURES  -  DNTOA"                   <<00207>>04354000
$ CONTROL SEGMENT = SEG3                                                04356000
PROCEDURE DNTOA (NUM,BASE,BA);                                          04358000
   VALUE NUM,BASE;                                                      04360000
   DOUBLE NUM; INTEGER BASE; BYTE ARRAY BA;                             04362000
   BEGIN                                                                04364000
   BA(0) _ "0";                                                         04366000
   WHILE NUM <> 0D DO                                                   04368000
      BEGIN                                                             04370000
      ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;                         04372000
               LDD NUM; DELB; LOAD BASE; LDIV;                          04374000
               ADDI %60);                                               04376000
      BA(XREG) _ TOS;                                                   04378000
      NUM _ TOS;                                                        04380000
      XREG _ XREG-1                                                     04382000
      END                                                               04384000
   END;                                                                 04386000
$PAGE "GENERAL PURPOSE PROCEDURES  -  NTOA"                    <<00207>>04388000
$ CONTROL SEGMENT = SEG3                                                04390000
PROCEDURE NTOA (NUM,BASE,BA);                                           04392000
   VALUE NUM,BASE;                                                      04394000
   INTEGER NUM,BASE;                                                    04396000
   BYTE ARRAY BA;                                                       04398000
   DNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);                                 04400000
$PAGE "GENERAL PURPOSE PROCEDURES  -  LDNTOA"                  <<00595>>04402000
$ CONTROL SEGMENT = SEG3                                       <<00595>>04404000
   INTEGER PROCEDURE LDNTOA(NUM, BASE, BA);                    <<00595>>04406000
      VALUE NUM, BASE;                                         <<00595>>04408000
      DOUBLE NUM;                                              <<00595>>04410000
      INTEGER BASE;                                            <<00595>>04412000
      BYTE ARRAY BA;                                           <<00595>>04414000
   BEGIN                                                       <<00595>>04416000
      BYTE ARRAY BUF(0:11)=Q;                                  <<00595>>04418000
                                                               <<00595>>04420000
      XREG := 12;                                              <<00595>>04422000
      DO BEGIN                                                 <<00595>>04424000
         ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;             <<00595>>04426000
                  LDD NUM; DELB; LOAD BASE; LDIV;              <<00595>>04428000
                  ADDI %60);                                   <<00595>>04430000
         BUF(XREG:=XREG-1) := TOS;                             <<00595>>04432000
         NUM := TOS;                                           <<00595>>04434000
         END UNTIL NUM=0D;                                     <<00595>>04436000
      MOVE BA := BUF(XREG),(LDNTOA:=12-XREG);                  <<00595>>04438000
   END;                                                        <<00595>>04440000
$PAGE "GENERAL PURPOSE PROCEDURES  -  LNTOA"                   <<00595>>04442000
$ CONTROL SEGMENT = SEG3                                       <<00595>>04444000
   INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                    <<00595>>04446000
      VALUE NUM, BASE;                                         <<00595>>04448000
      INTEGER NUM, BASE;                                       <<00595>>04450000
      BYTE ARRAY BA;                                           <<00595>>04452000
      LNTOA := LDNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);           <<00595>>04454000
$PAGE "GENERAL PURPOSE PROCEDURES  -  WARN"                    <<00595>>04456000
$ CONTROL SEGMENT = SEG4                                                04458000
PROCEDURE WARN (NUM);                                                   04460000
   VALUE NUM;                                                           04462000
   INTEGER NUM;                                                         04464000
   PRINTWARNING(NUM,M1D,NULL,NULL);                            <<00595>>04466000
$PAGE "GENERAL PURPOSE PROCEDURES  -  WARNS"                   <<00207>>04468000
$ CONTROL SEGMENT = SEG4                                                04470000
PROCEDURE WARNS (NUM,SPARM);                                            04472000
   VALUE NUM;                                                           04474000
   INTEGER NUM;                                                         04476000
   BYTE ARRAY SPARM;                                                    04478000
   PRINTWARNING(NUM,M1D,SPARM,NULL);                           <<00595>>04480000
$PAGE "GENERAL PURPOSE PROCEDURES  -  WARNS2"                  <<01124>>04482000
$ CONTROL SEGMENT = SEG4                                       <<01124>>04484000
PROCEDURE WARNS2 (NUM,SPARM1,SPARM2);                          <<01124>>04486000
   VALUE NUM;                                                  <<01124>>04488000
   INTEGER NUM;                                                <<01124>>04490000
   BYTE ARRAY SPARM1,SPARM2;                                   <<01124>>04492000
   PRINTWARNING(NUM,M1D,SPARM1,SPARM2);                        <<01124>>04494000
$PAGE "GENERAL PURPOSE PROCEDURES  -  ERROR"                   <<01124>>04496000
$ CONTROL SEGMENT = SEG4                                                04498000
PROCEDURE ERROR (NUM);                                                  04500000
   VALUE NUM; INTEGER NUM;                                              04502000
   PRINTERROR(NUM,M1D,NULL,NULL);                              <<00595>>04504000
$PAGE "GENERAL PURPOSE PROCEDURES  -  ERRORN"                  <<00207>>04506000
$ CONTROL SEGMENT = SEG4                                                04508000
PROCEDURE ERRORN (NUM,NPARM);                                           04510000
   VALUE NUM,NPARM;                                                     04512000
   INTEGER NUM; DOUBLE NPARM;                                           04514000
   PRINTFILERROR(NUM,NPARM,NULL,NULL);<<PRINTS FCHECK>>        <<00595>>04516000
$PAGE "GENERAL PURPOSE PROCEDURES  -  ERRORI"                  <<00207>>04518000
$CONTROL SEGMENT=SEG4                                          <<00207>>04520000
PROCEDURE ERRORI(NUM, NPARM);                                  <<00207>>04522000
   VALUE NUM, NPARM;                                           <<00207>>04524000
   INTEGER NUM, NPARM;                                         <<00207>>04526000
   ERRORN(NUM, DOUBLE(NPARM));                                 <<00207>>04528000
$PAGE "GENERAL PURPOSE PROCEDURES  -  ERRORS"                  <<00207>>04530000
$ CONTROL SEGMENT = SEG4                                                04532000
PROCEDURE ERRORS (NUM,SPARM);                                           04534000
   VALUE NUM;                                                           04536000
   INTEGER NUM;                                                         04538000
   BYTE ARRAY SPARM;                                                    04540000
   PRINTERROR(NUM,M1D,SPARM,NULL);                             <<00595>>04542000
$PAGE "GENERAL PURPOSE PROCEDURES  -  ERRORS2"                 <<00595>>04544000
$CONTROL SEGMENT = SEG4                                        <<00595>>04546000
PROCEDURE ERRORS2 (NUM,SPARM1,SPARM2);                         <<00595>>04548000
   VALUE NUM;                                                  <<00595>>04550000
   INTEGER NUM;                                                <<00595>>04552000
   BYTE ARRAY SPARM1,SPARM2;                                   <<00595>>04554000
   PRINTERROR(NUM,M1D,SPARM1,SPARM2);                          <<00595>>04556000
$PAGE "GENERAL PURPOSE PROCEDURES  -  PRINTERROR"              <<00595>>04558000
$ CONTROL SEGMENT = SEG4                                                04560000
PROCEDURE PRINTERROR (ERROR,NERROR,SERROR1,SERROR2);           <<00595>>04562000
   <<PRINTS AN ERROR MESSAGE ON THE JOB LIST DEVICE ALONG WITH AN       04564000
     OPTIONAL NUMERIC PARAMETER (IF NOT EQUAL TO -1D) AND AN OPTIONAL   04566000
     STRING PARAMETER (IF THE CHARACTER COUNT IS NOT EQUAL TO 0)>>      04568000
   VALUE ERROR,NERROR;                                                  04570000
   INTEGER ERROR;                                                       04572000
   DOUBLE NERROR;                                                       04574000
   BYTE ARRAY SERROR1,SERROR2;                                 <<00595>>04576000
   BEGIN                                                                04578000
   ENTRY PRINTWARNING;                                                  04580000
   ENTRY PRINTFILERROR;                                                 04582000
   MOVE BLINE _ "*** ERROR *** ",2;                                     04584000
   HARD:                                                                04586000
   IF NOT INTERACTIVE THEN  <<SET ABORT BIT?>>                          04588000
      BEGIN                                                             04590000
      TOS := GETJCW;                                                    04592000
      TOS.(0:1) := 1;  <<SET ABORT BIT>>                                04594000
      SETJCW(*)                                                         04596000
      END;                                                              04598000
   TOS _ HARDERROR;                                                     04600000
   GO PARMS;                                                            04602000
                                                                        04604000
   PRINTFILERROR:                                                       04606000
   MOVE BLINE _ "*** FILE ERROR ",2;                                    04608000
   GO HARD;                                                             04610000
                                                                        04612000
   PRINTWARNING:                                                        04614000
   MOVE BLINE _ "*** WARNING *** ",2;                                   04616000
   TOS _ SOFTERROR;                                                     04618000
                                                                        04620000
   PARMS:                                                               04622000
   ERRORNR _ TOS;  <<SET ERROR FLAG>>                                   04624000
   IF NERROR <> M1D THEN <<NUMERIC PARAM>>                              04626000
      BEGIN                                                             04628000
      TOS_LDNTOA(NERROR,10,BPS0);<<CONV PARM DEC>>             <<00595>>04630000
      TOS_TOS+TOS; <<ADD TO LENGTH>>                                    04632000
      BPS0 _ " "; <<ADD BLANK IF STRING PARAM>>                         04634000
      ASSEMBLE(INCA);                                                   04636000
      END;                                                              04638000
   XREG := SERROR1.(12:4);  <<NR. CHAR'S>>                     <<00595>>04640000
   IF <> THEN  <<STRING PARAMETER?>>                                    04642000
      BEGIN                                                             04644000
      TOS := @SERROR1;                                         <<00595>>04646000
      ASSEMBLE(INCA,LDXA);                                              04648000
      MOVE * := *,(TOS),2;  <<INSERT STRING>>                           04650000
      END;                                                              04654000
   XREG := SERROR2.(12:4);                                     <<00595>>04656000
   IF <> THEN                                                  <<00595>>04658000
      BEGIN                                                    <<00595>>04660000
      BPS0 := ",";                                             <<00595>>04662000
      TOS := TOS+1;                                            <<00595>>04664000
      TOS := @SERROR2;                                         <<00595>>04666000
      ASSEMBLE(INCA,LDXA);                                     <<00595>>04668000
      MOVE * := *,(TOS),2;  <<INSERT STRING>>                  <<00595>>04670000
      END;                                                     <<00595>>04672000
   PRINT(LINE,@BLINE-S0,0);  <<PRINT STRING AND PARAMETERS>>            04674000
   PRINT(LINE,-MESSAGE(ERROR,BLINE),0);  <<PRINT ERROR MESSAGE>>        04676000
   CLEARLINE                                                            04678000
   END;                                                                 04680000
$PAGE "GENERAL PURPOSE PROCEDURES  -  PRINTBITMAP"             <<00595>>04684000
$ CONTROL SEGMENT = SEG4                                       <<00595>>04686000
PROCEDURE PRINTBITMAP( MAP);                                   <<00595>>04688000
   ARRAY MAP;                                                  <<00595>>04690000
BEGIN                                                          <<00595>>04692000
   INTEGER COL := 0, I;                                        <<00595>>04694000
                                                               <<00595>>04696000
   FOR *I := 0 UNTIL %77 DO                                    <<00595>>04698000
      BEGIN                                                    <<00595>>04700000
      IF COL > 60 THEN                                         <<00595>>04702000
         BEGIN                                                 <<00595>>04704000
         PRINT(LINE,-COL,0);                                   <<00595>>04706000
         COL := 0;                                             <<00595>>04708000
         END;                                                  <<00595>>04710000
      IF TESTBIT( MAP, I) THEN                                 <<00595>>04712000
         BEGIN                                                 <<00595>>04714000
         IF COL <> 0 THEN                                      <<00595>>04716000
            BEGIN                                              <<00595>>04718000
            BLINE(COL) := ",";                                 <<00595>>04720000
            COL:=COL+1;                                        <<00595>>04722000
            END;                                               <<00595>>04724000
         COL := COL+LNTOA(I+1,10,BLINE(COL));                  <<00595>>04726000
         END;                                                  <<00595>>04728000
      END;                                                     <<00595>>04730000
   IF COL <> 0 THEN PRINT(LINE,-COL,0);                        <<00595>>04732000
   CLEARLINE;                                                  <<00595>>04734000
END;                                                           <<00595>>04736000
$PAGE "GENERAL PURPOSE PROCEDURES  -  MESSAGE"                 <<00595>>04738000
$ CONTROL SEGMENT = SEG4                                                04740000
INTEGER PROCEDURE MESSAGE (NR,BUF);                                     04742000
   <<THIS PROCEDURE COMPOSES THE MESSAGE IDENTIFIED BY NR               04744000
     (0 <= NR <= 254) AND INSERTS THE MESSAGE IN THE BUFFER BUF,        04746000
     RETURNING THE NUMBER OF CHARACTERS IN THE MESSAGE.  IF A MESSAGE   04748000
     DOES NOT EXIST, A ZERO LENGTH IS RETURNED>>                        04750000
   VALUE NR;                                                            04752000
   INTEGER NR;                                                          04754000
   BYTE ARRAY BUF;                                                      04756000
   BEGIN                                                                04758000
   byte array Vocab(*) = PB :=                                 <<02817>>04760000
      <<%0>> 3,"USL",                                                   04762000
      <<%1>> 2,"SL",                                                    04764000
      <<%2>> 2,"RL",                                                    04766000
      <<%3>> 7,"PROGRAM",                                               04768000
      <<%4>> 4,"FILE",                                                  04770000
      <<%5>> 7,"SEGMENT",                                               04772000
      <<%6>> 4,"UNIT",                                                  04774000
      <<%7>> 9,"PROCEDURE",                                             04776000
      <<%10>> 9,"DIRECTORY",                                            04778000
      <<%11>> 4,"INFO",                                                 04780000
      <<%12>> 10,"ATTEMPT TO",                                          04782000
      <<%13>> 6,"EXCEED",                                               04784000
      <<%14>> 7,"MAXIMUM",                                              04786000
      <<%15>> 4,"SIZE",                                                 04788000
      <<%16>> 9,"AVAILABLE",                                            04790000
      <<%17>> 5,"SPACE",                                                04792000
      <<%20>> 9,"EXHAUSTED",                                            04794000
      <<%21>> 10,"DESIGNATED",                                          04796000
      <<%22>> 7,"ILLEGAL",                                              04798000
      <<%23>> 13,"SPECIFICATION",                                       04800000
      <<%24>> 9,"UNABLE TO",                                            04802000
      <<%25>> 6,"ACCESS",                                               04804000
      <<%26>> 7,"CONTAIN",                                              04806000
      <<%27>> 7,"PRIMARY",                                              04808000
      <<%30>> 5,"OUTER",                                                04810000
      <<%31>> 5,"POINT",                                                04812000
      <<%32>> 15,"ALREADY DEFINED",                                     04814000
      <<%33>> 2,"NO",                                                   04816000
      <<%34>> 10,"OTHER THAN",                                          04818000
      <<%35>> 6,"ACTIVE",                                               04820000
      <<%36>> 4,"OPEN",                                                 04822000
      <<%37>> 7,"STORAGE",                                              04824000
      <<%40>> 7,"REQUIRE",                                              04826000
      <<%41>> 5,"FATAL",                                                04828000
      <<%42>> 6,"ACTUAL",                                               04830000
      <<%43>> 6,"FORMAL",                                               04832000
      <<%44>> 9,"PARAMETER",                                            04834000
      <<%45>> 12,"INCOMPATIBLE",                                        04836000
      <<%46>> 5,"CLASS",                                                04838000
      <<%47>> 4,"WITH",                                                 04840000
      <<%50>> 6,"USABLE",                                               04842000
      <<%51>> 10,"PRIVILEGED",                                          04844000
      <<%52>> 4,"DATA",                                                 04846000
      <<%53>> 4,"CODE",                                                 04848000
      <<%54>> 3,"STT",                                                  04850000
      <<%55>> 13,"MORE THAN ONE",                                       04852000
      <<%56>> 2,"IS",                                                   04854000
      <<%57>> 3,"HAS",                                                  04856000
      <<%60>> 8,"EXTERNAL",                                             04858000
      <<%61>> 8,"VARIABLE",                                             04860000
      <<%62>> 6,"GLOBAL",                                               04862000
      <<%63>> 3,"NOT",                                                  04864000
      <<%64>> 8,"DECLARED",                                             04866000
      <<%65>> 6,"LOCATE",                                               04868000
      <<%66>> 6,"COMMON",                                               04870000
      <<%67>> 5,"LABEL",                                                04872000
      <<%70>> 9,"DIFFERENT",                                            04874000
      <<%71>> 3,"USE",                                                  04876000
      <<%72>> 5,"BLOCK",                                                04878000
      <<%73>> 12,"NON-EXISTENT",                                        04880000
      <<%74>> 12,"INSUFFICIENT",                                        04882000
      <<%75>> 7,"SCRATCH",                                              04884000
      <<%76>> 4,"ITEM",                                                 04886000
      <<%77>> 7,"COMMAND",                                              04888000
      <<%100>> 12,"INAPPLICABLE",                                       04890000
      <<%101>> 8,"OVERFLOW",                                            04892000
      <<%102>> 2,"ON",                                                  04894000
      <<%103>> 8,"TOO MANY",                                            04896000
      <<%104>> 5,"ENTRY",                                               04898000
      <<%105>> 6,"HEADER",                                              04900000
      <<%106>> 5,"PATCH",                                               04902000
      <<%107>> 4,"TYPE",                                                04904000
      <<%110>> 4,"LIST",                                                04906000
      <<%111>> 10,"UNEXPECTED",                                         04908000
      <<%112>> 3,"I/O",                                                 04910000
      <<%113>> 4,"FROM",                                                04912000
      <<%114>> 5,"CLOSE",                                               04914000
      <<%115>> 5,"ERROR",                                               04916000
      <<%116>> 9,"NON-FATAL",                                           04918000
      <<%117>> 2,"TO",                                                  04920000
      <<%120>> 7,"PREPARE",                                             04922000
      <<%121>> 4,"AUX.",                                                04924000
      <<%122>> 7,"LIBRARY",                                             04926000
      <<%123>> 6,"EXTENT",                                              04928000
      <<%124>> 4,"USED",                                                04930000
      <<%125>> 10,"CAPABILITY",                                         04932000
      <<%126>> 7,"INVALID",                                             04934000
      <<%127>> 9,"CURRENTLY",                                           04936000
      <<%130>> 6,"LOADED",                                              04938000
      <<%131>> 4,"MODE",                                                04940000
      <<%132>> 6,"MAY BE",                                              04942000
      <<%133>> 9,"TOO LARGE",                                           04944000
      <<%134>> 7, "LOGICAL",                                            04946000
      <<%135>> 5,"STACK",                                               04948000
      <<%136>> 2,"DL",                                                  04950000
      <<%137>> 7,"MAXDATA",                                    <<00.EB>>04952000
      <<%140>> 6,"FREEZE",                                     <<00207>>04954000
      <<%141>> 3,"NEW",                                        <<00207>>04956000
      <<%142>> 3,"OLD",                                        <<00465>>04958000
      <<%143>> 2,"IN",                                         <<00207>>04960000
      <<%144>> 5,"WRONG",                                      <<00207>>04962000
      <<%145>> 11,"END OF FILE",                               <<00207>>04964000
      <<%146>> 4,"COPY",                                       <<00207>>04966000
      <<%147>> 6,"FACTOR",                                     <<00207>>04968000
      <<%150>> 9,"DUPLICATE",                                  <<00207>>04970000
      <<%151>> 4,"NAME",                                       <<00595>>04972000
      <<%152>> 2,"OF",                                         <<00595>>04974000
      <<%153>> 6,"NUMBER",                                     <<00595>>04976000
      <<%154>> 8,"FUNCTION",                                   <<04102>>04978000
      <<%155>> 5,"DEBUG",                                      <<04102>>04980000
      <<%156>> 8,"SYMBOLIC",                                   <<04584>>04982000
      <<%157>> 2,"SM",                                         <<04584>>04984000
      <<%160>> 8,"INTERNAL",                                   <<04584>>04986000
      <<%161>> 4,"PMAP",                                       <<04781>>04988000
      <<%162>> 9,"PERMANENT",                                  <<04781>>04990000
      <<%163>> 9,"TOO SMALL",                                  <<04781>>04992000
      0;                                                       <<04781>>04994000
   EQUATE ACCESS = %25,                                                 04996000
          ACTIVE' = %35,                                                04998000
          ACTUAL = %42,                                                 05000000
          ALREADY'DEFINED = %32,                                        05002000
          ATTEMPT'TO = %12,                                             05004000
          AUX = %121,                                                   05006000
          AVAILABLE = %16,                                              05008000
          BLOCK = %72,                                                  05010000
          CAPABILITY = %125,                                            05014000
          CLASS' = %46,                                                 05016000
          CLOSE = %114,                                                 05018000
          CODE = %53,                                                   05020000
          COMMAND = %77,                                                05022000
          COMMON = %66,                                                 05024000
          CONTAIN = %26,                                                05026000
          CONTAINS = %226,                                              05028000
          COPY=%146,                                           <<00207>>05030000
          CURRENTLY = %127,                                             05032000
          DATA = %52,                                                   05034000
          DEBUG = %155,                                        <<04102>>05036000
          DECLARED = %64,                                               05038000
          DESIGNATED = %21,                                             05040000
          DIFFERENT = %70,                                              05042000
          DIRECTORY = %10,                                              05044000
          DL = %136,                                                    05046000
          DUPLICATE = %150,                                    <<00207>>05048000
          END'OF'FILE = %145,                                  <<00207>>05050000
          ENTRY'POINT = %31,                                            05052000
          ENTRY' = %104,                                                05054000
          ERROR = %115,                                                 05056000
          EXCEED = %13,                                                 05058000
          EXCEEDS = %213,                                               05060000
          EXHAUSTED = %20,                                              05062000
          EXTENT = %123,                                                05064000
          EXTERNAL' = %60,                                              05066000
          FACTOR=%147,                                         <<00207>>05068000
          FATAL = %41,                                                  05070000
          FILE = %4,                                                    05072000
          FORMAL = %43,                                                 05074000
          FREEZE = %140,                                       <<00.EB>>05076000
          FROM = %113,                                                  05078000
          FUNCTION = %154,                                     <<00595>>05080000
          GLOBAL' = %62,                                                05082000
          HAS = %57,                                                    05084000
          HEADER = %105,                                                05086000
          ILLEGAL = %22,                                                05088000
          IN = %143,                                           <<00207>>05090000
          INAPPLICABLE = %100,                                          05092000
          INCOMPATIBLE = %45,                                           05094000
          INFO = %11,                                                   05096000
          INSUFFICIENT = %74,                                           05098000
          INVALID = %126,                                               05100000
          INTERNAL' = %160,                                    <<04584>>05102000
          IO = %112,                                                    05104000
          ITEM = %76,                                                   05106000
          IS = %56,                                                     05108000
          LABEL' = %67,                                                 05110000
          LABELS = %267,                                                05112000
          LIBRARY = %122,                                               05114000
          LIST' = %110,                                                 05116000
          LOADED = %130,                                                05118000
          LOCATE = %65,                                                 05120000
          LOGICAL' = %134,                                              05122000
          MAXDATA = %137,                                               05124000
          MAXIMUM = %14,                                                05126000
          MAY'BE = %132,                                                05128000
          MODE = %131,                                                  05130000
          MORE'THAN'ONE = %55,                                          05132000
          NAME = %151,                                         <<00207>>05134000
          NEW = %141,                                          <<00207>>05136000
          NO = %33,                                                     05138000
          NON'EXISTENT = %73,                                           05140000
          NON'FATAL = %116,                                             05142000
          NOT' = %63,                                                   05144000
          OLD = %142,                                          <<00465>>05146000
          NUMBER = %153,                                       <<00595>>05148000
          OF' = %152,                                          <<00595>>05150000
          ON = %102,                                                    05152000
          OPEN = %36,                                                   05154000
          OTHER'THAN = %34,                                             05156000
          OUTER = %30,                                                  05158000
          OVERFLOW' = %101,                                             05160000
          PARAMETER = %44,                                              05162000
          PARAMETERS = %244,                                            05164000
          PATCH = %106,                                                 05166000
          PERMANENT = %162,                                    <<04781>>05168000
          PMAP = %161,                                         <<04584>>05170000
          POINT = %31,                                                  05172000
          POINTS = %231,                                                05174000
          PREPARE = %120,                                               05176000
          PRIMARY = %27,                                                05178000
          PRIVILEGED' = %51,                                            05180000
          PROCEDURE' = %7,                                              05182000
          PROCEDURES = %207,                                            05184000
          PROGRAM = %3,                                                 05186000
          REQUIRE = %40,                                                05188000
          REQUIRES = %240,                                              05190000
          RL = %2,                                                      05192000
          SCRATCH = %75,                                                05194000
          SEGMENT' = %5,                                                05196000
          SEGMENTS = %205,                                              05198000
          SIZE = %15,                                                   05200000
          SL = %1,                                                      05202000
          SM = %157,                                           <<04584>>05204000
          SPACE = %17,                                                  05206000
          SPECIFICATION = %23,                                          05208000
          STACK = %135,                                                 05210000
          STORAGE = %37,                                                05212000
          STT = %54,                                                    05214000
          SYMBOLIC = %156,                                     <<04102>>05216000
          TO' = %117,                                                   05218000
          TOO'LARGE = %133,                                             05220000
          TOO'MANY = %103,                                              05222000
          TOO'SMALL = %163,                                    <<04781>>05224000
          TYPE = %107,                                                  05226000
          UNABLE'TO = %24,                                              05228000
          UNEXPECTED = %111,                                            05230000
          UNIT = %6,                                                    05232000
          UNITS = %206,                                                 05234000
          USABLE = %50,                                                 05236000
          USE = %71,                                                    05238000
          USED = %124,                                                  05240000
          USL = %0,                                                     05242000
          VARIABLE' = %61,                                              05244000
          WITH = %47,                                          <<00207>>05246000
          WRONG = %144;                                        <<00207>>05248000
   byte array Mess(*) = PB :=                                  <<02817>>05250000
                                                                        05252000
      <<USL FILE MESSAGES>>                                             05254000
                                                                        05256000
      0,2,ILLEGAL,ENTRY',                                               05258000
      1,2,ILLEGAL,HEADER,                                               05260000
      2,5,ATTEMPT'TO,EXCEED,MAXIMUM,DIRECTORY,SIZE,                     05262000
      3,4,AVAILABLE,DIRECTORY,SPACE,EXHAUSTED,                          05264000
      4,4,AVAILABLE,INFO,SPACE,EXHAUSTED,                               05266000
      5,4,USL,FILE,NOT',DESIGNATED,                                     05268000
      6,4,ILLEGAL,USL,FILE,SPECIFICATION,                               05270000
      7,4,UNABLE'TO,OPEN,USL,FILE,                                      05272000
      8,3,INVALID,USL,FILE,                                             05274000
      9,4,UNABLE'TO,CLOSE,USL,FILE,                                     05276000
                                                                        05278000
      <<SL FILE MESSAGES>>                                              05280000
                                                                        05282000
      10,4,UNABLE'TO,CLOSE,SL,FILE,                                     05284000
      11,4,AVAILABLE,FILE,SPACE,EXHAUSTED,                              05286000
      12,3,ENTRY',POINT,ALREADY'DEFINED,                                05288000
      13,6,SEGMENT',CONTAINS,PROGRAM,UNITS,OTHER'THAN,PROCEDURES,       05290000
      14,4,SEGMENT',REQUIRES,GLOBAL',STORAGE,                           05292000
      15,2,SEGMENT',ALREADY'DEFINED,                                    05294000
      16,4,SL,FILE,NOT',DESIGNATED,                                     05296000
      17,4,ILLEGAL,SL,FILE,SPECIFICATION,                               05298000
      18,4,UNABLE'TO,OPEN,SL,FILE,                                      05300000
      19,3,INVALID,SL,FILE,                                             05302000
                                                                        05304000
      <<RL FILE MESSAGES>>                                              05306000
                                                                        05308000
      20,4,ILLEGAL,RL,FILE,SPECIFICATION,                               05310000
      21,4,RL,FILE,NOT',DESIGNATED,                                     05312000
      22,3,INVALID,RL,FILE,                                             05314000
      23,4,UNABLE'TO,CLOSE,RL,FILE,                                     05316000
      28,6,PROCEDURE',HAS,NO,USABLE,ENTRY',POINT,                       05318000
      30,4,UNABLE'TO,OPEN,RL,FILE,                                      05320000
                                                                        05322000
      <<PROGRAM PREPARATION MESSAGES>>                                  05324000
                                                                        05326000
      32,3,INVALID,PROGRAM,FILE,                                        05328000
      33,3,ILLEGAL,CAPABILITY,SPECIFICATION,                            05330000
      34,3,MORE'THAN'ONE,EXTENT,USED,                                   05332000
      35,4,NO,PROGRAM,TO',PREPARE,                                      05334000
      36,4,UNABLE'TO,CLOSE,PROGRAM,FILE,                                05336000
      37,4,UNABLE'TO,OPEN,PROGRAM,FILE,                                 05338000
      38,3,DATA,SEGMENT',OVERFLOW',                                     05340000
      39,3,TOO'MANY,CODE,SEGMENTS,                                      05342000
                                                                        05344000
      <<SEGMENT PREPARATION MESSAGES>>                                  05346000
                                                                        05348000
      40,3,CODE,SEGMENT',OVERFLOW',                                     05350000
      41,2,STT,OVERFLOW',                                               05352000
      42,6,SEGMENT',HAS,NO,USABLE,ENTRY',POINT,                         05354000
      43,3,UNABLE'TO,ACCESS,PROCEDURE',                                 05356000
      44,4,REQUIRES,PRIVILEGED',MODE,CAPABILITY,                        05358000
      45,6,ACTUAL,PARAMETERS,INCOMPATIBLE,WITH,FORMAL,PARAMETERS,<<+08>>05360000
      46,5,PROGRAM,UNIT,CONTAINS,FATAL,ERROR,                           05362000
      47,5,PROGRAM,UNIT,CONTAINS,NON'FATAL,ERROR,                       05364000
      48,4,CODE,SEGMENT',MAY'BE,TOO'LARGE,                              05366000
      49,6,ACTUAL,FUNCTION,INCOMPATIBLE,WITH,FORMAL,FUNCTION,  <<00595>>05368000
      50,4,INCOMPATIBLE,NUMBER,OF',PARAMETERS,                 <<00595>>05370000
                                                                        05372000
      <<PROGRAM PREPARATION MESSAGES (CONT.)>>                          05374000
                                                                        05376000
      60,5,NO,OUTER,BLOCK,IS,ACTIVE',                                   05378000
      61,5,MORE'THAN'ONE,OUTER,BLOCK,IS,ACTIVE',                        05380000
      62,7,MORE'THAN'ONE,OUTER,BLOCK,HAS,ACTIVE',ENTRY',POINTS,         05382000
      63,5,EXTERNAL',VARIABLE',NOT',DECLARED,GLOBAL',                   05384000
      64,6,EXTERNAL',VARIABLE',INCOMPATIBLE,WITH,GLOBAL',VARIABLE',     05386000
      66,4,TOO'MANY,COMMON,DATA,LABELS,                                 05388000
      67,5,COMMON,DECLARED,WITH,DIFFERENT,SIZE,                         05390000
      68,7,ATTEMPT'TO,USE,BLOCK,DATA,ON,NON'EXISTENT,COMMON,            05392000
      69,7,ATTEMPT'TO,USE,BLOCK,DATA,ON,INCOMPATIBLE,COMMON,            05394000
      70,3,ILLEGAL,STACK,SIZE,                                          05396000
      71,3,ILLEGAL,DL,SIZE,                                             05398000
      72,3,ILLEGAL,MAXDATA,SIZE,                                        05400000
      73,4,DUPLICATE,ACTIVE',ENTRY',NAME,                      <<04121>>05402000
      74,5,UNABLE'TO,PREPARE,WITH,SYMBOLIC,DEBUG,              <<04102>>05404000
      75,5,PERMANENT,PROGRAM,FILE,SIZE,TOO'SMALL,              <<04781>>05406000
                                                                        05408000
      <<MISCELLANEOUS MESSAGES>>                                        05410000
                                                                        05412000
      80,2,INSUFFICIENT,STORAGE,                                        05414000
      81,2,ILLEGAL,PATCH,                                               05416000
      82,4,UNABLE'TO,OPEN,SCRATCH,FILE,                                 05418000
      83,4,UNABLE'TO,OPEN,LIST',FILE,                                   05420000
      84,3,UNEXPECTED,IO,ERROR,                                         05422000
      86,5,ITEM,DIFFERENT,FROM,CLASS',SPECIFICATION,                    05424000
      87,4,ITEM,NOT',PRIMARY,ENTRY'POINT,                               05426000
      88,3,INCOMPATIBLE,ITEM,TYPE,                                      05428000
      89,3,INVALID,CLASS',SPECIFICATION,                                05430000
      93,3,UNABLE'TO,LOCATE,ITEM,                                       05432000
      94,2,UNEXPECTED,END'OF'FILE,                             <<00207>>05434000
      95,3,INVALID,COPY,FACTOR,                                <<00207>>05436000
      96,3,ILLEGAL,FILE,ACCESS,                                <<00563>>05438000
      97,4,UNABLE'TO,CLOSE,SCRATCH,FILE,                       <<04102>>05440000
      98,6,NO,INTERNAL',PMAP,IN,PROGRAM,FILE,                  <<04584>>05442000
      99,3,REQUIRE,SM,CAPABILITY,                              <<04584>>05444000
                                                                        05446000
      <<SL FILE MESSAGES (CONT.)>>                                      05448000
                                                                        05450000
      110,3,SEGMENT',CURRENTLY,LOADED,                                  05452000
      111,4,SEGMENT',CONTAINS,EXTERNAL',VARIABLE',                      05454000
      112,3,SEGMENT',CONTAINS,COMMON,                                   05456000
      113,4,SEGMENT',CONTAINS,LOGICAL',UNITS,                           05458000
      114,3,UNABLE'TO,FREEZE,SEGMENT',                         <<00.EB>>05460000
                                                                        05468000
      <<AUXILIARY USL FILE MESSAGES>>                                   05470000
                                                                        05472000
      120,5,AUX,USL,FILE,NOT',DESIGNATED,                               05474000
      121,5,UNABLE'TO,OPEN,NEW,USL,FILE,                       <<00207>>05476000
      122,3,DUPLICATE,FILE,NAME,                               <<00207>>05478000
                                                                        05480000
      <<MISCELLANEOUS STRINGS>>                                         05482000
                                                                        05484000
      200,2,USL,FILE,                                                   05486000
      201,3,AUX,USL,FILE,                                               05488000
      202,2,SL,FILE,                                                    05490000
      203,2,RL,FILE,                                                    05492000
      204,3,RL,LIBRARY,FILE,                                            05494000
      205,2,PROGRAM,FILE,                                               05496000
      206,2,LIST',FILE,                                                 05498000
      207,2,SCRATCH,FILE,                                               05500000
      208,3,OLD,SL,FILE,                                       <<00465>>05502000
      209,3,NEW,USL,FILE,                                      <<00207>>05504000
                                                                        05506000
      255;  <<TABLE TERMINATOR>>                                        05508000
   BYTE ARRAY TEST (0:8);  <<MESSAGE BUFFER>>                           05510000
   BYTE POINTER PHRASE;                                                 05512000
   TOS _ @TEST; TOS _ @MESS;                                            05514000
   L1: MOVE * _ * PB,(2),1;  <<LOAD MESSAGE NR. AND NR. PHRASES>>       05516000
   IF INTEGER(TEST) = 255 OR INTEGER(TEST) > NR THEN RETURN;            05518000
   IF <> THEN  <<CORRECT MESSAGE?>>                                     05520000
      BEGIN                                                             05522000
      ASSEMBLE(DECB,DECB);                                              05524000
      TOS _ TOS+TEST(1);                                                05526000
      GO L1                                                             05528000
      END;                                                              05530000
   @PHRASE _ S1;  <<SAVE POINTER TO PHRASE NR.>>                        05532000
   MOVE * _ * PB,(INTEGER(TEST(1)));  <<LOAD REMAINDER OF MESSAGE>>     05534000
   TOS_@BUF; <<LOAD BEG. OF BUFF>>                                      05536000
   IF NR < 200 THEN <<KLUGE. NO NR FOR MISC MSG>>                       05538000
   BEGIN                                                                05540000
      MOVE BUF_"ERROR #    ";                                           05542000
      TOS_ASCII(NR,10,BUF(7));<<PUT MSG NR>>                            05544000
      TOS_TOS+TOS+8; <<PTR 1 PAST MSG NR>>                              05546000
   END;                                                                 05548000
   DO BEGIN                                                             05550000
      TOS _ @TEST; TOS _ @VOCAB;                                        05552000
      XREG _ PHRASE.(9:7);                                              05554000
      WHILE > DO                                                        05556000
         BEGIN                                                          05558000
         MOVE * _ * PB,(1),1;  <<LOAD NR. BYTES IN PHRASE>>             05560000
         TOS _ TOS+TEST;                                                05562000
         ASSEMBLE(DECB,DECX)                                            05564000
         END;                                                           05566000
      MOVE * _ * PB,(1),1;  <<LOAD NR. BYTES IN PHRASE>>                05568000
      ASSEMBLE(DELB);  <<LEAVE POINTER TO PHRASE>>                      05570000
      MOVE * _ * PB,(INTEGER(TEST)),2;  <<PUT PHRASE IN BUFFER>>        05572000
      IF LOGICAL(PHRASE.(8:1)) THEN  <<APPEND "S"?>>                    05574000
         BEGIN                                                          05576000
         BPS0 _ "S";                                                    05578000
         TOS _ TOS+1                                                    05580000
         END;                                                           05582000
      BPS0 _ " ";  <<APPEND " ">>                                       05584000
      TOS _ TOS+1;                                                      05586000
      @PHRASE _ @PHRASE+1;  <<NEXT PHRASE NR.>>                         05588000
      TEST(1) _ TEST(1)-1  <<DEC. NR. PHRASES>>                         05590000
      END UNTIL =;                                                      05592000
   MESSAGE _ TOS-@BUF-1  <<NR. BYTES IN MESSAGE>>                       05594000
   END;                                                                 05596000
$PAGE "GENERAL PURPOSE PROCEDURES  -  CTLY'TRAP"               <<00207>>05598000
$ CONTROL SEGMENT = SEG4                                       <<00.DM>>05600000
PROCEDURE CTLY'TRAP;                                           <<00.DM>>05602000
   BEGIN                                                       <<00.DM>>05604000
   INTEGER SDEC, I;                                            <<00.DM>>05606000
                                                               <<00.DM>>05608000
   BLANKLINE;                                                  <<00.DM>>05610000
   PRINTLINE;                                                  <<00.DM>>05612000
   RESETCONTROL;                                               <<00.DM>>05614000
   FCONTROL(INFNUM,DISABLE'CTLY,I);                            <<00.DM>>05616000
   CTLY := TRUE;                                               <<00.DM>>05618000
   TOS := %31400+SDEC;                                         <<00.DM>>05620000
   ASSEMBLE( XEQ 0 );                                          <<00.DM>>05622000
   END;                                                        <<00.DM>>05624000
$PAGE "GENERAL PURPOSE PROCEDURES  -  GETRECDDISP"             <<00207>>05626000
$ CONTROL SEGMENT = SEG3                                                05628000
PROCEDURE GETRECDDISP (FILEADR,RECD,DISP);                              05630000
   <<RETURNS THE RECORD NUMBER AND RECORD DISPLACEMENT FOR THE          05632000
     GIVEN FILE ADDRESS.  THE RECORD NUMBER MAY BE POSITIVE OR          05634000
     NEGATIVE BUT IS ADJUSTED SO THAT THE RECORD DISPLACEMENT IS        05636000
     ALWAYS NON-NEGATIVE>>                                              05638000
   VALUE FILEADR;                                                       05640000
   DOUBLE FILEADR; INTEGER RECD,DISP;                                   05642000
   BEGIN                                                                05644000
   TOS _ FILEADR; TOS _ RECSIZE;                                        05646000
   ASSEMBLE(DIVL);                                                      05648000
   DISP _ TOS; RECD _ TOS;                                              05650000
   IF DISP < 0 THEN                                                     05652000
      BEGIN                                                             05654000
      RECD _ RECD-1; DISP _ DISP+RECSIZE                                05656000
      END                                                               05658000
   END;                                                                 05660000
$PAGE "GENERAL PURPOSE PROCEDURES  -  REPAIRRECORD"            <<00207>>05662000
$ CONTROL SEGMENT = SEG3                                                05664000
PROCEDURE REPAIRRECORD (FNUM,FILEADR,NEWWORD);                          05666000
   VALUE FNUM,FILEADR,NEWWORD;                                          05668000
   INTEGER FNUM,NEWWORD; DOUBLE FILEADR;                                05670000
   BEGIN                                                                05672000
   INTEGER RECD,DISP;                                                   05674000
   GETRECDDISP(FILEADR,RECD,DISP);                                      05676000
   REPAIRRECORD'(FNUM,RECD,DISP,NEWWORD)                                05678000
   END;                                                                 05680000
$PAGE "GENERAL PURPOSE PROCEDURES  -  REPAIRRECORD'"           <<00207>>05682000
$ CONTROL SEGMENT = SEG3                                                05684000
PROCEDURE REPAIRRECORD' (FNUM,RECD,DISP,NEWWORD);                       05686000
   VALUE FNUM,RECD,DISP,NEWWORD;                                        05688000
   INTEGER FNUM,RECD,DISP,NEWWORD;                                      05690000
   BEGIN                                                                05692000
   FREADDIR'(FNUM,BUF,RECD);                                            05694000
   BUF(DISP) _ NEWWORD;  <<REPAIR WORD>>                                05696000
   FWRITEDIR'(FNUM,BUF,RECD)                                            05698000
   END;                                                                 05700000
$PAGE "GENERAL PURPOSE PROCEDURES  -  COREBUF1"                <<00207>>05702000
$ CONTROL SEGMENT = SEG3                                                05704000
PROCEDURE COREBUF1 (BUFFER,LENGTH);                                     05706000
   VALUE LENGTH;                                                        05708000
   INTEGER ARRAY BUFFER;                                                05710000
   INTEGER LENGTH;                                                      05712000
   BEGIN                                                                05714000
   ENTRY COREBUF2;                                                      05716000
   TOS _ TFNUM1; TOS _ 0; TOS _ @TBUF1; TOS _ @TRECD1; TOS _ @TDISP1;   05718000
   GO L1;                                                               05720000
                                                                        05722000
   COREBUF2:                                                            05724000
   TOS _ TFNUM1; TOS _ 0; TOS _ @TBUF2; TOS _ @TRECD2; TOS _ @TDISP2;   05726000
                                                                        05728000
   L1:                                                                  05730000
   MASTERBUF(*,*,*,*,*,FALSE,0D,BUFFER,LENGTH)                          05732000
   END;                                                                 05734000
$PAGE "GENERAL-PURPOSE PROCEDURES  -  COREBUFPMAP"             <<04102>>05736000
$CONTROL SEGMENT = SEG3                                        <<04102>>05738000
procedure CoreBufPmap(Buffer, Length);                         <<04102>>05740000
   value Length;                                               <<04102>>05742000
   integer array Buffer;          << Buffer to be written >>   <<04102>>05744000
   integer       Length;          << # words in Buffer >>      <<04102>>05746000
                                                               <<04102>>05748000
   << Writes Buffer to the Pmap scratch file starting at dis-  <<04102>>05750000
   << placement PmapBufDisp in record PmapRecNr.  The record   <<04102>>05752000
   << and displacement values will be updated upon return.     <<04102>>05754000
   << Note that a priming read of PmapBuf may be necessary     <<04102>>05756000
   << prior to the first call.                                 <<04102>>05758000
                                                               <<04102>>05760000
   begin << CoreBufPmap >>                                     <<04102>>05762000
                                                               <<04102>>05764000
      MasterBuf(PmapFileNr, 0, PmapBuf, PmapRecNr, PmapBufDisp,<<04102>>05766000
                false, 0D, Buffer, Length);                    <<04102>>05768000
                                                               <<04102>>05770000
   end; << CoreBufPmap >>                                      <<04102>>05772000
$PAGE "GENERAL-PURPOSE PROCEDURES  -  COREBUFSI"               <<04102>>05774000
$CONTROL SEGMENT = SEG3                                        <<04102>>05776000
procedure CoreBufSI(Buffer, Length);                           <<04102>>05778000
   value Length;                                               <<04102>>05780000
   integer array Buffer;          << Buffer to be written >>   <<04102>>05782000
   integer       Length;          << # words in Buffer >>      <<04102>>05784000
                                                               <<04102>>05786000
   << Writes Buffer to the TOOLBOX Symbol Item (SI) header     <<04102>>05788000
   << scratch file starting at displacement SIBufDisp in rec-  <<04102>>05790000
   << ord SIRecNr.  The record and displacement values will    <<04102>>05792000
   << be updated upon return.  Note that a priming read of     <<04102>>05794000
   << SIBuf may be necessary prior to the first call.          <<04102>>05796000
                                                               <<04102>>05798000
   begin << CoreBufSI >>                                       <<04102>>05800000
                                                               <<04102>>05802000
      MasterBuf(SIFileNr, 0, SIBuf, SIRecNr, SIBufDisp,        <<04102>>05804000
                false, 0D, Buffer, Length);                    <<04102>>05806000
                                                               <<04102>>05808000
   end; << CoreBufSI >>                                        <<04102>>05810000
$ CONTROL SEGMENT = SEG3                                                05812000
   PROCEDURE MASTERBUFD (TFNUM,SFNUM,TBUF,TRECD,TDISP,         <<04102>>05814000
                     FLAG,ADR,BUFFER,LENGTH);                           05816000
   <<MOVES THE SPECIFIED BUFFER INTO THE FILE RECORD BUFFER AND THEN    05818000
     INTO THE FILE.  IF FLAG IS SET, THE BUFFER IS DISC RESIDENT        05820000
     AND IT'S FILE ADDRESS IS GIVEN BY ADR; OTHERWISE THE BUFFER IS     05822000
     CORE RESIDENT AND IS GIVEN BY BUFFER>>                             05824000
   VALUE TFNUM,SFNUM,FLAG,ADR,LENGTH;                                   05826000
   INTEGER TFNUM,SFNUM,TRECD,TDISP;  DOUBLE LENGTH;            <<04102>>05828000
   INTEGER ARRAY TBUF,BUFFER; DOUBLE ADR; LOGICAL FLAG;                 05830000
   BEGIN                                                                05832000
   INTEGER I,SRECD,SDISP _ 0;                                           05834000
   INTEGER LEN=LENGTH+1;                                       <<04102>>05836000
   IF FLAG THEN  <<DISC RESIDENT BUFFER?>>                              05838000
      BEGIN                                                             05840000
      GETRECDDISP(ADR,SRECD,SDISP);                                     05842000
      @BUFFER _ @BUF;  <<USE UTILITY BUFFER>>                           05844000
      FREADDIR'(SFNUM,BUFFER,SRECD)  <<READ FIRST SOURCE RECD>>         05846000
      END;                                                              05848000
   WHILE LENGTH > 0D DO  <<FILL TARGET OR EMPTY SOURCE>>       <<04102>>05850000
      BEGIN                                                             05852000
      IF FLAG THEN I:=MIN2(128-TDISP,128-SDISP)                <<04102>>05854000
              ELSE I:=128-TDISP;                               <<04102>>05856000
      IF LENGTH < %(2)111111111111111D THEN                    <<04102>>05858000
         I:=MIN2(LEN,I);                                       <<04102>>05860000
      MOVE TBUF(TDISP) _ BUFFER(SDISP),(I);                             05864000
      LENGTH:=LENGTH-DOUBLE(I);                                <<04102>>05866000
      TOS _ SDISP+I;                                                    05868000
      IF FLAG THEN TOS _ TOS.(9:7);                                     05870000
      SDISP _ TOS;                                                      05872000
      TDISP _ (TDISP+I).(9:7);                                          05874000
      IF TDISP = 0 THEN  <<TARGET FULL?>>                               05876000
         BEGIN                                                          05878000
         FWRITEDIR'(TFNUM,TBUF,TRECD);  <<WRITE TARGET RECORD>>         05880000
         TRECD _ TRECD+1;                                               05882000
         IF NOT FLAG AND LENGTH >= 128D THEN                   <<04102>>05884000
            BEGIN                                                       05886000
            I:=LEN.(9:7);                                      <<04102>>05888000
            LENGTH:=LENGTH-DOUBLE(I);                          <<04102>>05890000
            FWRITEMR'(TFNUM,BUFFER(SDISP),LEN,TRECD);          <<04102>>05892000
            TRECD:=TRECD+LEN.(0:9);                            <<04102>>05894000
         IF FEOF(TFNUM) > TRECD THEN  <<PRIME BUFFER?>>                 05896000
                 FREADDIR'(TFNUM,TBUF,TRECD);                           05898000
            MOVE TBUF:=BUFFER(SDISP+LEN),(I),2;                <<04102>>05900000
            TDISP _ TOS-@TBUF;                                          05902000
            RETURN                                                      05904000
            END;                                                        05906000
         IF LENGTH<128D AND FEOF(TFNUM) > TRECD THEN           <<04102>>05908000
            FREADDIR'(TFNUM,TBUF,TRECD);                                05910000
         END;                                                           05912000
      IF FLAG AND (SDISP = 0) AND (LENGTH <> 0D) THEN          <<04102>>05914000
         FREADDIR'(SFNUM,BUFFER,(SRECD _ SRECD+1))  <<NEXT SOURCE>>     05916000
      END                                                               05918000
   END;                                                                 05920000
$PAGE "GENERAL PURPOSE PROCEDURE - MASTERBUF"                           05922000
$CONTROL SEGMENT=SEG3                                                   05924000
PROCEDURE MASTERBUF (TFNUM,SFNUM,TBUF,TRECD,TDISP,             <<04102>>05926000
                     FLAG,ADR,BUFFER,LENGTH);                  <<04102>>05928000
<<INTERFACE TO MASTERBUFD>>                                    <<04102>>05930000
VALUE TFNUM,SFNUM,FLAG,ADR,LENGTH;                             <<04102>>05932000
INTEGER TFNUM,SFNUM,TRECD,TDISP,LENGTH;                        <<04102>>05934000
INTEGER ARRAY TBUF,BUFFER;                                     <<04102>>05936000
DOUBLE ADR;                                                    <<04102>>05938000
LOGICAL FLAG;                                                  <<04102>>05940000
                                                               <<04102>>05942000
BEGIN                                                          <<04102>>05944000
   MASTERBUFD(TFNUM,SFNUM,TBUF,TRECD,TDISP,                    <<04102>>05946000
              FLAG,ADR,BUFFER,DOUBLE(LENGTH));                 <<04102>>05948000
END;                                                           <<04102>>05950000
$ CONTROL SEGMENT = SEG3                                                05952000
PROCEDURE BUFFERDATABYTES (DBADR,BUF,LENGTH,TIMES);                     05954000
   <<GENERALIZED BUFFERING PROCEDURE FOR INITIALIZING THE DATA SEGMENT  05956000
     IMAGE IN THE PROGRAM FILE.  THE BYTE BUFFER IS ASSUMED TO BE       05958000
     CORE RESIDENT AND TO BE LENGTH BYTES LONG.  THIS INITIALIZATION    05960000
     BLOCK IS TO BEGIN AT DBADR (BYTE ADDRESS) AND IS TO BE REPEATED    05962000
     TIMES TIMES>>                                                      05964000
   VALUE DBADR,LENGTH,TIMES;                                            05966000
   LOGICAL DBADR,LENGTH;                                                05968000
   BYTE ARRAY BUF;                                                      05970000
   INTEGER TIMES;                                                       05972000
   BEGIN                                                                05974000
                                                                        05976000
   SUBROUTINE SAVEBUFFER (NEXTRECD);                                    05978000
      <<SAVES THE CONTENTS OF THE DATA BUFFER AND INITIALIZES IT WITH   05980000
        THE NEXT RECORD.  NOTE THAT THIS SUBROUTINE MUST NOT ALTER THE  05982000
        X REGISTER>>                                                    05984000
      VALUE NEXTRECD;                                                   05986000
      INTEGER NEXTRECD;                                                 05988000
      BEGIN                                                             05990000
      TOS _ XREG;  <<SAVE X REGISTER>>                                  05992000
      IF S2 <> TRECD2 THEN  <<DIFFERENT RECORD?>>                       05994000
         BEGIN                                                          05996000
         IF TRECD2 <> 0 THEN  <<NON-EMPTY BUFFER?>>                     05998000
            BEGIN                                                       06000000
            FWRITEDIR'(PROGFNUM,TBUF2,TRECD2);                          06002000
            SETBIT(DIRTYDATA,TRECD2-PSAG)                               06004000
            END;                                                        06006000
         IF TESTBIT(DIRTYDATA,S2-PSAG) THEN  <<RE-READ RECORD?>>        06008000
            FREADDIR'(PROGFNUM,TBUF2,S2)                                06010000
         ELSE IF ZERODB THEN  <<INIT. BUFFER TO ZERO?>>                 06012000
            BEGIN                                                       06014000
            TOS _ @TBUF2; PS0 _ 0;                                      06016000
            ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3)             06018000
            END                                                         06020000
         END;                                                           06022000
      TRECD2 _ S2;  <<SAVE REC. NR.>>                                   06024000
      XREG _ TOS  <<RESTORE X REGISTER>>                                06026000
      END;                                                              06028000
                                                                        06030000
   TOS _ DOUBLE(DBADR)&DLSL(8);                                         06032000
   TDISP2 _ TOS&LSR(8);                                                 06034000
   SAVEBUFFER(TOS+PSAG);  <<INIT. BUFFER>>                              06036000
   TOS _ TIMES;                                                         06038000
   IF > THEN                                <<VALID TIMES?>>   <<C0.06>>06040000
   DO BEGIN                                                             06042000
      TOS _ @BUF;  <<SOURCE BYTE ADR.>>                                 06044000
      TOS _ LENGTH;  <<NR. BYTES>>                                      06046000
      WHILE <> DO                                                       06048000
         BEGIN                                                          06050000
         TOS _ @TBUF2&LSL(1)+TDISP2;  <<TARGET BYTE ADR.>>              06052000
         TOS _ @BPS2;  <<SOURCE BYTE ADR.>>                             06054000
         TOS _ MIN2(S2,P256-TDISP2);  <<NR. BYTES MOVED>>               06056000
         XREG _ S0;  <<SAVE COPY IN XREG>>                              06058000
         MOVE * _ *,(TOS),1;                                            06060000
         @BPS3 _ TOS;  <<UPDATE SOURCE BYTE ADR.>>                      06062000
         ASSEMBLE(DEL,LDXA);                                            06064000
         TDISP2 _ (TOS+TDISP2).(8:8);  <<UPDATE TARGET DISP.>>          06066000
         IF = THEN SAVEBUFFER(TRECD2+1);  <<TARGET BUFFER FULL?>>       06068000
         TOS _ LOGICAL(TOS)-LOGICAL(XREG)  <<UPDATE NR. BYTES>>         06070000
         END;                                                           06072000
      ASSEMBLE(DDEL,DECA)                                               06074000
      END UNTIL =;                                                      06076000
   TOS _ TDISP2;                                                        06078000
   IF = AND NOT TESTBIT(DIRTYDATA,TRECD2-PSAG) THEN  <<VALID BUFFER?>>  06080000
      TRECD2 _ TOS  <<MARK BUFFER EMPTY>>                               06082000
   END;                                                                 06084000
$PAGE "GENERAL PURPOSE PROCEDURES  -  BUFFERDATAWORDS"         <<00207>>06086000
$ CONTROL SEGMENT = SEG3                                                06088000
PROCEDURE BUFFERDATAWORDS (DBADR,BUF,LENGTH,TIMES);                     06090000
   <<SAME AS BUFFERDATABYTES EXCEPT MANIPULATES WORD BUFFERS>>          06092000
   VALUE DBADR,LENGTH,TIMES;                                            06094000
   LOGICAL DBADR,LENGTH;                                                06096000
   INTEGER ARRAY BUF;                                                   06098000
   INTEGER TIMES;                                                       06100000
   BEGIN                                                                06102000
   TOS _ DBADR&LSL(1);                                                  06104000
   TOS _ @BUF&LSL(1);                                                   06106000
   TOS _ LENGTH&LSL(1);                                                 06108000
   BUFFERDATABYTES(*,*,*,TIMES)                                         06110000
   END;                                                                 06112000
$PAGE "GENERAL PURPOSE PROCEDURES  -  HASH"                    <<00207>>06114000
$ CONTROL SEGMENT = SEG3                                                06116000
INTEGER PROCEDURE HASH (NAME);                                          06118000
   <<EVALUATES THE HASH CODE OF AN IDENTIFIER.  ASSUMES THAT THE        06120000
     IDENTIFIER IS A STRING OF BYTES AND THAT THE LOWER FOUR BITS       06122000
     OF THE FIRST BYTE IS THE NUMBER OF CHARACTERS IN THE               06124000
     IDENTIFIER>>                                                       06126000
   BYTE ARRAY NAME;                                                     06128000
   BEGIN                                                                06130000
   TOS _ NAME&CSL(8)+NAME(1);  <<NC AND FIRST CHAR>>                    06132000
   TOS _ TOS.(4:12);  <<CLEAR FLAG BITS FROM NC>>                       06134000
   XREG _ NAME.(12:4)-1;  <<NC - 1>>                                    06136000
   TOS _ NAME(XREG)&CSL(8);  <<SECOND TO LAST CHAR>>                    06138000
   XREG _ XREG+1;                                                       06140000
   TOS _ NAME(XREG);                                                    06142000
   ASSEMBLE(ADD,DECX);                                                  06144000
   IF = THEN TOS _ TOS.(4:12);  <<CLEAR FLAG BITS IF NC = 1>>           06146000
   TOS _ 95;                                                            06148000
   ASSEMBLE(LDIV,DELB);                                                 06150000
   HASH _ TOS                                                           06152000
   END;                                                                 06154000
$PAGE "DL AREA TABLE MAINTAINENCE PROCEDURES   -  MAKEROOMINDL"<<00207>>06156000
<<----------------------------------------------------------------------06158000
*                                                                      *06160000
*  DL AREA TABLE MAINTAINENCE PROCEDURES                               *06162000
*                                                                      *06164000
---------------------------------------------------------------------->>06166000
                                                                        06168000
$ CONTROL SEGMENT = SEG3                                                06170000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       06172000
   <<CHECKS THE AVAILABLE SPACE IN THE DL AREA TO SEE IF THERE IS ROOM  06174000
     FOR NRWORDS.  IF THERE IS NOT ENOUGH ROOM THE DL AREA IS EXPANDED, 06176000
     THE TABLES IN AREA 2 ARE MOVED, AND THE POINTERS INTO AREA 2 ARE   06178000
     UPDATED.  IF THERE IS STILL NOT ENOUGH ROOM, A DL OVERFLOW MESSAGE 06180000
     IS PRINTED.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO   06182000
     INDICATE AN ERROR>>                                                06184000
   VALUE NRWORDS;                                                       06186000
   INTEGER NRWORDS;                                                     06188000
   BEGIN                                                                06190000
   INTEGER NWAVAIL = Q+1;                                               06192000
   TOS _ @DLAREA1-@DLAVAIL;  <<NR. WORDS AVAILABLE>>                    06194000
   IF NRWORDS > NWAVAIL THEN  <<NOT ENOUGH ROOM?>>                      06196000
      BEGIN                                                             06198000
                                                                        06200000
      <<* * * EXPAND DL AREA * * *>>                                    06202000
                                                                        06204000
      TOS _ 0;  <<FOR RESULT OF DLSIZE>>                                06206000
      TOS _ @DLAREA2;                                                   06208000
      TOS _ DLINCREMENT;  <<INIT. INCREMENT>>                           06210000
      WHILE NRWORDS > S0+NWAVAIL DO TOS _ TOS+DLINCREMENT;              06212000
      TOS _ TOS-TOS;  <<NEW DL LIMIT>>                                  06214000
      TOS _ DLSIZE(*);  <<EXPAND DL AREA>>                              06216000
                                                                        06218000
      <<* * * MOVE TABLES AND FIX POINTERS IN AREA 2 * * *>>            06220000
                                                                        06222000
      MOVE PS0 _ DLAREA2,(@DLAVAIL-@DLAREA2);  <<MOVE TABLES>>          06224000
      TOS _ TOS-@DLAREA2;  <<POINTER FIX TERM>>                         06226000
      @PTABLE _ @PTABLE+S0;                                             06228000
      @PATCHP _ @PATCHP+S0;                                             06230000
      @LOGICALUNITS _ @LOGICALUNITS+S0;                                 06232000
      @PROG0 _ @PROG0+S0;                                               06234000
      @PMAP _ @PMAP+S0+S0;                                              06236000
      @PDESCRIP _ @PDESCRIP+S0;                                         06238000
      @COMMON _ @COMMON+S0;                                             06240000
      @COMTAB := @COMTAB+S0;                                            06242000
      @COMP _ @COMP+S0;                                                 06244000
      IF NOT RLIBEQUALRL THEN                                           06246000
         BEGIN                                                          06248000
         @RLIBREC0 _ @RLIBREC0+S0;                                      06250000
         @RLIBDIR _ @RLIBDIR+S0;                                        06252000
         @RLIBP _ @RLIBP+S0;                                            06254000
         @RLIBP1 _ @RLIBP1+S0;                                          06256000
         END;                                                           06258000
      @RLTABLE _ @RLTABLE+S0;                                           06260000
      @RLENTP _ @RLENTP+S0;                                             06262000
      @PUSTBUF _ @PUSTBUF+S0;                                           06264000
      @DLAREA2 _ @DLAREA2+S0;                                           06266000
      @DLAVAIL _ TOS+@DLAVAIL;                                          06268000
      IF NRWORDS > @DLAREA1-@DLAVAIL THEN  <<STILL NO ROOM?>>           06270000
         BEGIN                                                          06272000
         ERROR(80);                                                     06274000
         GO NFG                                                         06276000
         END                                                            06278000
      END;                                                              06280000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    06282000
   GO GETOUT;                                                           06284000
                                                                        06286000
   NFG:                                                                 06288000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 06290000
                                                                        06292000
   GETOUT:                                                              06294000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             06296000
   END;                                                                 06298000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   OPENUSL"         <<00207>>06300000
<<----------------------------------------------------------------------06302000
*                                                                      *06304000
*  USL FILE MAINTAINENCE PROCEDURES                                    *06306000
*                                                                      *06308000
---------------------------------------------------------------------->>06310000
                                                                        06312000
$ CONTROL SEGMENT = SEG13                                               06314000
PROCEDURE OPENUSL (NEWFILE);                                            06316000
   <<PRESERVES ANY INFORMATION IN CORE THAT MAY BE DESTROYED BY         06318000
     LOADING THE USL, THEN LOADS THE USL AND INITIALIZES THE            06320000
     NECESSARY GLOBAL PARAMETERS.  IF NEWFILE IS SET, RECORD 0          06322000
     IS INITIALIZED ACCORDING TO THE PARAMETERS IN THE COMMAND          06324000
     BUFFER; OTHERWISE RECORD 0 IS LOADED AND THE DIRECTORY IS          06326000
     LOADED, IF POSSIBLE>>                                              06328000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      06330000
   BEGIN                                                                06332000
   INTEGER SAVEDLAREA1;                                        <<00563>>06334000
   INTEGER AOPTIONS;     <<PASSED TO FOPEN>>                   <<00563>>06336000
   INTEGER REALAOPTIONS; <<FROM FGETINFO>>                     <<00563>>06338000
   INTEGER FLAG := 0;    <<DL BUFFERS JUST ALLOCATED?>>        <<00563>>06340000
                                                                        06342000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           06344000
                                                                        06346000
   SAVEDLAREA1 := @DLAREA1;  <<SAVE DL AREA 1 LIMIT>>          <<00563>>06348000
                                                                        06352000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  06354000
                                                                        06356000
   IF NOT USLBUFALLOC THEN  <<BUFFERS ALLOCATED?>>                      06358000
      BEGIN                                                             06360000
      MAKEROOMINDL(USLDLBUFS);  <<REQUEST SPACE>>                       06362000
      IF < THEN GO NFG;  <<ERROR?>>                                     06364000
      @USLREC0 _ @DLAREA1-128;                                          06366000
      @HEAD _ @USLREC0-MAXHEAD;                                         06368000
      @DIR _ @HEAD-MAXDIR;                                              06370000
      @DLAREA1 := @DIR;  <<NEW DL AREA 1 LIMIT>>                        06372000
      USLBUFALLOC := TRUE;  <<SET FLAG>>                                06374000
      FLAG := FLAG+1  <<SET FLAG>>                                      06376000
      END;                                                              06378000
                                                                        06380000
   <<* * * PRESERVE OVERLAYABLE INFORMATION * * *>>                     06382000
                                                                        06384000
   CLOSEUSL;                                                            06386000
   IF < THEN GO NFG;  <<ERROR?>>                                        06388000
                                                                        06390000
   <<* * * LOAD NEW USL INFORMATION * * *>>                             06392000
                                                                        06394000
   IF NEWFILE THEN  <<INIT. RECORD 0?>>                                 06396000
      BEGIN                                                             06398000
      IF NOT (MINUSL <= FILESIZE <= MAXUSL) THEN                        06400000
         BEGIN                                                          06402000
         ERROR(6);                                                      06404000
         GO NFG                                                         06406000
         END;                                                           06408000
      USLFNUM _ FOPEN(BFILENAME,%(2)10000000000,%(2)101010100,,,,,,,    06410000
         DOUBLE(LOGICAL(FILESIZE)),NREXTENTS,,USLFILECODE);             06412000
      IF < THEN  <<ERROR?>>                                             06414000
         BEGIN                                                          06416000
         FOPENERROR:                                                    06418000
         TOS _ 7;                                                       06420000
         TOS _ 0D; FCHECK(0,S0);  <<FILE SYS. ERROR NR.>>               06422000
         ERRORN(*,*);                                                   06424000
         GO NFG                                                         06426000
         END;                                                           06428000
      USLSTATE.(1:9) := %(2)011010010;  <<INIT. STATE WORD>>   <<00660>>06430000
      TOS _ @USLREC0; PS0 _ 0;                                          06432000
      ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);                  06434000
      USLLID := USLFILEID;  <<VERSION NR.>>                             06436000
      USLFL _ DOUBLE(LOGICAL(FILESIZE))&DLSL(7);  <<FILE LENGTH>>       06438000
      USLSAAD _ 128;  <<S.A. DIR. AVAIL. BLOCK>>                        06440000
      TOS _ (LOGICAL(FILESIZE)+3)&LSR(3);                               06442000
      IF S0 > 255 THEN TOS _ 255;  <<MAX. DIR. SIZE>>                   06444000
      USLADL _ TOS&LSL(7);  <<DIR. AVAIL. BLOCK LENGTH>>                06446000
      USLSAI _ DOUBLE(USLADL)+P128D;  <<S.A. INFO BLOCK>>               06448000
      USLSAAI _ USLSAI;  <<S.A. INFO AVAIL. BLOCK>>                     06450000
      USLAIL := USLFL-USLSAI;  <<INFO AVAIL. BLOCK LENGTH>>             06452000
      DIRADR := 128;                                                    06454000
      INFOADR := 0D                                                     06456000
      END                                                               06458000
   ELSE  <<READ RECORD 0 AND DIRECTORY>>                                06460000
      BEGIN                                                             06462000
      TOS_0;  <<RESULT OF FOPEN>>                                       06464000
      TOS _ @BFILENAME;                                                 06466000
      TOS _ %(2)10000000011; <<FOPTIONS>>                               06468000
      AOPTIONS := IF LOGICAL(STATECHANGED) THEN                <<00665>>06470000
         %(2)110010000   <<AOPTIONS FOR AUXUSL>>               <<00665>>06472000
      ELSE                                                     <<00665>>06474000
         %(2)101010100;  <<AOPTIONS FOR USL>>                  <<00665>>06476000
      USLFNUM := FOPEN(*,*,AOPTIONS);                          <<00563>>06478000
      IF < THEN GO FOPENERROR;  <<ERROR?>>                              06480000
      TOS := 0D;                         <<EOF>>               <<C+.06>>06482000
      TOS _ 0;                                                          06484000
      FGETINFO (USLFNUM,,,REALAOPTIONS,,,,,S0,,DS2);           <<00563>>06486000
      IF REALAOPTIONS.(7:9) <> AOPTIONS THEN                   <<00563>>06488000
         BEGIN                                                 <<00563>>06490000
         ERROR(96);                                            <<00563>>06492000
         CLOSEUSL;                                             <<00563>>06494000
         GO NFG;                                               <<00563>>06496000
         END;                                                  <<00563>>06498000
      IF TOS <> USLFILECODE THEN                               <<C+.06>>06500000
      BEGIN                                                    <<C+.06>>06502000
          DDEL;                                                <<C+.06>>06504000
          GO TO USLERR;                                        <<C+.06>>06506000
      END;                                                     <<C+.06>>06508000
      IF TOS = 0D THEN                   <<UNINITIALIZED USL?>><<C+.06>>06510000
      BEGIN                                                    <<C+.06>>06512000
          INITUSLF (USLFNUM,USLREC0);                          <<C+.06>>06514000
          IF < THEN GO TO USLERR;        <<FAILED?>>           <<C+.06>>06516000
          DIRADR := 128;                                       <<C+.06>>06518000
          USLSTATE.(1:9) := %(2)011010000;                     <<00660>>06520000
          GO TO GETOUT;                                        <<C+.06>>06522000
      END;                                                     <<C+.06>>06524000
      FREADDIR' (USLFNUM,USLREC0,0);                           <<C+.06>>06526000
      IF USLLID <> USLFILEID THEN                              <<C+.06>>06528000
   USLERR:                                                     <<C+.06>>06530000
      BEGIN                                                    <<C+.06>>06532000
          ERROR (8);                                           <<C+.06>>06534000
          GO TO NFG;                                           <<C+.06>>06536000
      END;                                                     <<C+.06>>06538000
      USLSTATE.(1:9) := %(2)000000000; <<INIT. STATE WORD>>    <<00660>>06540000
      DIRADR := -MAXDIR;                                                06542000
      INFOADR := DOUBLE(-MAXHEAD);                                      06544000
      GETDIR;  <<TRY TO LOAD DIRECTORY>>                                06546000
      GETINFO  <<TRY TO LOAD INFO BLOCK>>                               06548000
      END;                                                              06550000
   GO GETOUT;                                                           06552000
                                                                        06554000
   NFG:                                                                 06556000
   IF LOGICAL(FLAG) THEN  <<DEALLOCATE BUFFERS?>>                       06558000
      BEGIN                                                             06560000
      @DLAREA1 := SAVEDLAREA1;  <<RESTORE DL AREA 1 LIMIT>>             06562000
      USLBUFALLOC := FALSE  <<CLEAR FLAG>>                              06564000
      END;                                                              06566000
                                                                        06568000
   GETOUT:                                                              06570000
   END;                                                                 06572000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   CLOSEUSL"        <<00207>>06574000
$ CONTROL SEGMENT = SEG13                                               06576000
PROCEDURE CLOSEUSL;                                                     06578000
   <<IF A USL FILE IS OPENED, SAVES THE INFORMATION IN CORE THAT        06580000
     HAS BEEN MODIFIED; SAVES RECORD 0 AND THE DIRECTORY OR CURRENT     06582000
     ENTRY IF THEY HAVE BEEN MODIFIED.  NOTE THAT THIS PROCEDURE USES   06584000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          06586000
   BEGIN                                                                06588000
   TOS := USLFNUM;  <<FILE NR.>>                                        06590000
   IF <> THEN  <<FILE OPENED?>>                                         06592000
      BEGIN                                                             06594000
      IF USLREC0MOD THEN  <<RECORD 0 MODIFIED?>>                        06596000
         BEGIN                                                          06598000
         FWRITEDIR'(USLFNUM,USLREC0,0);  <<SAVE RECORD 0>>              06600000
         USLREC0MOD _ FALSE  <<CLEAR FLAG>>                             06602000
         END;                                                           06604000
      PUTDIR;  <<SAVE DIRECTORY BUFFER>>                                06606000
      PUTINFO;  <<SAVE INFO BUFFER>>                                    06608000
      FCLOSE(USLFNUM,USLCLOSECODE,0);                          <<00660>>06610000
      IF < THEN  <<ERROR?>>                                             06612000
         BEGIN                                                          06614000
         TOS _ 9;                                                       06616000
         TOS _ 0D; FCHECK(USLFNUM,S0);  <<FILE SYS. ERROR NR.>>         06618000
         ERRORN(*,*);                                                   06620000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           06622000
         GO GETOUT                                                      06624000
         END;                                                           06626000
      USLSTATE.(1:6) := %(2)000000;  <<RE-SET STATE WORD>>              06628000
      USLFNUM := 0  <<MARK FILE CLOSED>>                                06630000
      END;                                                              06632000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    06634000
                                                                        06636000
   GETOUT:                                                              06638000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             06640000
   END;                                                                 06642000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETDIR"          <<00207>>06644000
$ CONTROL SEGMENT = SEG10                                               06646000
PROCEDURE GETDIR;                                                       06648000
   <<LOADS THE DIRECTORY IF IT IS NOT IN CORE AND IT WILL FIT>>         06650000
   BEGIN                                                                06652000
   IF NOT USLDIRINCORE AND USLDL <= MAXDIR THEN                         06654000
      BEGIN                                                             06656000
      FREADMR''(USLFNUM,DIR,USLDL,1);  <<READ DIRECTORY>>               06658000
      DIRADR := 128;  <<INIT. DIR. ADR.>>                               06660000
      USLSTATE.(3:2) := %(2)10  <<RE-SET STATE>>                        06662000
      END                                                               06664000
   END;                                                                 06666000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   PUTDIR"          <<00207>>06668000
$ CONTROL SEGMENT = SEG10                                               06670000
PROCEDURE PUTDIR;                                                       06672000
   <<WRITES THE DIRECTORY OR CURRENT ENTRY BACK INTO THE USL FILE IF    06674000
     THE BUFFER HAS BEEN MODIFIED AND SETS THE APPROPRIATE STATE FLAGS>>06676000
   BEGIN                                                                06678000
   IF USLDIRMOD THEN  <<DIRECTORY MODIFIED?>>                           06680000
      BEGIN                                                             06682000
      FWRITEMR'(USLFNUM,DIR,MIN2(USLSAAD-DIRADR,MAXDIR),DIRADR.(0:9));  06684000
      USLDIRMOD _ FALSE  <<CLEAR FLAG>>                                 06686000
      END                                                               06688000
   END;                                                                 06690000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETINFO"         <<00207>>06692000
$ CONTROL SEGMENT = SEG10                                               06694000
PROCEDURE GETINFO;                                                      06696000
   <<IF THE INFO BLOCK IS NOT IN CORE AND IT WILL FIT INTO THE          06698000
     HEADER BUFFER IT WILL BE LOADED AND THE APPROPRIATE FLAGS WILL     06700000
     WILL BE SET>>                                                      06702000
   BEGIN                                                                06704000
   IF (NOT USLINFOINCORE) AND (USLIL <= DOUBLE(MAXDIR)) THEN            06706000
      BEGIN                                                             06708000
      TOS _ USLFNUM; TOS _ @HEAD; TOS _ USLIL2;                         06710000
      TOS _ USLSAI&DLSR(7); DELB;                                       06712000
      INFOADR _ 0D;                                                     06714000
      FREADMR''(*,*,*,*);  <<LOAD INFO BLOCK>>                          06716000
      USLSTATE.(5:2) := %(2)10  <<INIT. FLAGS>>                         06718000
      END                                                               06720000
   END;                                                                 06722000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   PUTINFO"         <<00207>>06724000
$ CONTROL SEGMENT = SEG10                                               06726000
PROCEDURE PUTINFO;                                                      06728000
   <<WRITES THE INFO BLOCK OR CURRENT HEADER/CODE MODULE BACK INTO THE  06730000
     USL FILE IF IT HAS BEEN MODIFIED AND SETS THE APPROPRIATE FLAGS>>  06732000
   BEGIN                                                                06734000
   IF USLINFOMOD THEN  <<INFO MODIFIED?>>                               06736000
      BEGIN                                                             06738000
      TOS := USLFNUM;  <<USL FILE NR.>>                                 06740000
      TOS := @HEAD;  <<INFO BUFFER>>                                    06742000
      TOS := USLIL-INFOADR;                                             06744000
      TOS := 0; TOS := MAXHEAD;                                         06746000
      IF DS1 < DS3 THEN ASSEMBLE(DXCH);                                 06748000
      ASSEMBLE(DDEL,DELB);  <<WORD COUNT>>                              06750000
      TOS := (INFOADR+USLSAI)&DLSR(7); DELB;  <<REC. NR.>>              06752000
      FWRITEMR'(*,*,*,*);  <<SAVE BUFFER>>                              06754000
      USLINFOMOD := FALSE  <<CLEAR FLAG>>                               06756000
      END                                                               06758000
   END;                                                                 06760000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   USLCLEAN"        <<00207>>06762000
$CONTROL SEGMENT=SEG13                                         <<00207>>06764000
PROCEDURE USLCLEAN;                                            <<00207>>06766000
                                                               <<00207>>06768000
   COMMENT:   THIS PROCEDURE PERFORMS THE CLEANUSL COMMAND BY  <<00207>>06770000
              CALLING THE INTRINSIC "CLEANUSL".  INPUT IS THE  <<00207>>06772000
              NAME OF THE NEW USL IN BFNAME1;                  <<00207>>06774000
                                                               <<00207>>06776000
BEGIN                                                          <<00660>>06780000
    BYTE ARRAY B0(*)=PB := 14,"USL OR NEW USL";                <<00660>>06782000
    BYTE ARRAY B1(*)=PB := 8,"USL FILE";                       <<00660>>06784000
    BYTE ARRAY B2(*)=PB := 15,"CLEANUSL,      ";               <<00660>>06786000
    BYTE ARRAY BNEWPASS(*)=PB:="$NEWPASS ";                    <<04779>>06788000
    BYTE ARRAY BOLDPASS(*)=PB:="$OLDPASS ";                    <<04779>>06790000
    BYTE ARRAY OLDFILENAME(0:31);                              <<00660>>06792000
    BYTE ARRAY MSGBUF(*) = OLDFILENAME;                        <<00660>>06794000
    INTEGER CLERR = NUSLFNUM;<<00660USL RTNS ERROR ON FAILURE>><<00660>>06796000
    LOGICAL REPLACEOLDUSL := FALSE;                            <<00660>>06798000
                                                               <<00660>>06800000
    SUBROUTINE FILESYSERR( FNUM, ERRMSG);                      <<00660>>06802000
       VALUE FNUM, ERRMSG;                                     <<00660>>06804000
       INTEGER FNUM, ERRMSG;                                   <<00660>>06806000
    BEGIN                                                      <<00660>>06808000
       FCHECK( FNUM, I);                                       <<00660>>06810000
       ERRORI( ERRMSG, I);                                     <<00660>>06812000
    END;                                                       <<00660>>06814000
                                                               <<00660>>06816000
    IF USLFNUM = 0 THEN <<USL FILE OPEN?>>                     <<00660>>06818000
       BEGIN                                                   <<00660>>06820000
       ERROR(5);                                               <<00660>>06822000
       RETURN;                                                 <<00660>>06824000
       END;                                                    <<00660>>06826000
                                                               <<00660>>06828000
    FGETINFO( USLFNUM, OLDFILENAME); <<PRESENT USL FILE NAME>> <<00660>>06830000
    IF <> THEN                                                 <<00660>>06832000
       BEGIN                                                   <<00660>>06834000
       FILESYSERR( USLFNUM, 200);                              <<00660>>06836000
       RETURN;                                                 <<00660>>06838000
       END;                                                    <<00660>>06840000
    IF BFNAME1 = " " THEN <<REPLACE OLD USL FILE?>>            <<00660>>06842000
       BEGIN                                                   <<00660>>06844000
       REPLACEOLDUSL := TRUE;                                  <<00660>>06846000
       MOVE BFNAME1 := OLDFILENAME,(32);                       <<00660>>06848000
       END                                                     <<00660>>06850000
    ELSE                                                       <<00660>>06852000
       BEGIN                                                   <<00660>>06854000
       OLDFILE( BFNAME1, 209);                                 <<00660>>06856000
       IF < THEN RETURN;                                       <<00660>>06858000
       END;                                                    <<00660>>06860000
                                                               <<00660>>06862000
    <<FLUSH BUFFERS TO DISC>>                                  <<00660>>06864000
    IF USLREC0MOD THEN <<RECORD 0 MODIFIED?>>                  <<00660>>06866000
       BEGIN                                                   <<00660>>06868000
       FWRITEDIR'(USLFNUM,USLREC0,0);<<SAVE RECORD 0>>         <<00660>>06870000
       USLREC0MOD := FALSE; <<CLEAR FLAG>>                     <<00660>>06872000
       END;                                                    <<00660>>06874000
    PUTDIR;  <<SAVE DIRECTORY BUFFER>>                         <<00660>>06876000
    PUTINFO; <<SAVE INFO BUFFER>>                              <<00660>>06878000
                                                               <<00660>>06880000
    NUSLFNUM := CLEANUSL( USLFNUM, BFNAME1);                   <<00660>>06882000
    IF < THEN                                                  <<00660>>06884000
       BEGIN                                                   <<00660>>06886000
       MOVE MSGBUF := B0,(15);                                 <<00660>>06888000
       IF CLERR = 0 THEN ERRORS( 94, MSGBUF)                   <<00660>>06890000
     ELSE                                                      <<00660>>06892000
       IF CLERR = 1 THEN ERRORS( 84, MSGBUF)                   <<00660>>06894000
     ELSE                                                      <<00660>>06896000
       IF CLERR = 7 THEN ERROR(121)                            <<00660>>06898000
     ELSE                                                      <<00660>>06900000
       IF CLERR = 12 THEN                                      <<00660>>06902000
          BEGIN                                                <<00660>>06904000
          MOVE MSGBUF := B1,(9);                               <<00660>>06906000
          ERRORS( 8, MSGBUF);                                  <<00660>>06908000
          END                                                  <<00660>>06910000
       ELSE                                                    <<00660>>06912000
          BEGIN <<WHAT ERROR??????>>                           <<00660>>06914000
          MOVE MSGBUF := B2,(16);                              <<00660>>06916000
          LNTOA( CLERR, 10, MSGBUF(10));                       <<00660>>06918000
          ERRORS( 209, MSGBUF);                                <<00660>>06920000
          END;                                                 <<00660>>06922000
       NUSLFNUM := 0;                                          <<00660>>06924000
       RETURN;                                                 <<00660>>06926000
       END;                                                    <<00660>>06928000
   IF REPLACEOLDUSL THEN                                       <<04779>>06932000
      BEGIN                                                    <<04779>>06934000
         FCLOSE(NUSLFNUM,1,0);                                 <<04779>>06936000
         IF <> THEN                                            <<04779>>06938000
            BEGIN                                              <<04779>>06940000
               TOS:=0;                                         <<04779>>06942000
               FCHECK(NUSLFNUM,S0);                            <<04779>>06944000
               IF S0 = DUP'NAME THEN                           <<04779>>06946000
                  BEGIN                                        <<04779>>06948000
                     USLCLOSECODE := 4;                        <<04779>>06950000
                     CLOSEUSL;                                 <<04779>>06952000
                     IF < THEN RETURN;                         <<04779>>06954000
                     FCLOSE(NUSLFNUM,1,0);                     <<04779>>06956000
                     IF <> THEN                                <<04779>>06958000
                        FILESYSERR(NUSLFNUM,209);              <<04779>>06960000
                  END                                          <<04779>>06962000
               ELSE                                            <<04779>>06964000
                  BEGIN                                        <<04779>>06966000
                     ERRORI(209,S0);                           <<04779>>06968000
                     CLOSEUSL;                                 <<04779>>06970000
                     IF < THEN RETURN;                         <<04779>>06972000
                  END;                                         <<04779>>06974000
               DEL;                                            <<04779>>06976000
            END                                                <<04779>>06978000
         ELSE                                                  <<04779>>06980000
            BEGIN                                              <<04779>>06982000
               USLCLOSECODE := 4;                              <<04779>>06984000
               CLOSEUSL;                                       <<04779>>06986000
               IF < THEN RETURN;                               <<04779>>06988000
            END;                                               <<04779>>06990000
      END                                                      <<04779>>06992000
   ELSE                                                        <<04779>>06994000
      BEGIN                                                    <<04779>>06996000
         CLOSEUSL;                                             <<04779>>06998000
         IF < THEN RETURN;                                     <<04779>>07000000
         FCLOSE(NUSLFNUM,1,0);                                 <<04779>>07002000
         IF <> THEN                                            <<04779>>07004000
            BEGIN                                              <<04779>>07006000
               FILESYSERR(NUSLFNUM,209);                       <<04779>>07008000
               MOVE BFNAME1 := OLDFILENAME,(32);               <<04779>>07010000
            END;                                               <<04779>>07012000
    OPENUSL( FALSE);                                           <<00660>>07014000
      END;                                                     <<04779>>07016000
                                                               <<04779>>07018000
   IF BFNAME1 = BNEWPASS,(8) THEN                              <<04779>>07020000
      MOVE BFNAME1 := BOLDPASS,(9);                            <<04779>>07022000
   NUSLFNUM := 0;                                              <<04779>>07024000
END;                                                           <<00660>>07026000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETENTRY"        <<00207>>07028000
$ CONTROL SEGMENT = SEG10                                               07030000
PROCEDURE GETENTRY (FILEADR);                                           07032000
   <<LOADS THE USL ENTRY HAVING THE FILE ADDRESS FILEADR AND SETS       07034000
     THE ENTRY PARAMETERS>>                                             07036000
   VALUE FILEADR; INTEGER FILEADR;                                      07038000
   BEGIN                                                                07040000
   INTEGER MAXDIR' = Q+1;                                               07042000
                                                                        07044000
   SUBROUTINE LOAD;                                                     07046000
      <<LOADS THE SPECIFIED ENTRY BY FILLING THE DIRECTORY BUFFER       07048000
        STARTING WITH THE RECORD CONTAINING THE FIRST WORD OF THE       07050000
        ENTRY>>                                                         07052000
      BEGIN                                                             07054000
      PUTDIR;  <<SAVE DIRECTORY BUFFER>>                                07056000
      FREADMR''(USLFNUM,DIR,MAXDIR',ENTFILEADR.(0:9));                  07058000
      @ENTP _ @DIR+ENTFILEADR.(9:7);  <<INIT. ENTRY POINTER>>           07060000
      DIRADR _ ENTFILEADR&LSR(7)&LSL(7)                                 07062000
      END;                                                              07064000
                                                                        07066000
   TOS _ MAXDIR;                                                        07068000
   ENTFILEADR _ FILEADR.(1:15);  <<STRIP "LAST BIT" AND SAVE ADR.>>     07070000
   IF USLDIRINCORE THEN  <<DIRECTORY IN CORE?>>                         07072000
      @ENTP _ @DIR+ENTFILEADR-128                                       07074000
   ELSE                                                                 07076000
      BEGIN                                                             07078000
      TOS _ ENTFILEADR-DIRADR;  <<DIR. DISP. OF ENTRY>>                 07080000
      IF < OR S0 >= MAXDIR' THEN  <<FIRST WORD IN CORE?>>               07082000
         LOAD                                                           07084000
      ELSE                                                              07086000
         BEGIN                                                          07088000
         @ENTP _ TOS+@DIR;  <<INIT. ENTRY POINTER>>                     07090000
         IF @ENTP+ENW > @DIR+MAXDIR' THEN LOAD                          07092000
         END                                                            07094000
      END;                                                              07096000
   USLENTRYPARMS                                                        07098000
   END;                                                                 07100000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   USLCOPY"         <<00207>>07102000
$CONTROL SEGMENT=SEG10                                         <<00207>>07104000
PROCEDURE USLCOPY;                                             <<00207>>07106000
                                                               <<00207>>07108000
   COMMENT: THIS PROCEDURE IMPLEMENTS THE COPYUSL COMMAND.  IT <<00207>>07110000
            EXPECTS TO FIND THE PERCENTAGE IN NUM1 AND THE NEW <<00207>>07112000
            FILE NAME IN BFNAME1;                              <<00207>>07114000
                                                               <<00207>>07116000
BEGIN                                                          <<00666>>07120000
    BYTE ARRAY BNEWPASS(*)=PB := "$NEWPASS ";                  <<00666>>07122000
    BYTE ARRAY BOLDPASS(*)=PB := "$OLDPASS ";                  <<00666>>07124000
    BYTE ARRAY OLDFILENAME(0:31);                              <<00666>>07126000
    DOUBLE                                                     <<00666>>07128000
       FACTOR,                                                 <<00666>>07130000
       TOTALDL,                                                <<00666>>07132000
       TOTALIL;                                                <<00666>>07134000
    LOGICAL REPLACEOLDUSL := FALSE;                            <<00666>>07136000
    INTEGER                                                    <<00666>>07138000
       FOPT;                                                   <<00666>>07140000
    INTEGER POINTER                                            <<00666>>07142000
       NEWREC0,                                                <<00666>>07144000
       TBUF;                                                   <<00666>>07146000
    DOUBLE POINTER                                             <<00666>>07148000
       DNEWREC0 = NEWREC0;                                     <<00666>>07150000
    DEFINE                                                     <<00666>>07152000
       NEWPASS  = FOPT.(10:3) = 2#,                            <<00666>>07154000
       OLDPASS  = FOPT.(10:3) = 3#;                            <<00666>>07156000
                                                               <<00666>>07158000
    SUBROUTINE FILESYSERR( FNUM, ERRMSG);                      <<00666>>07160000
       VALUE FNUM, ERRMSG;                                     <<00666>>07162000
       INTEGER FNUM, ERRMSG;                                   <<00666>>07164000
    BEGIN                                                      <<00666>>07166000
       FCHECK( FNUM, I);                                       <<00666>>07168000
       ERRORI( ERRMSG, I);                                     <<00666>>07170000
    END;                                                       <<00666>>07172000
                                                               <<00666>>07174000
    SUBROUTINE COPYREC0;                                       <<00666>>07176000
    BEGIN                                                      <<00666>>07178000
       MOVE NEWREC0 := USLREC0,(128);                          <<00666>>07180000
       NEWFL := (TOTALDL+TOTALIL+1D)&DLSL(7);                  <<00666>>07182000
       NEWADL := INTEGER(TOTALDL&DLSL(7))-NEWDL;               <<00666>>07184000
       NEWSAI := (TOTALDL+1D)&DLSL(7);                         <<00666>>07186000
       NEWSAAI := NEWSAI+NEWIL;                                <<00666>>07188000
       NEWAIL := TOTALIL&DLSL(7)-NEWIL;                        <<00666>>07190000
       FWRITEDIR'( NUSLFNUM, NEWREC0, 0);                      <<00666>>07192000
    END;                                                       <<00666>>07194000
                                                               <<00666>>07196000
    SUBROUTINE COPY( START, LAST, NEWPOSITION);                <<00666>>07198000
       VALUE START, LAST, NEWPOSITION;                         <<00666>>07200000
       INTEGER START, LAST, NEWPOSITION;                       <<00666>>07202000
    BEGIN                                                      <<00666>>07204000
       WHILE START <= LAST DO                                  <<00666>>07206000
          BEGIN                                                <<00666>>07208000
          FREADDIR'( USLFNUM, TBUF, START);                    <<00666>>07210000
          FWRITEDIR'( NUSLFNUM, TBUF, NEWPOSITION);            <<00666>>07212000
          START := START+1;                                    <<00666>>07214000
          NEWPOSITION := NEWPOSITION+1;                        <<00666>>07216000
          END;                                                 <<00666>>07218000
    END;                                                       <<00666>>07220000
                                                               <<00666>>07222000
    IF USLFNUM = 0 THEN <<USL FILE OPEN?>>                     <<00666>>07224000
       BEGIN                                                   <<00666>>07226000
       ERROR(5);                                               <<00666>>07228000
       RETURN;                                                 <<00666>>07230000
       END;                                                    <<00666>>07232000
    FACTOR := DOUBLE(NUM1) + 100D;                             <<00666>>07234000
    IF FACTOR < 100D OR FACTOR > 10000D THEN                   <<00666>>07236000
       BEGIN                                                   <<00666>>07238000
       ERROR(95);                                              <<00666>>07240000
       RETURN;                                                 <<00666>>07242000
       END;                                                    <<00666>>07244000
                                                               <<00666>>07246000
    FGETINFO( USLFNUM,OLDFILENAME,FOPT);<<PRESENT USL FILE NAME<<00666>>07248000
    IF <> THEN                                                 <<00666>>07250000
       BEGIN                                                   <<00666>>07252000
       FILESYSERR( USLFNUM, 200);                              <<00666>>07254000
       RETURN;                                                 <<00666>>07256000
       END;                                                    <<00666>>07258000
    IF BFNAME1 = " " THEN <<REPLACE OLD USL FILE?>>            <<00666>>07260000
       BEGIN                                                   <<00666>>07262000
       REPLACEOLDUSL := TRUE;                                  <<00666>>07264000
       IF OLDPASS THEN                                         <<00666>>07266000
          MOVE BFNAME1 := BNEWPASS,(9)                         <<00666>>07268000
       ELSE                                                    <<00666>>07270000
          MOVE BFNAME1 := OLDFILENAME,(32);                    <<00666>>07272000
       END                                                     <<00666>>07274000
    ELSE                                                       <<00666>>07276000
       BEGIN                                                   <<00666>>07278000
       OLDFILE( BFNAME1, 209);                                 <<00666>>07280000
       IF < THEN RETURN;                                       <<00666>>07282000
       IF BFNAME1 = BOLDPASS,(8) THEN                          <<00666>>07284000
          MOVE BFNAME1 := BNEWPASS,(9);                        <<00666>>07286000
       END;                                                    <<00666>>07288000
                                                               <<00666>>07290000
    <<FLUSH BUFFERS TO DISC>>                                  <<00666>>07292000
    IF USLREC0MOD THEN <<RECORD 0 MODIFIED?>>                  <<00666>>07294000
       BEGIN                                                   <<00666>>07296000
       FWRITEDIR'(USLFNUM,USLREC0,0);<<SAVE RECORD 0>>         <<00666>>07298000
       USLREC0MOD := FALSE; <<CLEAR FLAG>>                     <<00666>>07300000
       END;                                                    <<00666>>07302000
    PUTDIR;  <<SAVE DIRECTORY BUFFER>>                         <<00666>>07304000
    PUTINFO; <<SAVE INFO BUFFER>>                              <<00666>>07306000
                                                               <<00666>>07308000
    <<OPEN NEW USL FILE>>                                      <<00666>>07310000
    TOTALDL := DELTA(DOUBLE(USLDL+127)&DLSR(7),FACTOR);        <<00666>>07312000
    IF TOTALDL > 255D THEN TOTALDL := 255D;                    <<00666>>07314000
    TOTALIL := DELTA((USLIL+127D)&DLSR(7),FACTOR);             <<00666>>07316000
    IF TOTALDL+TOTALIL+1D > DOUBLE(MAXUSL) THEN                <<00666>>07318000
       BEGIN                                                   <<00666>>07320000
       ERROR(6);                                               <<00666>>07322000
       RETURN;                                                 <<00666>>07324000
       END;                                                    <<00666>>07326000
    NUSLFNUM := FOPEN( BFNAME1,,4,,,,,,,TOTALDL+TOTALIL+1D,    <<00666>>07328000
       16,1,USLFILECODE);                                      <<00666>>07330000
    IF <> THEN                                                 <<00666>>07332000
       BEGIN                                                   <<00666>>07334000
       FILESYSERR( NUSLFNUM, 209);                             <<00666>>07336000
       RETURN;                                                 <<00666>>07338000
       END;                                                    <<00666>>07340000
                                                               <<00666>>07342000
    <<ALLOCATE STORAGE>>                                       <<00666>>07344000
    MAKEROOMINDL(256); <<GET 256 WORDS>>                       <<00666>>07346000
    IF < THEN RETURN;                                          <<00666>>07348000
    @TBUF := @DLAREA1;                                         <<00666>>07350000
    @NEWREC0 := @DLAREA1+128;                                  <<00666>>07352000
                                                               <<00666>>07354000
    <<BEGIN COPY INTO NEW USL FILE>>                           <<00666>>07356000
    COPYREC0;                                                  <<00666>>07358000
    COPY( 1, (USLSAAD+127)&LSR(7), 1);                         <<00666>>07360000
    COPY( INTEGER(USLSAI&DLSR(7)), INTEGER((USLSAAI+127D)&DLSR(7))-1,   07362000
          INTEGER(NEWSAI&DLSR(7)));                            <<00666>>07364000
                                                               <<00666>>07366000
   IF REPLACEOLDUSL THEN                                       <<04779>>07370000
      BEGIN                                                    <<04779>>07372000
         FCLOSE(NUSLFNUM,1,0);                                 <<04779>>07374000
         IF <> THEN                                            <<04779>>07376000
            BEGIN                                              <<04779>>07378000
               TOS:=0;                                         <<04779>>07380000
               FCHECK(NUSLFNUM,S0);                            <<04779>>07382000
               IF S0 = DUP'NAME THEN                           <<04779>>07384000
                  BEGIN                                        <<04779>>07386000
                     USLCLOSECODE := 4;                        <<04779>>07388000
                     CLOSEUSL;                                 <<04779>>07390000
                     IF < THEN RETURN;                         <<04779>>07392000
                     FCLOSE(NUSLFNUM,1,0);                     <<04779>>07394000
                     IF <> THEN                                <<04779>>07396000
                        FILESYSERR(NUSLFNUM,209);              <<04779>>07398000
                  END                                          <<04779>>07400000
               ELSE                                            <<04779>>07402000
                  BEGIN                                        <<04779>>07404000
                     ERRORI(209,S0);                           <<04779>>07406000
                     CLOSEUSL;                                 <<04779>>07408000
                     IF < THEN RETURN;                         <<04779>>07410000
                  END;                                         <<04779>>07412000
               DEL;                                            <<04779>>07414000
            END                                                <<04779>>07416000
         ELSE                                                  <<04779>>07418000
            BEGIN                                              <<04779>>07420000
               USLCLOSECODE := 4;                              <<04779>>07422000
               CLOSEUSL;                                       <<04779>>07424000
               IF < THEN RETURN;                               <<04779>>07426000
            END;                                               <<04779>>07428000
      END                                                      <<04779>>07430000
   ELSE                                                        <<04779>>07432000
      BEGIN                                                    <<04779>>07434000
         CLOSEUSL;                                             <<04779>>07436000
         IF < THEN RETURN;                                     <<04779>>07438000
         FCLOSE(NUSLFNUM,1,0);                                 <<04779>>07440000
         IF <> THEN                                            <<04779>>07442000
            BEGIN                                              <<04779>>07444000
               FILESYSERR(NUSLFNUM,209);                       <<04779>>07446000
               MOVE BFNAME1 := OLDFILENAME,(32);               <<04779>>07448000
            END;                                               <<04779>>07450000
      END;                                                     <<04779>>07452000
                                                               <<04779>>07454000
   IF BFNAME1 = BNEWPASS,(8) THEN                              <<04779>>07456000
      MOVE BFNAME1 := BOLDPASS,(9);                            <<04779>>07458000
   NUSLFNUM := 0;                                              <<04779>>07460000
   OPENUSL(FALSE);                                             <<04779>>07462000
END;                                                           <<04779>>07464000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   DELTA"           <<00207>>07466000
$CONTROL SEGMENT=SEG10                                         <<00207>>07468000
DOUBLE PROCEDURE DELTA(X,F);                                   <<00207>>07470000
   VALUE X,F; DOUBLE X,F;                                      <<00207>>07472000
   BEGIN                                                       <<00207>>07474000
      DELTA:=(X*F+50D)/100D;                                   <<00207>>07476000
   END;                                                        <<00207>>07478000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   OLDFILE"         <<00207>>07480000
$CONTROL SEGMENT=SEG10                                         <<00207>>07482000
PROCEDURE OLDFILE( NAME, ERRNUM);                              <<00648>>07486000
   VALUE ERRNUM;                                               <<00648>>07488000
   BYTE ARRAY NAME;                                            <<00648>>07490000
   INTEGER ERRNUM;                                             <<00648>>07492000
BEGIN                                                          <<00648>>07494000
   INTEGER FNUM, I;                                            <<00648>>07496000
   IF NAME <> " " THEN                                         <<00648>>07498000
      BEGIN                                                    <<00648>>07500000
      FNUM := FOPEN( NAME, 3);                                 <<00648>>07502000
      IF = THEN                                                <<00648>>07504000
         BEGIN                                                 <<00648>>07506000
         FCLOSE( FNUM, 0, 0);                                  <<00648>>07508000
         ERROR(122);                                           <<00648>>07510000
         GO NFG;                                               <<00648>>07512000
         END                                                   <<00648>>07514000
      ELSE                                                     <<00648>>07516000
         BEGIN                                                 <<00648>>07518000
         FCHECK( FNUM, I);                                     <<00648>>07520000
         IF I <> 52 AND I <> 58 THEN                           <<00660>>07522000
            BEGIN                                              <<00648>>07524000
            ERRORN( ERRNUM, DOUBLE(I));                        <<00648>>07526000
            GO NFG;                                            <<00648>>07528000
            END;                                               <<00648>>07530000
         END;                                                  <<00648>>07532000
      END;                                                     <<00648>>07534000
   CONDCODE := CCE;                                            <<00648>>07536000
   RETURN;                                                     <<00648>>07538000
NFG:                                                           <<00648>>07540000
   CONDCODE := CCL;                                            <<00648>>07542000
END;                                                           <<00648>>07544000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   USLENTRYPARMS"   <<00207>>07546000
$ CONTROL SEGMENT = SEG10                                      <<00207>>07548000
PROCEDURE USLENTRYPARMS;                                                07550000
   <<CALCULATES THE USL ENTRY PARAMETERS FOR THE ENTRY POINTED TO       07552000
     BY ENTP.  CHECKS FOR A VALID ENTRY TYPE NUMBER; IF AN INVALID      07554000
     ONE IS FOUND, A MESSAGE IS PRINTED AND THE PROGRAM TERMINATES>>    07556000
   BEGIN                                                                07558000
   SWITCH ENTRYSW := ENTRY2,DONE,ENTRY4,DONE,ENTRY6,ENTRY7,ENTRY8;      07560000
   ENTNW _ ENW;  <<NR. WORDS IN ENTRY>>                                 07562000
   ENTTYPE _ ETYPE;  <<ENTRY TYPE NR.>>                                 07564000
   IF ENTTYPE > 8 THEN  <<ILLEGAL ENTRY?>>                              07566000
      BEGIN                                                             07568000
      PRINTERROR(0,DOUBLE(LOGICAL(ENTFILEADR)),NULL,NULL);     <<00595>>07570000
      QUIT(1)                                                           07572000
      END;                                                              07574000
   ENTNC _ ENC;  <<NR. CHAR'S IN NAME>>                                 07576000
   ENTNAMENW _ ENTNC&LSR(1)+1;  <<NR. WORDS FOR NAME>>                  07578000
   ENTHASH _ HASH(ENAME);  <<GET ENTRY HASH CODE>>                      07580000
   @ENTP1 := @ENTP+ENTNAMENW+2;  <<POINTS TO WORD FOLLOWING NAME>>      07582000
   GO ENTRYSW(ENTTYPE-2);                                               07584000
   GO DONE;                                                             07586000
                                                                        07588000
   <<OUTER BLOCK>>                                                      07590000
                                                                        07592000
   ENTRY2:                                                              07594000
   TOS := @ENTP1(11);  <<FIRST HEADER SET POINTER>>                     07596000
   ENTRY2B:                                                             07598000
   ASSEMBLE(DUP,INCB);                                                  07600000
   @ENTHEADSETP _ TOS;  <<FIRST HEADER SET POINTER>>                    07602000
   ENTHEADADR _ DPS0;  <<FIRST HEADER SET ADR.>>                        07604000
   @ENTHEADP _ TOS+1;  <<INIT. HEADER DESCRIPTOR POINTER>>              07606000
   TOS := @ESAC1;  <<POINTER TO S.A. OF CODE MODULE>>                   07608000
   ENTCODEADR _ DPS0;  <<S.A. OF CODE MODULE>>                          07610000
   ENTNWCODE _ ENWC;  <<NR. WORDS IN CODE MODULE>>                      07612000
   GO DONE;                                                             07614000
                                                                        07616000
   <<PROCEDURE>>                                                        07618000
                                                                        07620000
   ENTRY4:                                                              07622000
   @ENTP2 := @ENTP1(11);  <<POINTER TO PARM. INFO>>                     07624000
   ENTPARMLEN := PARMLEN(EPARMS);  <<PARM. INFO LENGTH>>                07626000
   TOS := @EPARMS+ENTPARMLEN;  <<FIRST HEADER SET POINTER>>             07628000
   GO ENTRY2B;                                                          07630000
                                                                        07632000
   <<INTERUPT PROCEDURE>>                                               07634000
                                                                        07636000
   ENTRY6:                                                              07638000
   TOS _ @ENTP1(6);  <<FIRST HEADER SET POINTER>>                       07640000
   GO ENTRY2B;                                                          07642000
                                                                        07644000
   <<BLOCK DATA>>                                                       07646000
                                                                        07648000
   ENTRY7:                                                              07650000
   @BDP _ @ENTP1(1);  <<INIT. BLOCK DATA POINTER>>                      07652000
   TOS _ @BDP+BDP(1).(4:3)+2;  <<POINTER TO FIRST HEADER SET>>          07654000
   GO ENTRY2B;                                                          07656000
                                                                        07658000
   <<SECONDARY PROCEDURE WITH PARM'S>>                                  07660000
                                                                        07662000
   ENTRY8:                                                              07664000
   @ENTP2 := @ENTP1(2);  <<POINTER TO PARM. INFO>>                      07666000
   ENTPARMLEN := PARMLEN(EPARMS);  <<PARM. INFO LENGTH>>                07668000
                                                                        07670000
   DONE:                                                                07672000
   HEADTYPE _ 0  <<INIT. HEADER TYPE NR.>>                              07674000
   END;                                                                 07676000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETHEADER"       <<00207>>07678000
$ CONTROL SEGMENT = SEG10                                               07680000
PROCEDURE GETHEADER (CODEFLAG,FILEADR);                                 07682000
   <<LOADS THE HEADER OR CODE MODULE HAVING THE SPECIFIED FILE ADDRESS  07684000
     (RELATIVE TO SAI) AND CALCULATES THE HEADER PARAMETERS.  IF THE    07686000
     CODE MODULE FLAG IS SET, THE HEADER TYPE NUMBER IS -1 AND THE      07688000
     NUMBER OF WORDS IN THE HEADER IS NUMBER OF WORDS OF THE CODE       07690000
     MODULE IN THE HEADER BUFFER>>                                      07692000
   VALUE CODEFLAG,FILEADR;                                              07694000
   LOGICAL CODEFLAG;                                                    07696000
   DOUBLE FILEADR;                                                      07698000
   BEGIN                                                                07700000
   INTEGER MAXHEAD' = Q+1;                                              07702000
                                                                        07704000
   SUBROUTINE LOAD;                                                     07706000
      BEGIN                                                             07708000
      PUTINFO;  <<SAVE INFO BUFFER>>                                    07710000
      TOS _ USLFNUM; TOS _ @HEAD; TOS _ MAXHEAD';                       07712000
      TOS _ HEADFILEADR&DLSL(9);                                        07714000
      @HEADP _ TOS&LSR(9)+@HEAD;  <<INIT. HEADER POINTER>>              07716000
      FREADMR''(*,*,*,*);                                               07718000
      INFOADR _ FILEADR&DLSR(7)&DLSL(7)                                 07720000
      END;                                                              07722000
                                                                        07724000
   TOS _ MAXHEAD;                                                       07726000
   HEADFILEADR _ USLSAI+FILEADR;  <<ABSOLUTE FILE ADR.>>                07728000
   TOS _ FILEADR-INFOADR;  <<BUFFER DISP. OF INFO>>                     07730000
   IF < OR DS1 >= DOUBLE(LOGICAL(MAXHEAD')) THEN  <<OUT OF BUFFER?>>    07732000
      LOAD                                                              07734000
   ELSE  <<IN BUFFER>>                                                  07736000
      @HEADP _ TOS+@HEAD;                                               07738000
   IF CODEFLAG THEN  <<CODE MODULE?>>                                   07740000
      BEGIN                                                             07742000
      TOS _ -1;  <<HEADER TYPE NR.>>                                    07744000
      TOS _ MIN3(ENTNWCODE,@HEAD+MAXHEAD'-@HEADP,BIGGESTHEAD);          07746000
      END                                                               07748000
   ELSE  <<HEADER>>                                                     07750000
      BEGIN                                                             07752000
      TOS _ HTYPE;  <<HEADER TYPE NR.>>                                 07754000
      if S0 > 15 then  << Illegal type number? >>              <<02817>>07756000
         BEGIN                                                          07758000
      PRINTERROR(1,HEADFILEADR,NULL,NULL);                     <<00595>>07760000
         QUIT(2)                                                        07762000
         END;                                                           07764000
      TOS _ HNW;  <<NR. WORDS IN HEADER>>                               07766000
      IF @HEADP+S0 > @HEAD+MAXHEAD' THEN LOAD  <<COMPLETELY LOADED?>>   07768000
      END;                                                              07770000
   HEADNW _ TOS;  <<NR. WORDS IN HEADER>>                               07772000
   HEADTYPE _ TOS  <<HEADER TYPE NR.>>                                  07774000
   END;                                                                 07776000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETNEXTDESCRIP"  <<00207>>07778000
$ CONTROL SEGMENT = SEG10                                               07780000
LOGICAL PROCEDURE GETNEXTDESCRIP;                                       07782000
   <<SETS THE HEADER DESCRIPTOR POINTER TO THE NEXT DESCRIPTOR IN THE   07784000
     HEADER SET OF THE CURRENT ENTRY.  RETURNS THE VALUE FALSE IF       07786000
     THERE ARE NO MORE DESCRIPTORS>>                                    07788000
   BEGIN                                                                07790000
   @ENTHEADP _ @ENTHEADP+1;  <<NEXT DESCRIPTOR>>                        07792000
   IF @ENTHEADP >= @ENTP+ENTNW THEN RETURN;  <<NO MORE?>>               07794000
   IF @ENTHEADP = @ENTHEADSETP+ENTHEADSETP.(1:15)+3 THEN                07796000
      BEGIN                                                             07798000
      @ENTHEADSETP _ @ENTHEADP;                                         07800000
      @ENTHEADP _ @ENTHEADP+3                                           07802000
      END;                                                              07804000
   GETNEXTDESCRIP _ TRUE                                                07806000
   END;                                                                 07808000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETNEXTHEADER"   <<00207>>07810000
$ CONTROL SEGMENT = SEG10                                               07812000
LOGICAL PROCEDURE GETNEXTHEADER (CODEFLAG,BITMAP);                      07814000
   <<LOADS THE NEXT HEADER WHOSE TYPE NUMBER IS EQUAL TO ONE SPECIFIED  07816000
     BY BITMAP.  IF CODEFLAG IS SET, WILL SET THE HEADER POINTER TO THE 07818000
     CODE MODULE WHEN IT IS LOADED, AND SETS HEADTYPE TO -1 AND HEADNW  07820000
     TO THE LENGTH OF THE CODE MODULE THAT IS IN CORE.  RETURNS THE     07822000
     VALUE FALSE WHEN THERE ARE NO MORE HEADERS>>                       07824000
   VALUE CODEFLAG,BITMAP;                                               07826000
   LOGICAL CODEFLAG,BITMAP;                                             07828000
   BEGIN                                                                07830000
   XREG _ HEADTYPE;  <<LAST HEADER TYPE NR.>>                           07832000
   IF < THEN  <<CODE MODULE?>>                                          07834000
      BEGIN                                                             07836000
      ENTHEADADR _ ENTHEADADR+DOUBLE(LOGICAL(HEADNW));                  07838000
      ENTNWCODE _ ENTNWCODE-HEADNW;                                     07840000
      IF <> THEN GO L3;  <<MORE CODE?>>                                 07842000
      IF @ENTHEADSETP >= @ENTP+ENTNW THEN RETURN;  <<NO HEADERS?>>      07844000
      GO L2                                                             07846000
      END;                                                              07848000
   IF @ENTHEADSETP >= @ENTP+ENTNW THEN  <<NO HEADER SET?>>              07850000
      BEGIN                                                             07852000
      IF CODEFLAG THEN  <<WANT CODE?>>                                  07854000
         BEGIN                                                          07856000
         ENTHEADADR _ ENTCODEADR;                                       07858000
         GO L3                                                          07860000
         END;                                                           07862000
      RETURN                                                            07864000
      END;                                                              07866000
   L1:                                                                  07868000
   IF @ENTHEADP > @ENTHEADSETP+2 THEN                                   07870000
      ENTHEADADR _ ENTHEADADR+DOUBLE(LOGICAL(EHEADNW));                 07872000
   IF ENTHEADADR = ENTCODEADR THEN  <<HIT CODE MODULE?>>                07874000
      BEGIN                                                             07876000
      IF CODEFLAG THEN  <<SKIP CODE MODULE?>>                           07878000
         BEGIN                                                          07880000
         L3:                                                            07882000
         TOS _ TRUE;                                                    07884000
         GO L4                                                          07886000
         END;                                                           07888000
      ENTHEADADR _ ENTHEADADR+DOUBLE(LOGICAL(ENTNWCODE))                07890000
      END;                                                              07892000
   L2:                                                                  07894000
   @ENTHEADP _ @ENTHEADP+1;  <<NEXT DESCRIPTOR>>                        07896000
   IF @ENTHEADP = @ENTHEADSETP+3+ENTHEADSETP.(1:15) THEN                07898000
      BEGIN                                                             07900000
      IF ENTHEADSETP < 0 THEN RETURN;  <<LAST HEADER SET?>>             07902000
      TOS _ @ENTHEADP;                                                  07904000
      ASSEMBLE(DUP,INCB);                                               07906000
      @ENTHEADSETP _ TOS;                                               07908000
      ENTHEADADR _ DPS0;                                                07910000
      @ENTHEADP _ TOS+1;                                                07912000
      GO L1                                                             07914000
      END;                                                              07916000
   IF NOT BITMAP&CSR(EHEADTYPE) THEN GO L1;  <<SKIP HEADER?>>           07918000
   TOS _ FALSE;                                                         07920000
   L4:                                                                  07922000
   GETHEADER(*,ENTHEADADR);  <<LOAD HEADER OR CODE>>                    07924000
   GETOUT:                                                              07926000
   GETNEXTHEADER _ TRUE                                                 07928000
   END;                                                                 07930000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   BLOCKDATARESET"  <<00207>>07932000
$ CONTROL SEGMENT = SEG10                                               07934000
LOGICAL PROCEDURE BLOCKDATARESET;                                       07936000
   <<CHECKS TO SEE IF THERE IS MORE THAN ONE SET OF HEADERS IN          07938000
     AN ENTRY (AS IS THE CASE WITH THE BLOCK DATA ENTRY).  IF SO        07940000
     THE VALUE TRUE IS RETURNED, THE NUMBER OF HEADERS IN THE           07942000
     NEW SET IS CALCULATED AND THE BLOCK DATA POINTER (BDP) AND         07944000
     THE HEADER POINTER (ENTHEADP) ARE RESET.  OTHERWISE THE            07946000
     VALUE FALSE IS RETURNED>>                                          07948000
   BEGIN                                                                07950000
   IF @ENTHEADP-@ENTP < ENTNW THEN                                      07952000
      BEGIN                                                             07954000
      @BDP _ @ENTHEADP;  <<RE-INIT. COMMON ARRAY POINTER>>              07956000
      TOS _ @BDP+BDP(1).(4:3)+2;                                        07958000
      ASSEMBLE(DUP,INCB);                                               07960000
      @ENTHEADSETP _ TOS;  <<RE-INIT. HEADER SET POINTER>>              07962000
      ENTHEADADR _ DPS0;  <<S.A. OF FIRST HEADER IN SET>>               07964000
      @ENTHEADP _ TOS+1;  <<RE-INIT. HEADER DESCRIPTOR POINTER>>        07966000
      BLOCKDATARESET _ TRUE                                             07968000
      END                                                               07970000
   END;                                                                 07972000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   SEARCHUSL"       <<00207>>07974000
$CONTROL SEGMENT = SEG10                                       <<03026>>07978000
LOGICAL PROCEDURE SEARCHUSL(NAME,INDEX,TYPE,MODE');            <<03026>>07980000
  << SEARCHES THE USL FILE AND LOADS THE ENTRY HAVING THE   >> <<03026>>07982000
  << NAME NAME, INDEX INDEX AND ENTRY TYPE CORRESPONDING    >> <<03026>>07984000
  << TO TYPE:                                               >> <<03026>>07986000
  <<    TYPE < 0    ANY ENTRY TYPE                          >> <<03026>>07988000
  <<    TYPE = 0    SEGMENT ENTRY TYPE                      >> <<03026>>07990000
  <<    TYPE > 0    NON-SEGMENT ENTRY TYPE                  >> <<03026>>07992000
  << ASSUMPTIONS:                                           >> <<03026>>07994000
  <<    LEFTMOST BYTE OF NAME(0) CONTAINS CHARACTER COUNT   >> <<03026>>07996000
  <<    OPTIONAL MODE' SPECIFIED --- SEARCH FOR INACTIVE    >> <<03026>>07998000
  <<    MODE' NOT SPECIFIED --- SEARCH FOE ACTIVE ENTRY     >> <<03026>>08000000
  <<    INDEX = 0 MEANS FIRST OCCURRENCE (ACTIVE / INACTIVE)>> <<03026>>08002000
  <<    INDEX > 0 MEANS THE I-TH OCCURRENCE                 >> <<03026>>08004000
  << NOTE THAT INDEX IS IGNORED FOE SEGMENT ENTRY SEARCHES  >> <<03026>>08006000
                                                               <<03026>>08008000
   VALUE INDEX,TYPE,MODE';                                     <<03026>>08010000
   INTEGER INDEX,TYPE;                                         <<03026>>08012000
   LOGICAL MODE';                                              <<03026>>08014000
   INTEGER ARRAY NAME;                                         <<03026>>08016000
                                                               <<03026>>08018000
   OPTION VARIABLE;                                            <<03026>>08020000
                                                               <<03026>>08022000
   BEGIN                                                       <<03026>>08024000
      INTEGER MASK=Q-4;                                        <<03026>>08026000
      INTEGER ADR;                                             <<03026>>08028000
                                                               <<03026>>08030000
      ADR:=USLREC0(USLFHI+HASH(NAME));                         <<03026>>08032000
      WHILE ADR > 0 DO                                         <<03026>>08034000
        BEGIN                                                  <<03026>>08036000
          GETENTRY(ADR);                                       <<03026>>08038000
          IF NAME.(4:4)=ENTNC THEN                             <<03026>>08040000
            BEGIN                                              <<03026>>08042000
              TOS:=@NAME&LSL(1)+1;                             <<03026>>08044000
              TOS:=@ENAME&LSL(1)+1;                            <<03026>>08046000
              IF * = *,(ENTNC) THEN                            <<03026>>08048000
                 IF TYPE < 0 OR                                <<03026>>08050000
                    TYPE = 0 AND SEGMENTNAME OR                <<03026>>08052000
                    TYPE > 0 AND NOT SEGMENTNAME THEN          <<03026>>08054000
                    BEGIN                                      <<03026>>08056000
                      IF INTEGER(MASK.(15:1))=0 THEN           <<03026>>08058000
                        IF SEGMENTNAME OR                      <<03026>>08060000
                           INDEX <= 0 AND ACTIVE OR            <<03026>>08062000
                           INDEX = 1 THEN                      <<03026>>08064000
                           BEGIN                               <<03026>>08066000
                             FOUND: SEARCHUSL:=TRUE;           <<03026>>08068000
                             RETURN                            <<03026>>08070000
                           END                                 <<03026>>08072000
                        ELSE  INDEX:=INDEX-1                   <<03026>>08074000
                      ELSE                                     <<03026>>08076000
                        IF SEGMENTNAME OR                      <<03026>>08078000
                           INDEX <= 0 AND INACTIVE OR          <<03026>>08080000
                           INDEX = 1 THEN                      <<03026>>08082000
                              GO FOUND                         <<03026>>08084000
                        ELSE  INDEX:=INDEX-1                   <<03026>>08086000
                    END;                                       <<03026>>08088000
           END;                                                <<03026>>08090000
        ADR:=EHL;                                              <<03026>>08092000
     END;                                                      <<03026>>08094000
   END;                                                        <<03026>>08096000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETFATHER"       <<00207>>08098000
$ CONTROL SEGMENT = SEG10                                               08100000
PROCEDURE GETFATHER;                                                    08102000
   <<LOADS THE FATHER ENTRY OF THE ENTRY IN CORE.  NOTHING IS DONE      08104000
     IF THE RELATIONSHIP IS UNDEFINED OR THE FATHER DOES NOT            08106000
     EXIST.  NOTE THAT A KLUGE HAS BEEN ADDED FOR THE REMOVEFAMILY      08108000
     PROCEDURE: ENTRY TYPE 0 HAS A FATHER RELATION DEFINED>>            08110000
   BEGIN                                                                08112000
   IF BITMAP4&CSR(ENTTYPE) THEN                                         08114000
      BEGIN                                                             08116000
      WHILE EBL > 0 DO GETENTRY(EBL);                                   08118000
      GETENTRY(EBL)                                                     08120000
      END                                                               08122000
   END;                                                                 08124000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETBROTHER"      <<00207>>08126000
$ CONTROL SEGMENT = SEG10                                               08128000
PROCEDURE GETBROTHER;                                                   08130000
   <<LOADS THE BROTHER ENTRY OF THE ENTRY IN CORE.  NOTHING IS DONE     08132000
     IF THE RELATIONSHIP IS UNDEFINED OR THE BROTHER DOES NOT           08134000
     EXIST>>                                                            08136000
   BEGIN                                                                08138000
   TOS _ EBL;                                                           08140000
   IF > THEN GETENTRY(*)                                                08142000
   END;                                                                 08144000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETSON"          <<00207>>08146000
$ CONTROL SEGMENT = SEG10                                               08148000
PROCEDURE GETSON;                                                       08150000
   <<LOADS THE SON ENTRY OF THE ENTRY IN CORE.  NOTHING IS DONE         08152000
     IF THE RELATIONSHIP IS UNDEFINED OR THE SON DOES NOT EXIST>>       08154000
   BEGIN                                                                08156000
   IF BITMAP3&CSR(ENTTYPE) THEN  <<RELATIONSHIP DEFINED?>>              08158000
      BEGIN                                                             08160000
      TOS _ ESL;                                                        08162000
      IF > THEN GETENTRY(*)                                             08164000
      END                                                               08166000
   END;                                                                 08168000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETENTRY"        <<00207>>08170000
$ CONTROL SEGMENT = SEG10                                               08172000
PROCEDURE GETSEGENTRY;                                                  08174000
   <<LOADS THE SEGMENT ENTRY FOR THE PROGRAM UNIT ENTRY CURRENTLY       08176000
     IN CORE.  IF THE ENTRY IN CORE IS A SEGMENT, BLOCK DATA OR         08178000
     INTERUPT PROCEDURE ENTRY NOTHING IS DONE>>                         08180000
   BEGIN                                                                08182000
   WHILE NOT SEGMENTNAME DO GETFATHER                                   08184000
   END;                                                                 08186000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETFAMILY"       <<00207>>08188000
$ CONTROL SEGMENT = SEG10                                               08190000
LOGICAL PROCEDURE GETFAMILY (FATHERADR);                                08192000
   <<LOADS THE SON OF THE ENTRY IN CORE.  IF NO SON EXISTS, LOADS       08194000
     THE BROTHER OF THE ENTRY IN CORE.  IF NO BROTHER EXISTS,           08196000
     LOADS THE BROTHER OF THE FATHER OF THE ENTRY IN CORE.  IF          08198000
     THE ENTRY LOADED IS THE SAME AS FATHERADR, THE VALUE FALSE         08200000
     IS RETURNED; OTHERWISE THE VALUE TRUE IS RETURNED>>                08202000
   VALUE FATHERADR; INTEGER FATHERADR;                                  08204000
   BEGIN                                                                08206000
   INTEGER ADR = Q+1;                                                   08208000
   TOS _ ENTFILEADR;  <<SAVE CURRENT ENTRY ADDRESS>>                    08210000
   GETSON;                                                              08212000
   IF FATHERADR = ENTFILEADR THEN RETURN;                               08214000
   IF ADR = ENTFILEADR THEN                                             08216000
      BEGIN                                                             08218000
      L1: GETBROTHER;                                                   08220000
      IF FATHERADR = ENTFILEADR THEN RETURN;                            08222000
      IF ADR = ENTFILEADR THEN                                          08224000
         BEGIN                                                          08226000
         GETFATHER;                                                     08228000
         ADR _ ENTFILEADR;  <<SAVE ADDRESS>>                            08230000
         IF FATHERADR = ENTFILEADR THEN RETURN;                         08232000
         GO L1                                                          08234000
         END                                                            08236000
      END;                                                              08238000
   GETFAMILY _ TRUE                                                     08240000
   END;                                                                 08242000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   GETACTIVEFAMILY" <<02815>>08244000
$ CONTROL SEGMENT = SEG10                                      <<02815>>08246000
LOGICAL PROCEDURE GETACTIVEFAMILY (FATHERADR);                 <<02815>>08248000
     COMMENT                                                   <<02815>>08250000
     LOADS ONLY AN ACTIVE FAMILY MEMBER INTO CORE.             <<02815>>08252000
     LOADS THE SON OF THE ENTRY IN CORE.  IF NO SON EXISTS, LOA<<02815>>08254000
     THE BROTHER OF THE ENTRY IN CORE.  IF NO BROTHER EXISTS,  <<02815>>08256000
     LOADS THE BROTHER OF THE FATHER OF THE ENTRY IN CORE.  IF <<02815>>08258000
     THE ENTRY LOADED IS THE SAME AS FATHERADR, THE VALUE FALSE<<02815>>08260000
     IS RETURNED, OTHERWISE THE VALUE TRUE IS RETURNED;        <<02815>>08262000
   VALUE FATHERADR; INTEGER FATHERADR;                         <<02815>>08264000
   BEGIN                                                       <<02815>>08266000
   INTEGER ADR = Q+1;                                          <<02815>>08268000
   TOS _ ENTFILEADR;  <<SAVE CURRENT ENTRY ADDRESS>>           <<02815>>08270000
   IF ACTIVE THEN GETSON;                                      <<02815>>08272000
   IF FATHERADR = ENTFILEADR THEN RETURN;                      <<02815>>08274000
   IF ADR = ENTFILEADR THEN                                    <<02815>>08276000
      BEGIN                                                    <<02815>>08278000
      L1: GETBROTHER;                                          <<02815>>08280000
      IF FATHERADR = ENTFILEADR THEN RETURN;                   <<02815>>08282000
      IF ADR = ENTFILEADR THEN                                 <<02815>>08284000
         BEGIN                                                 <<02815>>08286000
         GETFATHER;                                            <<02815>>08288000
         ADR _ ENTFILEADR;  <<SAVE ADDRESS>>                   <<02815>>08290000
         IF FATHERADR = ENTFILEADR THEN RETURN;                <<02815>>08292000
         GO L1                                                 <<02815>>08294000
         END                                                   <<02815>>08296000
      END;                                                     <<02815>>08298000
   IF INACTIVE THEN                                            <<02815>>08300000
      BEGIN                                                    <<02815>>08302000
      ADR _ ENTFILEADR;                                        <<02815>>08304000
      GO L1;                                                   <<02815>>08306000
      END;                                                     <<02815>>08308000
   GETACTIVEFAMILY _ TRUE                                      <<02815>>08310000
   END;                                                        <<02815>>08312000
$ CONTROL SEGMENT = SEG13                                               08314000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   ADDHASHLIST"     <<00207>>08316000
PROCEDURE ADDHASHLIST;                                                  08318000
   <<LINKS THE CURRENT ENTRY INTO THE HASH TABLE.  NOTE THAT            08320000
     THE STATE WORD FLAGS ARE NOT CHANGED>>                             08322000
   BEGIN                                                                08324000
   EHL _ USLREC0(USLFHI+ENTHASH);  <<MOVE OLD LINK>>                    08326000
   USLREC0(USLFHI+ENTHASH) _ ENTFILEADR  <<INSERT NEW LINK>>            08328000
   END;                                                                 08330000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   ADDENTRY"        <<00207>>08332000
$ CONTROL SEGMENT = SEG13                                               08334000
PROCEDURE ADDENTRY (SIZE);                                              08336000
   <<ADJUSTS THE PARAMETERS IN RECORD 0 FOR THE ADDITION OF AN ENTRY.   08338000
     A POSITIVE SIZE INDICATES THAT AN ENTRY IS BEING ADDED; A          08340000
     NEGATIVE SIZE INDICATES THAT AN ENTRY IS BEING DELETED.  NOTE THAT 08342000
     THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>      08344000
   VALUE SIZE;                                                          08346000
   INTEGER SIZE;                                                        08348000
   BEGIN                                                                08350000
   IF SIZE > USLADL THEN  <<NO ROOM AVAILABLE?>>                        08352000
      BEGIN                                                             08354000
      MOVEINFO((SIZE+127)&LSR(7));  <<MOVE INFO BLOCK>>                 08356000
      IF < THEN  <<ERROR?>>                                             08358000
         BEGIN                                                          08360000
         TOS := CCL;  <<ERROR CONDITION CODE>>                          08362000
         GO GETOUT                                                      08364000
         END                                                            08366000
      END;                                                              08368000
   USLNE _ USLNE + (IF SIZE > 0 THEN 1 ELSE -1);                        08370000
   USLDL _ USLDL+SIZE;                                                  08372000
   USLSAAD _ USLSAAD+SIZE;                                              08374000
   USLADL _ USLADL-SIZE;                                                08376000
   USLREC0MOD := TRUE;  <<SET MODIFIED FLAG>>                           08378000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08380000
                                                                        08382000
   GETOUT:                                                              08384000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            08386000
   END;                                                                 08388000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   ADDHEADER"       <<00207>>08390000
$ CONTROL SEGMENT = SEG13                                               08392000
PROCEDURE ADDHEADER (SIZE);                                             08394000
   <<ADJUSTS THE PARAMETERS IN RECORD 0 FOR THE ADDITION OF A HEADER    08396000
     OR CODE MODULE.  A POSITIVE SIZE INDICATES THAT A HEADER IS        08398000
     BEING ADDED; A NEGATIVE SIZE INDICATES THAT AN HEADER IS BEING     08400000
     DELETED.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO      08402000
     INDICATE AN ERROR>>                                                08404000
   VALUE SIZE;                                                          08406000
   INTEGER SIZE;                                                        08408000
   BEGIN                                                                08410000
   DOUBLE DSIZE = Q+1;                                                  08412000
                                                                        08414000
   TOS := DOUBLE(SIZE);                                                 08416000
   IF DSIZE > USLAIL THEN  <<NO ROOM AVAILABLE?>>                       08418000
      BEGIN                                                             08420000
      MOVEINFO(-((SIZE+127)&LSR(7)));  <<MOVE INFO BLOCK>>              08422000
      IF < THEN  <<ERROR?>>                                             08424000
         BEGIN                                                          08426000
         TOS := CCL;  <<ERROR CONDITION CODE>>                          08428000
         GO GETOUT                                                      08430000
         END                                                            08432000
      END;                                                              08434000
   USLIL := USLIL+DSIZE;                                                08436000
   USLSAAI := USLSAAI+DSIZE;                                            08438000
   USLAIL := USLAIL-DSIZE;                                              08440000
   USLREC0MOD := TRUE;  <<SET MODIFIED FLAG>>                           08442000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08444000
                                                                        08446000
   GETOUT:                                                              08448000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            08450000
   END;                                                                 08452000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   MOVEINFO"        <<00207>>08454000
$ CONTROL SEGMENT = SEG13                                               08456000
PROCEDURE MOVEINFO (NRRECORDS);                                         08458000
   <<INTERFACE TO ADJUSTUSLF PROCEDURE: MOVES THE INFO BLOCK UP OR DOWN 08460000
     IN THE USL FILE.  NOTE THAT THE FILE LENGTH IS NOT CHANGED.  NOTE  08462000
     THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>> 08464000
   VALUE NRRECORDS;                                                     08466000
   INTEGER NRRECORDS;                                                   08468000
   BEGIN                                                                08470000
   IF USLREC0MOD THEN  <<RECORD 0 MODIFIED?>>                           08472000
      BEGIN                                                             08474000
      FWRITEDIR'(USLFNUM,USLREC0,0);  <<SAVE RECORD 0>>                 08476000
      USLREC0MOD := FALSE  <<CLEAR FLAG>>                               08478000
      END;                                                              08480000
   PUTINFO;  <<SAVE INFO BUFFER>>                                       08482000
   TOS := ADJUSTUSLF(USLFNUM,NRRECORDS);  <<MOVE INFO>>                 08484000
   IF < THEN  <<ERROR?>>                                                08486000
      BEGIN                                                             08488000
      XREG := S0;  <<ERROR NR.>>                                        08490000
      ASSEMBLE(DZRO,INCA);                                              08492000
      IF (TOS <= XREG <= TOS) THEN FERROR(USLFNUM);  <<I/O ERROR?>>     08494000
      ERROR(TOS-2);  <<INSUFFICIENT SPACE ERROR>>                       08496000
      TOS := CCL;  <<ERROR CONDITION CODE>>                             08498000
      GO GETOUT                                                         08500000
      END;                                                              08502000
   FREADDIR'(USLFNUM,USLREC0,0);  <<RELOAD RECORD 0>>                   08504000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08506000
                                                                        08508000
   GETOUT:                                                              08510000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            08512000
   END;                                                                 08514000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   ADDTODIRECTORY"  <<00207>>08516000
$ CONTROL SEGMENT = SEG13                                               08518000
PROCEDURE ADDTODIRECTORY (SIZE);                                        08520000
   <<CHECKS THE USL DIRECTORY TO SEE IF THERE IS ROOM FOR A NEW         08522000
     ENTRY OF LENGTH SIZE.  IF THERE IS ROOM, AN "EQUAL" CONDITION      08524000
     CODE IS RETURNED AND THE BUFFERS ARE ADJUSTED FOR THE NEW          08526000
     ENTRY: THE DIRECTORY IS REMOVED IF THE NEW ENTRY WILL              08528000
     OVERFLOW THE BUFFER AND THE ENTRY POINTER (ENTP) IS SET TO         08530000
     THE NEW ENTRY.  IF THERE IS NOT ENOUGH ROOM, A "LESS THAN"         08532000
     CONDITION CODE IS RETURNED AND THE BUFFERS ARE RESTORED TO         08534000
     THEIR ORIGIONAL STATE>>                                            08536000
   VALUE SIZE;                                                          08538000
   INTEGER SIZE;                                                        08540000
   BEGIN                                                                08542000
   DEFINE DIRENDREC = (RECD & LSL (7))-128 #;                  <<C0.06>>08544000
   INTEGER RECD = Q+1;  <<REC. NR.>>                                    08546000
   INTEGER DISP = Q+2;  <<REC. DISP.>>                                  08548000
                                                                        08550000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           08552000
                                                                        08554000
   TOS := USLSAAD.(0:9);                                                08556000
   TOS := USLSAAD.(9:7);                                                08558000
                                                                        08560000
   ADDENTRY(SIZE);  <<UPDATE RECORD 0>>                                 08562000
   IF < THEN GO NFG;  <<ERROR?>>                                        08564000
   IF USLDIRINCORE THEN  <<DIRECTORY IN CORE?>>                         08566000
      IF USLDL > MAXDIR THEN  <<DIR. BUF. OVERFLOW?>>                   08568000
         BEGIN                                                          08570000
         PUTDIR;  <<SAVE DIRECTORY BUFFER>>                             08572000
         USLDIRINCORE := FALSE;  <<CLEAR FLAG>>                         08574000
         TOS := @DIR; TOS := @DIR + DIRENDREC; TOS := DISP;    <<C0.06>>08576000
<<MOVE LAST CHUNK OF DIRECTORY (AT REC BOUNDARY)>>             <<C0.06>>08578000
         ASSEMBLE(MOVE 3);                                              08580000
         DIRADR := RECD&LSL(7);                                         08582000
         TOS := DISP                                                    08584000
         END                                                            08586000
      ELSE                                                              08588000
         TOS := USLSAAD-SIZE-128                                        08590000
   ELSE  <<ENTRY IN CORE>>                                              08592000
      IF USLSAAD-DIRADR > MAXDIR THEN  <<DIR. BUF. OVERFLOW?>>          08594000
         BEGIN                                                          08596000
         PUTDIR;  <<SAVE DIRECTORY BUFFER>>                             08598000
         FREADMR''(USLFNUM,DIR,DISP,RECD);  <<PRIME BUFFER>>            08600000
         DIRADR := RECD&LSL(7);                                         08602000
         TOS := DISP                                                    08604000
         END                                                            08606000
      ELSE                                                              08608000
         TOS := USLSAAD-SIZE-DIRADR;                                    08610000
   @ENTP := TOS+@DIR;  <<ENTRY POINTER>>                                08612000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08614000
   GO GETOUT;                                                           08616000
                                                                        08618000
   NFG:                                                                 08620000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                08622000
                                                                        08624000
   GETOUT:                                                              08626000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            08628000
   END;                                                                 08630000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   ADDTOINFO"       <<00207>>08632000
$ CONTROL SEGMENT = SEG13                                               08634000
PROCEDURE ADDTOINFO (SIZE);                                             08636000
   <<ADJUSTS THE BUFFERS FOR THE ADDITION OF A NEW HEADER OR CODE       08638000
     MODULE.  RECORD 0 IS UPDATED AND THE HEADER POINTER IS SET TO      08640000
     THE SPACE FOR THE NEW HEADER.  NOTE THAT THIS PROCEDURE USES       08642000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          08644000
   VALUE SIZE;                                                          08646000
   INTEGER SIZE;                                                        08648000
   BEGIN                                                                08650000
   DEFINE HEADRENDREC = (RECD & LSL (7)) #;                    <<00.06>>08652000
   INTEGER RECD = Q+1;                                                  08654000
   INTEGER DISP = Q+2;                                                  08656000
                                                                        08658000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           08660000
                                                                        08662000
   TOS := USLIL;                                                        08664000
   TOS := TOS&DLSL(9);                                                  08666000
   TOS := TOS&LSR(9);                                                   08668000
                                                                        08670000
   ADDHEADER(SIZE);                                                     08672000
   IF < THEN GO NFG;  <<ERROR?>>                                        08674000
   IF USLINFOINCORE THEN  <<INFO IN CORE?>>                             08676000
      IF USLIL > DOUBLE (LOGICAL (MAXHEAD)) THEN                        08678000
         BEGIN                                                          08680000
         PUTINFO;  <<SAVE INFO>>                                        08682000
         USLINFOINCORE := FALSE;  <<CLEAR FLAG>>                        08684000
         TOS := @HEAD; TOS := @HEAD+HEADRENDREC; TOS := DISP;  <<00.06>>08686000
         ASSEMBLE(MOVE 3);  <<PRIME BUFFER>>                            08688000
         INFOADR := DOUBLE(LOGICAL(RECD&LSL(7)));                       08690000
         TOS := DISP                                                    08692000
         END                                                            08694000
      ELSE  <<NO OVERFLOW>>                                             08696000
         TOS := USLIL2-SIZE                                             08698000
   ELSE  <<HEADER OR CODE MODULE IN CORE>>                              08700000
      BEGIN                                                             08702000
      <<TEST FOR INFO BUFFER OVERFLOW>>                                 08704000
      IF DOUBLE (LOGICAL (MAXHEAD)) < (USLIL-INFOADR) THEN              08706000
         BEGIN                                                          08708000
         PUTINFO;  <<SAVE INFO>>                                        08710000
         TOS := USLFNUM;                                                08712000
         TOS := @HEAD;                                                  08714000
         TOS := DISP;                                                   08716000
         TOS := USLSAI&DLSR(7); DELB;                                   08718000
         FREADMR''(*,*,*,TOS+RECD);  <<PRIME BUFFER>>                   08720000
         INFOADR:=DOUBLE (LOGICAL (RECD)) & DLSL (7);          <<C0.02>>08722000
         TOS := DISP                                                    08724000
         END                                                            08726000
      ELSE  <<NO BUFFER OVERFLOW>>                                      08728000
         BEGIN                                                          08730000
         TOS := USLIL-INFOADR-DOUBLE(SIZE); DELB                        08732000
         END                                                            08734000
      END;                                                              08736000
   @HEADP := TOS+@HEAD;  <<INIT. HEADER POINTER>>                       08738000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08740000
   GO GETOUT;                                                           08742000
                                                                        08744000
   NFG:                                                                 08746000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                08748000
                                                                        08750000
   GETOUT:                                                              08752000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            08754000
   END;                                                                 08756000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   CREATESEGENTRY"  <<00207>>08758000
$ CONTROL SEGMENT = SEG13                                               08760000
PROCEDURE CREATESEGENTRY (NAME);                                        08762000
   <<CREATES A SEGMENT ENTRY HAVING THE NAME SPECIFIED.  THIS           08764000
     ENTRY BECOMES THE CURRENT ENTRY IN CORE AND IS COMPLETELY          08766000
     LINKED IN THE USL.  NOTE THAT THIS PROCEDURE USES THE CONDITION    08768000
     CODE TO INDICATE AN ERROR>>                                        08770000
   INTEGER ARRAY NAME;                                                  08772000
   BEGIN                                                                08774000
   INTEGER SIZE = Q+1;  <<NR. WORDS IN SEGMENT ENTRY>>                  08776000
   TOS := NAME.(4:3)+5;                                                 08778000
   ADDTODIRECTORY(SIZE);                                                08780000
   IF < THEN GO NFG;  <<ERROR?>>                                        08782000
   ENTFILEADR := USLSAAD-SIZE;  <<ENTRY FILE ADR.>>                     08784000
   TOS := SIZE&LSL(5); SETBIT15; EDESCRIP := TOS;  <<DESCRIP. WORD>>    08786000
   MOVE ENAME := NAME,(SIZE-4);  <<ENTRY NAME>>                         08788000
   USLENTRYPARMS;  <<GET ENTRY PARM'S>>                                 08790000
   ADDHASHLIST;  <<ADD ENTRY TO HASH LISTS>>                            08792000
   TOS := USLSL;  <<BROTHER LINK>>                                      08794000
   TOS := ENTFILEADR; SETBIT0;  <<SON LINK>>                            08796000
   ELINKS := TOS;                                                       08798000
   USLSL := ENTFILEADR;  <<S.A. OF SEGMENT LIST>>                       08800000
   USLREC0MOD := TRUE;  <<SET MODIFIED FLAG>>                           08802000
   USLDIRMOD := TRUE;  <<SET MODIFIED FLAG>>                            08804000
   TOS := CCE;  <<OK CONDITION CODE>>                                   08806000
   GO GETOUT;                                                           08808000
                                                                        08810000
   NFG:                                                                 08812000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                08814000
                                                                        08816000
   GETOUT:                                                              08818000
   CONDCODE := TOS  <<STORE CONDITION COCE>>                            08820000
   END;                                                                 08822000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   SETACTIVITY"     <<00207>>08824000
$ CONTROL SEGMENT = SEG1                                                08826000
PROCEDURE SETACTIVITY (ADFLAG);                                         08828000
   <<ADJUSTS THE ACTIVITY BIT OF THE FAMILY OF ENTRIES WHOSE ROOT       08830000
     IS IN CORE>>                                                       08832000
   VALUE ADFLAG; LOGICAL ADFLAG;                                        08834000
   BEGIN                                                                08836000
                                                                        08838000
   SUBROUTINE FIXBIT;                                                   08840000
      <<ADJUSTS THE ACTIVITY BIT IN THE CURRENT ENTRY>>                 08842000
      BEGIN                                                             08844000
      EACTIVITYBIT := ADFLAG;  <<RESET ACTIVITY BIT>>                   08846000
      USLDIRMOD _ TRUE  <<SET MODIFIED FLAG>>                           08848000
      END;                                                              08850000
                                                                        08852000
   FIXBIT;  <<ADJUST ENTRY ACTIVITY BIT>>                               08854000
   IF CLASS <> ENTRYCLASS THEN  <<ADJ. ACTIVITY OF SONS?>>              08856000
      BEGIN                                                             08858000
      TOS _ ENTFILEADR;  <<SAVE ENTRY ADDRESS>>                         08860000
      WHILE GETFAMILY(S0) DO FIXBIT                                     08862000
      END;                                                              08864000
   IF NOT ADFLAG AND BITMAP10&CSR(ENTTYPE) THEN  <<ACT. SEG.?>>         08866000
      BEGIN                                                             08868000
      GETSEGENTRY;  <<GET SEGMENT ENTRY>>                               08870000
      FIXBIT                                                            08872000
      END                                                               08874000
   END;                                                                 08876000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   LISTUSL'"        <<00207>>08878000
$ CONTROL SEGMENT = SEG13                                               08880000
PROCEDURE LISTUSL';                                                     08882000
   <<LISTS THE CONTENTS OF THE CURRENT USL FILE ON THE LIST DEVICE>>    08884000
   BEGIN                                                                08886000
   ARRAY ABBREV (2:8)=PB := "OB","SO","P ","SP","I0","BD","CP";         08888000
   BYTE ARRAY B0 (0:8)=PB _ "USL FILE ";                                08890000
   BYTE ARRAY B1 (0:11)=PB _ "BLOCK DATA'S";                            08892000
   BYTE ARRAY B2 (0:19)=PB := "INTERRUPT PROCEDURES";                   08894000
   BYTE ARRAY B3 (0:8)=PB _ "FILE SIZE";                                08896000
   BYTE ARRAY B4 (0:8)=PB _ "DIR. USED";                                08898000
   BYTE ARRAY B5 (0:8)=PB _ "INFO USED";                                08900000
   BYTE ARRAY B6 (0:9)=PB _ "DIR. GARB.";                               08902000
   BYTE ARRAY B7 (0:9)=PB _ "INFO GARB.";                               08904000
   BYTE ARRAY B8 (0:10)=PB _ "DIR. AVAIL.";                             08906000
   BYTE ARRAY B9 (0:10)=PB _ "INFO AVAIL.";                             08908000
                                                                        08910000
   SUBROUTINE DESCRIP;                                                  08912000
      <<PRINTS A ONE LINE DESCRIPTION OF THE CURRENT PROGRAM UNIT OR    08914000
        ENTRY POINT>>                                                   08916000
      BEGIN                                                             08918000
      IF CTLY THEN ASSEMBLE( EXIT 0 ); <<CHECK FOR CONTROL Y>> <<00.DM>>08920000
      TOS _ @BLINE(3); TOS _ @ENAME&LSL(1)+1;                           08922000
      MOVE * _ *,(ENTNC);  <<ENTRY NAME>>                               08924000
      IF BITMAP5&CSR(ENTTYPE) THEN  <<CODE MODULE?>>                    08926000
         BEGIN                                                          08928000
         NTOA(ENWC,8,BLINE(23));  <<NR. WORDS OF CODE>>                 08930000
         BLINE(33) _ IF PRIVLEDGED THEN "P" ELSE "N"                    08932000
         END;                                                           08934000
      LINE(13) _ ABBREV(ENTTYPE);  <<ENTRY TYPE ABBREVIATION>>          08936000
      IF INTERUPTPROC THEN BLINE(27) _ INTEGER(BLINE(27))+EIT;          08938000
      BLINE(29) _ IF INACTIVE THEN "I" ELSE "A";  <<ACTIVITY>>          08940000
      IF BITMAP10&CSR(ENTTYPE) THEN  <<CALLABILITY>>                    08942000
         BLINE(31) _ IF CALLABLE' THEN "U" ELSE "C";                    08944000
      IF NOT BITMAP1&CSR(ENTTYPE) THEN  <<HIDDENNESS>>                  08946000
         BLINE(35) _ IF HIDDEN THEN "H" ELSE "R";                       08948000
      PRINTLINE                                                         08950000
      END;                                                              08952000
                                                                        08954000
   IF USLREC0MOD THEN  <<RECORD 0 MODIFIED?>>                  <<00294>>08956000
      BEGIN                                                    <<00294>>08958000
      FWRITEDIR'(USLFNUM,USLREC0,0);  <<SAVE RECORD 0>>        <<00294>>08960000
      USLREC0MOD _ FALSE  <<CLEAR FLAG>>                       <<00294>>08962000
      END;                                                     <<00294>>08964000
   PUTDIR;  <<SAVE DIRECTORY BUFFER>>                          <<00294>>08966000
   PUTINFO;  <<SAVE INFO BUFFER>>                              <<00294>>08968000
   FCONTROL(INFNUM,ENABLE'CTLY,I);                             <<00.DM>>08970000
   CTLY := FALSE;                                              <<00.DM>>08972000
   BLANKLINE;                                                           08974000
                                                               <<00592>>08976000
   IF SEGNAME.(4:4) <> 0 THEN  <<LIST JUST ONE SEGMENT?>>      <<00592>>08980000
      BEGIN                                                    <<00592>>08982000
      IF SEARCHUSL(SEGNAME,0,USLSEG) THEN                      <<00592>>08984000
         BEGIN                                                 <<00592>>08986000
         TOS := @ENAME&LSL(1)+1;                               <<00592>>08988000
         MOVE BLINE := *,(ENTNC);                              <<00592>>08990000
         PRINTLINE;                                            <<00592>>08992000
         TOS := ENTFILEADR;                                    <<00592>>08994000
         WHILE GETFAMILY(S0) DO DESCRIP;                       <<00592>>08996000
         END                                                   <<00592>>08998000
      ELSE                                                     <<00592>>09000000
         ERROR(93);                                            <<00592>>09002000
      RETURN;                                                  <<00592>>09004000
      END;                                                     <<00592>>09006000
                                                               <<00592>>09008000
   TOS _ USLFNUM;                                                       09010000
   MOVE BLINE _ B0,(9),2;                                               09012000
   FGETINFO(*,*);  <<INSERT USL FILE NAME>>                             09014000
   PRINTLINE;                                                           09016000
   BLANKLINE;                                                           09018000
                                                                        09020000
   <<* * * LIST SEGMENTS AND ENTRY POINTS * * *>>                       09022000
                                                                        09024000
   TOS _ USLSL;  <<S.A. SEGMENT LIST>>                                  09026000
   IF <> THEN                                                           09028000
      BEGIN                                                             09030000
      DO BEGIN                                                          09032000
         GETENTRY(S0);  <<GET SEGMENT ENTRY>>                           09034000
         TOS _ @BLINE; TOS _ @ENAME&LSL(1)+1;                           09036000
         MOVE * _ *,(ENTNC);  <<SEGMENT NAME>>                          09038000
         PRINTLINE;                                                     09040000
         WHILE GETFAMILY(S0) DO DESCRIP;                                09042000
         DEL;                                                           09044000
         TOS _ EBL;  <<NEXT SEGMENT ADR.>>                              09046000
         IF <> THEN GETBROTHER                                          09048000
         END UNTIL =;                                                   09050000
      BLANKLINE                                                         09052000
      END;                                                              09054000
                                                                        09056000
   <<* * * LIST BLOCK DATA PROGRAM UNITS * * *>>                        09058000
                                                                        09060000
   TOS _ USLBDL;  <<S.A. BLOCK DATA LIST>>                              09062000
   IF <> THEN                                                           09064000
      BEGIN                                                             09066000
      MOVE BLINE _ B1,(12);                                             09068000
      PRINTLINE;                                                        09070000
      DO BEGIN                                                          09072000
         GETENTRY(*);  <<GET BLOCK DATA ENTRY>>                         09074000
         DESCRIP;                                                       09076000
         TOS _ EBL  <<NEXT BLOCK DATA ENTRY>>                           09078000
         END UNTIL =;                                                   09080000
      BLANKLINE                                                         09082000
      END;                                                              09084000
                                                                        09086000
   <<* * * LIST INTERUPT PROCEDURE PROGRAM UNITS * * *>>                09088000
                                                                        09090000
   TOS _ USLIPL;  <<S.A. INTERUPT PROCEDURE LIST>>                      09092000
   IF <> THEN                                                           09094000
      BEGIN                                                             09096000
      MOVE BLINE := B2,(20);                                            09098000
      PRINTLINE;                                                        09100000
      DO BEGIN                                                          09102000
         GETENTRY(*);  <<GET INTERUPT PROC. ENTRY>>                     09104000
         DESCRIP;                                                       09106000
         TOS _ EBL  <<NEXT INTERUPT PROC. ENTRY>>                       09108000
         END UNTIL =;                                                   09110000
      BLANKLINE                                                         09112000
      END;                                                              09114000
                                                                        09116000
   <<* * * LIST USL FILE PARAMETERS * * *>>                             09118000
                                                                        09120000
   MOVE BLINE:=B3,(9); DNTOA(USLFL,8,BLINE(19));               <<00207>>09122000
   BLINE(20):="(";                                             <<00207>>09124000
   DNTOA((USLFL&DASR(7)),8,BLINE(25));                         <<00207>>09126000
   BLINE(26):=".";                                             <<00207>>09128000
   NTOA(USLFL2.(9:7),8,BLINE(29));                             <<00207>>09130000
   BLINE(30):=")";                                             <<00207>>09132000
   PRINTLINE;                                                  <<00207>>09134000
   MOVE BLINE:=B4,(9); NTOA((USLDL+%200),8,BLINE(19));         <<00207>>09136000
   MOVE BLINE(35):=B5,(9); DNTOA(USLIL,8,BLINE(54));           <<00207>>09138000
   BLINE(20):="(";                                             <<00207>>09140000
   NTOA(USLDL.(0:9)+1,8,BLINE(25));                            <<00591>>09142000
   BLINE(26):=".";                                             <<00207>>09144000
   NTOA(USLDL.(9:7),8,BLINE(29));                              <<00207>>09146000
   BLINE(30):=")";                                             <<00207>>09148000
   BLINE(55):="(";                                             <<00207>>09150000
   DNTOA((USLIL&DASR(7)),8,BLINE(60));                         <<00207>>09152000
   BLINE(61):=".";                                             <<00207>>09154000
   NTOA(USLIL2.(9:7),8,BLINE(64));                             <<00207>>09156000
   BLINE(65):=")";                                             <<00207>>09158000
   PRINTLINE;                                                  <<00207>>09160000
   MOVE BLINE:=B6,(10); NTOA(USLTDG,8,BLINE(19));              <<00207>>09162000
   MOVE BLINE(35):=B7,(10); DNTOA(USLTIG,8,BLINE(54));         <<00207>>09164000
   BLINE(20):="(";                                             <<00207>>09166000
  NTOA(USLTDG.(0:9),8,BLINE(25));                              <<00207>>09168000
   BLINE(26):=".";                                             <<00207>>09170000
   NTOA(USLTDG.(9:7),8,BLINE(29));                             <<00207>>09172000
   BLINE(30):=")";                                             <<00207>>09174000
   BLINE(55):="(";                                             <<00207>>09176000
   DNTOA((USLTIG&DASR(7)),8,BLINE(60));                        <<00207>>09178000
   BLINE(61):=".";                                             <<00207>>09180000
   NTOA(USLTIG2.(9:7),8,BLINE(64));                            <<00207>>09182000
   BLINE(65):=")";                                             <<00207>>09184000
   PRINTLINE;                                                  <<00207>>09186000
   MOVE BLINE:=B8,(11); NTOA(USLADL,8,BLINE(19));              <<00207>>09188000
   MOVE BLINE(35):=B9,(11); DNTOA(USLAIL,8,BLINE(54));         <<00207>>09190000
   BLINE(20):="(";                                             <<00207>>09192000
  NTOA(USLADL.(0:9),8,BLINE(25));                              <<00207>>09194000
   BLINE(26):=".";                                             <<00207>>09196000
   NTOA(USLADL.(9:7),8,BLINE(29));                             <<00207>>09198000
   BLINE(30):=")";                                             <<00207>>09200000
   BLINE(55):="(";                                             <<00207>>09202000
   DNTOA((USLAIL&DASR(7)),8,BLINE(60));                        <<00207>>09204000
   BLINE(61):=".";                                             <<00207>>09206000
   NTOA(USLAIL2.(9:7),8,BLINE(64));                            <<00207>>09208000
   BLINE(65):=")";                                             <<00207>>09210000
   PRINTLINE;                                                           09212000
   EJECTPAGE;                                                  <<00.DM>>09214000
   FCONTROL(INFNUM,DISABLE'CTLY,I);                            <<00.DM>>09216000
   END;                                                                 09218000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   UNLINKFAMILY"    <<00207>>09220000
$ CONTROL SEGMENT = SEG13                                               09222000
PROCEDURE UNLINKFAMILY (FATHERADR);                                     09224000
   <<UNLINKS A FAMILY OF ENTRIES FROM THE SEGMENT, BLOCK DATA OR        09226000
     INTERUPT PROCEDURE LISTS.  NOTHING IS CHANGED WITHIN THE           09228000
     FAMILY OF ENTRIES (INCLUDING THE HASH LINKS)>>                     09230000
   VALUE FATHERADR; INTEGER FATHERADR;                                  09232000
   BEGIN                                                                09234000
   INTEGER BROTHERADR;                                                  09236000
                                                                        09238000
   SUBROUTINE GETPREDENTRY (STARTADR,ENTRYADR);                         09240000
      <<STEPS THROUGH A LIST OF BROTHER ENTRIES LOOKING FOR THE         09242000
        PREDECESSOR ENTRY OF THE SPECIFIED ENTRY.  WHEN DONE THE        09244000
        PREDECESSOR ENTRY IS IN CORE.  IF THE STARTING ENTRY ADDRESS    09246000
        IS THE SAME AS THE SPECIFIED ENTRY, NOTHING IS DONE>>           09248000
      VALUE STARTADR,ENTRYADR; INTEGER STARTADR,ENTRYADR;               09250000
      BEGIN                                                             09252000
      IF STARTADR <> ENTRYADR THEN                                      09254000
         BEGIN                                                          09256000
         GETENTRY(STARTADR);                                            09258000
         WHILE ENTP1.(1:15) <> ENTRYADR DO GETBROTHER                   09260000
         END                                                            09262000
      END;                                                              09264000
                                                                        09266000
   SUBROUTINE UNLINK (STARTADR,FLAG);                                   09268000
      <<MOVES ENTRY LINK TO PREDECESSOR ENTRY OR REC0 AND SETS THE      09270000
        APPROPRIATE MODIFIED FLAG>>                                     09272000
      VALUE FLAG;                                                       09274000
      INTEGER STARTADR; LOGICAL FLAG;                                   09276000
      BEGIN                                                             09278000
      IF FATHERADR = STARTADR THEN  <<FIRST ENTRY IN LIST?>>            09280000
         BEGIN                                                          09282000
         STARTADR _ BROTHERADR;  <<INSERT LINK>>                        09284000
         IF FLAG THEN USLREC0MOD _ TRUE ELSE USLDIRMOD _ TRUE           09286000
         END                                                            09288000
      ELSE                                                              09290000
         BEGIN                                                          09292000
         GETPREDENTRY(STARTADR,FATHERADR);                              09294000
         EBL _ BROTHERADR;  <<INSERT LINK>>                             09296000
         USLDIRMOD _ TRUE  <<SET MODIFIED FLAG>>                        09298000
         END                                                            09300000
      END;                                                              09302000
                                                                        09304000
   GETENTRY(FATHERADR);                                                 09306000
   BROTHERADR _ EBL;  <<SAVE BROTHER LINK>>                             09308000
   IF SEGMENTNAME THEN UNLINK(USLSL,TRUE)                               09310000
   ELSE IF INTERUPTPROC THEN UNLINK(USLIPL,TRUE)                        09312000
   ELSE IF BLOCKDATA THEN UNLINK(USLBDL,TRUE)                           09314000
   ELSE                                                                 09316000
      BEGIN                                                             09318000
      GETSEGENTRY;                                                      09320000
      UNLINK(ESL,FALSE)                                                 09322000
      END                                                               09324000
   END;                                                                 09326000
$PAGE "USL FILE MAINTAINENCE PROCEDURES   -   REMOVEFAMILY"    <<00207>>09328000
$ CONTROL SEGMENT = SEG13                                               09330000
PROCEDURE REMOVEFAMILY (FATHERADR);                                     09332000
   <<REMOVES A FAMILY OF ENTRIES FROM THE CURRENT USL FILE>>            09334000
   VALUE FATHERADR; INTEGER FATHERADR;                                  09336000
   BEGIN                                                                09338000
   INTEGER I,ENTRYADR;                                                  09340000
   UNLINKFAMILY(FATHERADR);                                             09342000
                                                                        09344000
   <<* * * FREE ENTRY FAMILY STORAGE * * *>>                            09346000
                                                                        09348000
   GETENTRY(FATHERADR);                                                 09350000
   DO BEGIN                                                             09352000
      ENTRYADR _ ENTFILEADR;  <<SAVE ENTRY ADDRESS>>                    09354000
      TOS _ EHL;  <<SAVE HASH LINK>>                                    09356000
                                                                        09358000
      <<* * * FREE HEADER AND CODE MODULE STORAGE * * *>>               09360000
                                                                        09362000
      IF BITMAP6&CSR(ENTTYPE) THEN                                      09364000
         BEGIN                                                          09366000
         IF BITMAP5&CSR(ENTTYPE) THEN  <<CODE MODULE?>>                 09368000
            USLTIG _ USLTIG+DOUBLE(LOGICAL(ENTNWCODE));                 09370000
         DO WHILE GETNEXTDESCRIP DO                                     09372000
            USLTIG _ USLTIG+DOUBLE(LOGICAL(EHEADNW))                    09374000
            UNTIL NOT BLOCKDATARESET                                    09376000
         END;                                                           09378000
                                                                        09380000
      <<* * * REMOVE ENTRY FROM HASH LIST * * *>>                       09384000
                                                                        09386000
      I _ USLREC0(USLFHI+ENTHASH);                                      09388000
      IF I = ENTFILEADR THEN USLREC0(XREG) _ TOS  <<NEW HASH LINK>>     09390000
      ELSE                                                              09392000
         BEGIN                                                          09394000
         DO BEGIN  <<GET PREDECESSOR HASH ENTRY>>                       09396000
            GETENTRY(I);                                                09398000
            I _ EHL  <<SAVE HASH LINK>>                                 09400000
            END UNTIL I = ENTRYADR;                                     09402000
         EHL _ TOS;  <<INSERT NEW HASH LINK>>                           09404000
         USLDIRMOD _ TRUE;                                              09406000
         GETENTRY(ENTRYADR)                                             09408000
         END;                                                           09410000
                                                               <<01141>>09412000
      <<* * * FREE ENTRY STORAGE * * *>>                       <<01141>>09414000
                                                               <<01141>>09416000
      ETYPE _ 0;  <<GARBAGE TYPE NR.>>                         <<01141>>09418000
      USLTDG _ USLTDG+ENTNW;                                   <<01141>>09420000
      USLNDG _ USLNDG+1;                                       <<01141>>09422000
      USLDIRMOD _ TRUE;                                        <<01141>>09424000
                                                               <<01141>>09426000
      END UNTIL NOT GETFAMILY(FATHERADR);                               09428000
                                                                        09430000
   <<* * * CHECK FOR EMPTY USL FILE * * *>>                             09432000
                                                                        09434000
   IF USLTDG = USLDL THEN  <<DIRECTORY EMPTY?>>                         09436000
      BEGIN                                                             09438000
      ASSEMBLE(DZRO,DZRO; DZRO,DZRO; ZERO);                             09440000
      USLADL := USLADL+USLDL;  <<RE-SET AVAIL. DIRECTORY LENGTH>>       09442000
      USLNE := TOS; USLDL := TOS; USLTDG := TOS; USLNDG := TOS;         09444000
      USLSAAD := 128;                                                   09446000
      USLAIL := USLAIL+USLIL;  <<RE-SET AVAIL. INFO LENGTH>>            09448000
      USLIL := TOS; USLTIG := TOS; USLNIG := TOS;                       09450000
      USLSAAI := USLSAI;                                       <<01.DM>>09452000
      DIRADR := 128;                                           <<01.DM>>09454000
      INFOADR := 0D;                                           <<01.DM>>09456000
      USLSTATE.(3:4) := %(2)1010;                              <<01.DM>>09458000
      END;                                                              09460000
   USLREC0MOD _ TRUE                                                    09462000
   END;                                                                 09464000
$PAGE "AUXILIARY USL FILE MAINTAINENCE PROC - CHANGESTATE"     <<00207>>09466000
<<----------------------------------------------------------------------09468000
*                                                                      *09470000
* AUXILIARY USL FILE MAINTAINENCE PROCEDURES                           *09472000
*                                                                      *09474000
---------------------------------------------------------------------->>09476000
                                                                        09478000
$ CONTROL SEGMENT = SEG13                                               09480000
PROCEDURE CHANGESTATE;                                                  09482000
   <<INTERCHANGES THE STATE VARIABLES FOR THE USL AND AUX. USL          09484000
     FILES>>                                                            09486000
   BEGIN                                                                09488000
   TOS := USLSTATE; TOS := XUSLSTATE;                                   09490000
   USLSTATE := TOS; XUSLSTATE := TOS;                                   09492000
   TOS := USLFNUM; TOS := XUSLFNUM;                                     09494000
   USLFNUM := TOS; XUSLFNUM := TOS;                                     09496000
   TOS := @USLREC0; TOS := @XUSLREC0;                                   09498000
   @USLREC0 := TOS; @XUSLREC0 := TOS;                                   09500000
   TOS := @DIR; TOS := @XDIR;                                           09502000
   @DIR := TOS; @XDIR := TOS;                                           09504000
   TOS := DIRADR; TOS := XDIRADR;                                       09506000
   DIRADR := TOS; XDIRADR := TOS;                                       09508000
   TOS := @ENTP; TOS := @XENTP;                                         09510000
   @ENTP := TOS; @XENTP := TOS;                                         09512000
   TOS := @ENTP1; TOS := @XENTP1;                                       09514000
   @ENTP1 := TOS; @XENTP1 := TOS;                                       09516000
   TOS := @ENTP2; TOS := @XENTP2;                                       09518000
   @ENTP2 := TOS; @XENTP2 := TOS;                                       09520000
   TOS := @HEAD; TOS := @XHEAD;                                         09522000
   @HEAD := TOS; @XHEAD := TOS;                                         09524000
   TOS := INFOADR; TOS := XINFOADR;                                     09526000
   INFOADR := TOS; XINFOADR := TOS;                                     09528000
   TOS := @HEADP; TOS := @XHEADP;                                       09530000
   @HEADP := TOS; @XHEADP := TOS;                                       09532000
   STATECHANGED := STATECHANGED+1  <<SET STATE FLAG>>                   09534000
   END;                                                                 09536000
$PAGE "AUXILIARY USL FILE MAINTAINENCE PROC - COPYFAMILY"      <<00207>>09538000
$ CONTROL SEGMENT = SEG13                                               09540000
PROCEDURE COPYFAMILY;                                                   09542000
   <<COPIES A FAMILY OF ENTRIES FROM THE AUX. USL FILE INTO THE         09544000
     ORIG. USL FILE.  IT IS ASSUMED THAT THE USL STATE HAS BEEN         09546000
     CHANGED WHEN THE PROCEDURE IS CALLED>>                             09548000
   BEGIN                                                                09550000
   INTEGER FATHERADR = Q+1;  <<ADDRESS OF FAMILY ROOT ENTRY>>           09552000
   INTEGER ENTRYADR = Q+2;  <<ADDRESS OF FIRST COPIED ENTRY>>           09554000
   INTEGER SEGADR = Q+3;  <<ADDRESS OF SEGMENT ENTRY>>                  09556000
   INTEGER UNITADR = Q+4;  <<ADDRESS OF UNIT ENTRY>>                    09558000
   INTEGER CODEFLAG = Q+5;  <<FIRST PART OF CODE MODULE FLAG>>          09560000
   INTEGER ARRAY SAVEREC0 (*) = Q+6;  <<SAVE REC0 BUFFER>>              09562000
                                                                        09564000
   SUBROUTINE COPYENTRY;                                                09566000
      <<COPIES THE CURRENT ENTRY FROM THE AUX. USL FILE TO THE ORIG.    09568000
        USL FILE>>                                                      09572000
      BEGIN                                                             09574000
      CHANGESTATE;  <<BACK TO ORIG. USL FILE>>                          09576000
      ADDTODIRECTORY(ENTNW);  <<ALLOCATE ENTRY>>                        09578000
      IF < THEN GO NFG;  <<ERROR?>>                                     09580000
      MOVE ENTP := XENTP,(ENTNW);  <<COPY ENTRY>>                       09582000
      @ENTP1 := @ENTP+ENTNAMENW+2;  <<INIT. SECONDARY POINTER>>         09584000
      USLDIRMOD := TRUE;  <<SET MODIFIED FLAG>>                         09586000
      CHANGESTATE  <<BACK TO AUX. USL>>                                 09588000
      END;                                                              09590000
                                                                        09592000
   SUBROUTINE COPYHEADER;                                               09594000
      <<COPIES THE CURRENT HEADER OR CODE MODULE FROM THE AUX. USL      09596000
        FILE TO THE ORIG. USL FILE>>                                    09598000
      BEGIN                                                             09600000
      CHANGESTATE;  <<BACK TO ORIG. USL FILE>>                          09602000
      ADDTOINFO(HEADNW);  <<APPEND HEADER OR CODE MODULE>>              09604000
      IF < THEN GO NFG;  <<ERROR?>>                                     09606000
      MOVE HEADP := XHEADP,(HEADNW);  <<COPY HEADER>>                   09608000
      USLINFOMOD := TRUE;  <<SET FLAG>>                                 09610000
      CHANGESTATE  <<BACK TO AUX. USL>>                                 09612000
      END;                                                              09614000
                                                                        09616000
   SUBROUTINE LINKUP (LISTADR);                                         09618000
      <<INSERTS THE CURRENT ENTRY INTO THE SPECIFIED PRIMARY            09620000
        (I.E. SEGMENT, INTERUPT PROCEDURE OR BLOCK DATA) LIST>>         09622000
      INTEGER LISTADR;                                                  09624000
      BEGIN                                                             09626000
      EBL := LISTADR;  <<INSERT BROTHER LINK>>                          09628000
      LISTADR := ENTRYADR  <<NEW S.A. OF LIST>>                         09630000
      END;                                                              09632000
                                                                        09634000
   SUBROUTINE INSERT;                                                   09636000
      <<INSERTS THE CURRENT ENTRY INTO THE APPROPRIATE HASH LIST>>      09638000
      BEGIN                                                             09640000
      ADDHASHLIST;  <<LINK ENTRY INTO HASH LIST>>                       09642000
      USLDIRMOD := TRUE;  <<SET MODIFIED FLAG>>                         09644000
      ENTRYADR := ENTRYADR+ENTNW  <<NEXT ENTRY ADR.>>                   09646000
      END;                                                              09648000
                                                                        09650000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           09652000
                                                                        09654000
   TOS := ENTFILEADR;  <<SAVE ROOT ADR.>>                               09656000
   TOS := XUSLSAAD;  <<SAVE FIRST ENTRY ADR.>>                          09658000
   ASSEMBLE(ADDS 131);                                                  09660000
   MOVE SAVEREC0 := XUSLREC0,(128);  <<SAVE RECORD 0>>                  09662000
                                                                        09664000
   <<* * * COPY SEGMENT ENTRY * * *>>                                   09666000
                                                                        09668000
   IF BITMAP12&CSR(ENTTYPE) THEN  <<SEG. ENTRY REQUIRED?>>              09670000
      BEGIN                                                             09672000
      GETSEGENTRY;  <<GET SEGMENT ENTRY>>                               09674000
      CHANGESTATE;  <<BACK TO ORIG. USL>>                               09676000
      IF SEARCHUSL(XENAME,0,USLSEG) THEN  <<SEG. ENTRY EXISTS?>>        09678000
         BEGIN                                                          09680000
         TOS := FALSE;                                                  09682000
         TOS := ENTFILEADR                                              09684000
         END                                                            09686000
      ELSE  <<SEG. ENTRY COPY NEEDED>>                                  09688000
         BEGIN                                                          09690000
         TOS := TRUE;                                                   09692000
         TOS := USLSAAD                                                 09694000
         END;                                                           09696000
      SEGADR := TOS;  <<SAVE SEG. ADR.>>                                09698000
      CHANGESTATE;  <<BACK TO AUX. USL>>                                09700000
      IF TOS THEN  <<COPY SEG. ENTRY?>>                                 09702000
         BEGIN                                                          09704000
         USLENTRYPARMS;  <<RESTORE ENTRY PARM'S>>                       09706000
         COPYENTRY                                                      09708000
         END;                                                           09710000
      GETENTRY(FATHERADR)  <<RESTORE ROOT ENTRY>>                       09712000
      END;                                                              09714000
                                                                        09716000
   <<* * * COPY ENTRY, HEADERS AND CODE * * *>>                         09718000
                                                                        09720000
   DO BEGIN                                                             09722000
                                                                        09724000
      <<* * * COPY ENTRY * * *>>                                        09726000
                                                                        09728000
      IF NOT SEGMENTNAME THEN COPYENTRY;  <<COPY ENTRY?>>               09730000
                                                                        09732000
      <<* * * COPY HEADERS AND CODE * * *>>                             09734000
                                                                        09736000
      CODEFLAG := -1;  <<INIT. CODE MODULE FLAG>>                       09738000
      IF BITMAP6&CSR(ENTTYPE) THEN  <<HEADERS OR CODE?>>                09740000
         DO BEGIN                                                       09742000
            WHILE GETNEXTHEADER(TRUE,-1) DO                             09744000
               BEGIN                                                    09746000
               XREG := HEADTYPE;  <<HEADER TYPE NR.>>                   09748000
               IF < THEN  <<CODE MODULE?>>                              09750000
                  BEGIN                                                 09752000
                  CODEFLAG := CODEFLAG+1;                               09754000
                  IF = THEN  <<FIRST PART OF CODE MODULE?>>             09756000
                     BEGIN                                              09758000
                     TOS := XUSLIL;  <<S.A. CODE MODULE>>               09760000
                     XESAC2:= TOS; XESAC1 := TOS                        09762000
                     END                                                09764000
                  END                                                   09766000
               ELSE  <<HEADER>>                                         09768000
                  IF @ENTHEADP-@ENTHEADSETP = 3 THEN  <<NEW SET?>>      09770000
                     BEGIN                                              09772000
                     TOS := @XENTP+@ENTHEADSETP-@ENTP+1;  <<SAH PNTR>>  09774000
                     IF CODEFLAG <> -1 THEN                             09776000
                     BEGIN  <<CODE FIRST>>                              09778000
                         TOS := XESAC1;                                 09780000
                         TOS := XESAC2;                                 09782000
                     END                                                09784000
                     ELSE    <<HEAD FIRST IN SET>>                      09786000
                      TOS := XUSLIL;                                    09788000
                     DPS2 := TOS;  <<INSERT S.A. OF HEADER SET>>        09790000
                     DEL                                                09792000
                     END;                                               09794000
               COPYHEADER  <<COPY HEADER/CODE MODULE>>                  09796000
               END                                                      09798000
            END UNTIL NOT BLOCKDATARESET                                09800000
      END UNTIL NOT GETFAMILY(FATHERADR);                               09802000
                                                                        09804000
   <<* * * INSERT FAMILY ROOT INTO APPROPRIATE LIST * * *>>             09806000
                                                                        09808000
   CHANGESTATE;  <<BACK TO ORIG. USL>>                                  09810000
   IF ENTRYADR = USLSAAD THEN GO GETOUT; << ANYTHING COPIED? >><<01145>>09812000
   GETENTRY(ENTRYADR);  <<GET FIRST COPIED ENTRY>>                      09814000
   IF MAP12(ENTTYPE) = SEGCLASS THEN  <<NEW LIST ENTRY?>>               09816000
      BEGIN                                                             09818000
      IF SEGMENTNAME THEN  <<SEGMENT ENTRY?>>                           09820000
         BEGIN                                                          09822000
         LINKUP(USLSL);  <<INSERT INTO LIST>>                           09824000
         TOS := ENTRYADR; SETBIT0; ESL := TOS  <<EMPTY SON LINK>>       09826000
         END                                                            09828000
      ELSE IF INTERUPTPROC THEN  <<INTERUPT PROCEDURE ENTRY?>>          09830000
         LINKUP(USLIPL)  <<INSERT INTO LIST>>                           09832000
      ELSE LINKUP(USLBDL);  <<BLOCK DATA ENTRY>>                        09834000
      INSERT  <<INSERT INTO HASH LIST>>                                 09836000
      END;                                                              09838000
                                                                        09840000
   <<* * * INSERT ENTRIES INTO FAMILY LIST * * *>>                      09842000
                                                                        09844000
   WHILE ENTRYADR <> USLSAAD DO                                         09846000
      BEGIN                                                             09848000
      GETENTRY(ENTRYADR);  <<GET NEXT ENTRY>>                           09850000
      TOS := MAP12(ENTTYPE);  <<ENTRY LEVEL>>                           09852000
      GETENTRY(IF S0 = UNITCLASS THEN SEGADR ELSE UNITADR);             09854000
      TOS := ESL;  <<SAVE SON LINK>>                                    09856000
      ESL := ENTRYADR;  <<INSERT NEW SON LINK>>                         09858000
      USLDIRMOD := TRUE;  <<SET MODIFIED FLAG>>                         09860000
      GETENTRY(ENTRYADR);  <<GET ENTRY AGAIN>>                          09862000
      EBL := TOS;  <<INSERT BROTHER LINK>>                              09864000
      IF TOS = UNITCLASS THEN                                           09866000
         BEGIN                                                          09868000
         TOS := ENTRYADR; SETBIT0; ESL := TOS;  <<EMPTY SON LINK>>      09870000
         UNITADR := ENTRYADR                                            09872000
         END;                                                           09874000
      INSERT  <<INSERT INTO HASH LIST>>                                 09876000
      END;                                                              09878000
   GO GETOUT;                                                           09880000
                                                                        09882000
   NFG:                                                                 09884000
   TOS := USLSAI; TOS := USLSAAI;  <<NEW INFO POSITION>>                09886000
   MOVE USLREC0 := SAVEREC0,(128);  <<RESTORE RECORD 0>>                09888000
   USLSAAI := TOS; USLSAI := TOS;  <<SET NEW INFO POSITION>>            09890000
                                                                        09892000
   GETOUT:                                                              09894000
   USLREC0MOD := TRUE  <<SET MODIFIED FLAG>>                            09896000
   END;                                                                 09898000
$PAGE "SYMBOL TABLE MAINTAINENCE PROCEDURES  -  SEARCHSYM"     <<00207>>09900000
<<----------------------------------------------------------------------09902000
*                                                                      *09904000
*  SYMBOL TABLE MAINTAINENCE PROCEDURES                                *09906000
*                                                                      *09908000
---------------------------------------------------------------------->>09910000
                                                                        09912000
$ CONTROL SEGMENT = SEG21                                               09914000
LOGICAL PROCEDURE SEARCHSYM (NAME,TYPE);                                09916000
   value Type;                                                 <<04102>>09920000
   integer array Name;            << Name to be searched for >><<04102>>09922000
   logical Type;                  << Bit map of valid types >> <<04102>>09924000
                                                               <<04102>>09926000
   << This procedure searches the symbol table for a specific ><<04102>>09928000
   << name and qualifying type.  The type is specified in a    <<04102>>09930000
   << bit map whose bits are numbered from the right, starting <<04102>>09932000
   << with 16, then 1 through 15.  If a bit is set in the map, <<04102>>09934000
   << then the corresponding entry type qualifies for a match. <<04102>>09936000
                                                               <<04102>>09938000
   begin << SearchSym >>                                       <<04102>>09940000
                                                               <<04102>>09942000
   @SYMP _ SYMBOL(HASH(NAME));  <<GET INITIAL ADDRESS>>                 09944000
   WHILE <> DO                                                          09946000
      BEGIN                                                             09948000
      SYMENTPARMS;  <<GET ENTRY PARM'S>>                                09950000
      IF NAME.(4:4) = SYMNC THEN                                        09952000
         BEGIN                                                          09954000
         TOS _ @NAME&LSL(1)+1; TOS _ @SNAME&LSL(1)+1;                   09956000
         IF * = *,(SYMNC) THEN  <<NAMES MATCH?>>                        09958000
                                                               <<04102>>09960000
            if Type & CSR(SymType) then                        <<04102>>09962000
               BEGIN                                                    09964000
               SEARCHSYM _ TRUE;                                        09966000
               RETURN                                                   09968000
               END                                                      09970000
         END;                                                           09972000
      @SYMP _ SHL  <<NEXT ENTRY>>                                       09974000
      END                                                               09976000
   END;                                                                 09978000
$PAGE "SYMBOL TABLE MAINTAINENCE PROCEDURES  -  SYMENTPARMS"   <<00207>>09980000
$ CONTROL SEGMENT = SEG21                                               09982000
PROCEDURE SYMENTPARMS;                                                  09984000
   <<CALCULATES THE PARAMETERS OF THE SYMBOL TABLE ENTRY POINTED        09986000
     TO BY SYMP>>                                                       09988000
   BEGIN                                                                09990000
   SYMNW _ SNW;  <<NR. WORDS IN ENTRY>>                                 09992000
   SYMTYPE _ STYPE;  <<ENTRY TYPE NUMBER>>                              09994000
   SYMNC _ SNC;  <<NR. CHAR'S IN NAME>>                                 09996000
   SYMNAMENW _ SYMNC&LSR(1)+1;  <<NR. WORDS FOR NAME>>                  09998000
   @SYMP1 _ @SYMP+SYMNAMENW+2;  <<SECONDARY POINTER>>                   10000000
   @SYMP2 _ INTEGER(MAP11(SYMTYPE))+@SYMP1;  <<SECONDARY POINTER>>      10002000
   IF SYMTYPE = 7 THEN @SYMP2 := @SYMP2+SXNL                            10004000
   END;                                                                 10006000
$PAGE "SYMBOL TABLE MAINTAINENCE PROCEDURES  -  CREATESYMENT"  <<00207>>10008000
$ CONTROL SEGMENT = SEG21                                               10010000
PROCEDURE CREATESYMENT (TYPE,NAME,PARMS);                               10012000
   <<CREATES A SYMBOL TABLE ENTRY OF THE SPECIFIED TYPE AND LINKS       10014000
     IT INTO THE SYMBOL TABLE.  WHEN DONE THE SYMBOL TABLE ENTRY        10016000
     PARAMETERS ARE SET.  NOTE THAT THIS PROCEDURE USES THE             10018000
     CONDITION CODE TO INDICATE AN ERROR>>                              10020000
   VALUE TYPE;                                                          10022000
   INTEGER TYPE; BYTE ARRAY NAME; INTEGER ARRAY PARMS;                  10024000
   BEGIN                                                                10026000
   LOGICAL BITMAP0 := %(2)0000111110011000;  <<ENT'S WITH PARM. INFO>>  10028000
   INTEGER PARMINFOLEN;                                                 10030000
                                                                        10032000
   <<* * * ALLOCATE SPACE FOR ENTRY * * *>>                             10034000
                                                                        10036000
   SYMNC _ NAME.(12:4);  <<NR. CHAR'S IN NAME>>                         10038000
   SYMNAMENW _ SYMNC&LSR(1)+1;  <<NR WORDS FOR NAME>>                   10040000
   TOS _ 0;  <<INIT. PARM. INFO LENGTH>>                                10042000
   IF BITMAP0&CSR(TYPE) THEN  <<ENTRY CONTAINS PARM. INFO?>>            10044000
      BEGIN                                                             10046000
      TOS _ @PARMS;                                                     10048000
      TOS _ PARMLEN(*)                                                  10050000
      END;                                                              10052000
   PARMINFOLEN _ TOS;  <<PARM. INFO LENGTH>>                            10054000
   SYMNW _ INTEGER(MAP11(TYPE))+2+SYMNAMENW+PARMINFOLEN;  <<ENT. LEN.>> 10056000
   MAKEROOMINDL(SYMNW);  <<IS THERE ROOM?>>                             10058000
   IF < THEN  <<ERROR?>>                                                10060000
      BEGIN                                                             10062000
      TOS _ CCL;  <<ERROR CONDITION CODE>>                              10064000
      GO GETOUT                                                         10066000
      END;                                                              10068000
   @STABLE _ @STABLE-SYMNW;  <<ADJ. SYMBOL TABLE POINTER>>              10070000
   @DLAREA1 _ @STABLE;  <<ADJ. DL AVAIL. AREA POINTER>>                 10072000
   USEDSYMBOL _ USEDSYMBOL+SYMNW;  <<ADJ. USED SPACE COUNT>>            10074000
                                                                        10076000
   <<* * * INITIALIZE ENTRY * * *>>                                     10078000
                                                                        10080000
   @SYMP _ @STABLE;  <<INIT. ENTRY POINTER>>                            10082000
   SYMTYPE _ TYPE;  <<ENTRY TYPE NUMBER>>                               10084000
   SYMP := SYMTYPE CAT SYMNW (0:6:10);  <<DESCRIPTOR WORD>>    <<01124>>10086000
   TOS _ HASH(NAME);  <<HASH CODE OF NAME>>                             10088000
   SHL _ SYMBOL(S0);  <<INSERT ENTRY HASH LINK>>                        10090000
   SYMBOL(TOS) _ @SYMP;  <<NEW S.A. OF HASH LIST>>                      10092000
   TOS _ @SNAME&LSL(1);                                                 10094000
   MOVE * _ NAME,(SYMNC+1);  <<INSERT ENTRY NAME>>                      10096000
   @SYMP1 _ @SYMP+SYMNAMENW+2;  <<INIT. SECONDARY POINTER>>             10098000
   @SYMP2 _ INTEGER(MAP11(TYPE))+@SYMP1;  <<INIT. SECONDARY POINTER>>   10100000
   MOVE SPARMS := PARMS,(PARMINFOLEN);  <<INSERT PARM. INFO>>           10102000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    10104000
   GETOUT:                                                              10106000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             10108000
   END;                                                                 10110000
$PAGE "SYMBOL TABLE MAINTAINENCE PROCEDURES  -  EXPANDSYMENT"  <<00207>>10112000
$ CONTROL SEGMENT = SEG21                                               10114000
PROCEDURE EXPANDSYMENT (PNTR,NRWORDS);                                  10116000
   <<EXPANDS THE SYMBOL TABLE ENTRY POINTED TO BY SYMP BY THE           10118000
     SPECIFIED NUMBER OF WORDS.  PNTR POINTS TO THE FIRST WORD THAT     10120000
     IS TO BE MADE AVAILABLE.  ALSO REPAIRS ALL ENTRY POINTERS THAT     10122000
     REFERENCE MOVED ENTRIES.  NOTE THAT THIS PROCEDURE USES THE        10124000
     CONDITION CODE TO INDICATE AN ERROR>>                              10126000
   VALUE PNTR,NRWORDS; INTEGER POINTER PNTR; INTEGER NRWORDS;           10128000
   BEGIN                                                                10130000
   SUBROUTINE FIX (LINK);                                               10132000
      <<FIXES THE SPECIFIED SYMBOL TABLE POINTER (IF NECESSARY)>>       10134000
      INTEGER LINK;                                                     10136000
      BEGIN                                                             10138000
      IF LINK < @PNTR THEN LINK := LINK-NRWORDS                <<01124>>10140000
      END;                                                              10142000
   MAKEROOMINDL(NRWORDS);  <<IS THERE ROOM?>>                           10144000
   IF < THEN  <<ERROR - NO ROOM?>>                                      10146000
      BEGIN                                                             10148000
      TOS _ CCL;  <<ERROR CONDITION CODE>>                              10150000
      GO GETOUT                                                         10152000
      END;                                                              10154000
   @STABLE _ @STABLE-NRWORDS;  <<ADJ. SYMBOL TABLE POINTER>>            10156000
   @DLAREA1 _ @STABLE;  <<ADJ. DL AVAILABLE AREA POINTER>>              10158000
   USEDSYMBOL _ USEDSYMBOL+NRWORDS;  <<ADJ. USED SPACE COUNT>>          10160000
                                                                        10162000
   <<* * * EXPAND SYMBOL TABLE ENTRY * * *>>                            10164000
                                                                        10166000
   TOS _ @STABLE; TOS _ S0+NRWORDS; TOS _ @PNTR-S0+1;                   10168000
   ASSEMBLE(MOVE 3);                                                    10170000
   @SYMP _ @SYMP-NRWORDS;  <<ADJ. ENTRY POINTER>>                       10172000
   SNW _ SNW+NRWORDS;  <<ADJ. NR. WORDS IN ENTRY>>                      10174000
                                                                        10176000
   <<* * * REPAIR POINTERS TO MOVED ENTRIES * * *>>                     10178000
                                                                        10180000
   XREG := 94;  <<HASH INDEX>>                                          10182000
   DO BEGIN                                                             10184000
      FIX(SYMBOL(XREG));  <<REPAIR LIST HEAD>>                          10186000
      XREG := XREG-1                                                    10188000
      END UNTIL <;                                                      10190000
   TOS _ @SYMP;  <<SAVE CURRENT ENTRY POINTER>>                         10192000
   @SYMP _ @STABLE;                                                     10194000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 10196000
      BEGIN                                                             10198000
      SYMENTPARMS;  <<GET ENTRY PARM'S>>                                10200000
      FIX(SHL);  <<REPAIR HASH LINK>>                                   10202000
      @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                               10204000
      END;                                                              10206000
   TOS _ @RLTABLE;  <<ENTRY POINTER>>                                   10208000
   TOS _ NRRLENT;  <<ENTRY COUNTER>>                                    10210000
   WHILE <> DO                                                          10212000
      BEGIN                                                             10214000
      FIX(PS1(2));                                                      10216000
      ASSEMBLE(INCB,INCB; INCB,DECA)                                    10218000
      END;                                                              10220000
   DDEL;                                                                10222000
   @SYMP _ TOS;  <<RESTORE CURRENT ENTRY POINTER>>                      10224000
   SYMENTPARMS;  <<RESTORE ENTRY PARM'S>>                               10226000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    10228000
                                                                        10230000
   GETOUT:                                                              10232000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             10234000
   END;                                                                 10236000
$PAGE "PATCH TABLE MAINTAINENCE PROCEDURES  -  CREATEPATCHENT" <<00207>>10238000
<<----------------------------------------------------------------------10240000
*                                                                      *10242000
*  PATCH TABLE MAINTAINENCE PROCEDURES                                 *10244000
*                                                                      *10246000
---------------------------------------------------------------------->>10248000
                                                                        10250000
$ CONTROL SEGMENT = SEG21                                               10252000
PROCEDURE CREATEPATCHENT (TYPE,ADR);                                    10254000
   <<CREATES A PATCH TABLE ENTRY OF THE SPECIFIED TYPE FOR THE          10256000
     SPECIFIED SEGMENT ADDRESS AND LINKS THE ENTRY INTO THE PATCH       10258000
     TABLE.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO        10260000
     INDICATE AN ERROR>>                                                10262000
   VALUE TYPE,ADR; INTEGER TYPE,ADR;                                    10264000
   BEGIN                                                                10266000
   MAKEROOMINDL(3);                                                     10268000
   IF < THEN  <<ERROR - NO ROOM?>>                                      10270000
      BEGIN                                                             10272000
      TOS _ CCL;  <<ERROR CONDITION CODE>>                              10274000
      GO GETOUT                                                         10276000
      END;                                                              10278000
   @PATCHP _ @DLAVAIL;  <<INIT. ENTRY POINTER>>                         10280000
   @DLAVAIL _ @DLAVAIL+3;  <<ADJ. DL AVAILABLE AREA LIMIT>>             10282000
   XREG _ ADR.(0:9);  <<RECORD NR. OF PATCH>>                           10284000
   TOS _ TYPE CAT ADR (1:9:7);  <<ENTRY HEADER WORD>>                   10286000
   TOS _ PATCH(XREG);  <<INSERT OLD LINK>>                              10288000
   PATCHDP _ TOS;                                                       10290000
   PATCH(XREG) _ @PATCHP-@PTABLE;  <<INSERT NEW LINK>>                  10292000
   USEDPATCH _ USEDPATCH+3;  <<ADJ. PATCH TABLE LENGTH>>                10294000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    10296000
   GETOUT:                                                              10298000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             10300000
   END;                                                                 10302000
$PAGE "COMMON DATA LABEL TABLE MAINTAINENCE PROC-SEARCHCOMMON" <<00207>>10304000
<<----------------------------------------------------------------------10306000
*                                                                      *10308000
*  COMMON DATA LABEL TABLE MAINTAINENCE PROCEDURES                     *10310000
*                                                                      *10312000
---------------------------------------------------------------------->>10314000
                                                                        10316000
$ CONTROL SEGMENT = SEG23                                               10318000
LOGICAL PROCEDURE SEARCHCOMMON (DLABEL,TYPE);                           10320000
   <<SEARCHES THE COMMON TABLE FOR THE SPECIFIED DATA LABEL.  RETURNS   10322000
     THE VALUE TRUE IF THE DATA LABEL OF THE SPECIFIED TYPE IS          10324000
     FOUND AND SETS THE ENTRY POINTER TO THE ENTRY.                     10326000
        TYPE.(14:1) SET IF BLANK COMMON DATA LABEL                      10328000
        TYPE.(15:1) SET IF BYTE DATA LABEL>>                            10330000
   VALUE DLABEL,TYPE; LOGICAL DLABEL,TYPE;                              10332000
   BEGIN                                                                10334000
   INTEGER INDEX = Q+1;                                                 10336000
   TOS _ COMMON(DLABEL MOD COMHASH).(0:14);                    <<CM.DM>>10338000
   WHILE INDEX <> %037777 DO                                            10340000
      BEGIN                                                             10342000
      TOS _ COMTABD(INDEX);  <<LOAD ENTRY>>                             10344000
      IF TOS = DLABEL THEN  <<DATA LABEL MATCH?>>                       10346000
         BEGIN                                                          10348000
         ASSEMBLE(DUP);  <<DUPLICATE LINK WORD>>                        10350000
         IF TOS.(14:2) = TYPE.(14:2) THEN  <<TYPE MATCH?>>              10352000
            BEGIN                                                       10354000
            SEARCHCOMMON _ TRUE;                                        10356000
            @COMP _ @COMTABD(INDEX);  <<SET ENTRY POINTER>>             10358000
            RETURN                                                      10360000
            END                                                         10362000
         END;                                                           10364000
      INDEX _ TOS.(0:14)  <<NEXT ENTRY>>                                10366000
      END                                                               10368000
   END;                                                                 10370000
$PAGE "COMMON DATA LABEL TABLE MAINTAINENCE PROC-CREATECOMENT" <<00207>>10372000
$ CONTROL SEGMENT = SEG23                                               10374000
PROCEDURE CREATECOMENT (DLABEL,TYPE);                                   10376000
   <<CREATES A COMMON TABLE ENTRY FOR THE SPECIFIED DATA LABEL.         10378000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE       10380000
     AN ERROR>>                                                         10382000
   VALUE DLABEL,TYPE; LOGICAL DLABEL,TYPE;                              10384000
   BEGIN                                                                10386000
   INTEGER HASHCODE = Q+1;                                              10388000
   IF NRCOMENT = P256 THEN  <<TABLE OVERFLOW?>>                         10390000
      BEGIN                                                             10392000
      ERROR(66);                                                        10394000
      TOS _ CCL;  <<ERROR CONDITION CODE>>                              10396000
      GO GETOUT                                                         10398000
      END;                                                              10400000
   TOS _ DLABEL MOD COMHASH;  <<GET HASH CODE>>                         10402000
   TOS _ TYPE CAT COMMON(HASHCODE) (0:0:14);  <<LINK WORD>>    <<CM.DM>>10404000
   TOS _ DLABEL;  <<DATA LABEL>>                                        10406000
   COMTABD(NRCOMENT) _ TOS;  <<STORE ENTRY INTO TABLE>>                 10408000
   COMMON(HASHCODE).(0:14) _ NRCOMENT;  <<NEW S.A. OF LIST>>   <<CM.DM>>10410000
   NRCOMENT _ NRCOMENT+1;  <<BUMP NR. OF ENTRIES>>                      10412000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    10414000
   GETOUT:                                                              10416000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             10418000
   END;                                                                 10420000
$PAGE "RL TABLE MAINTAINENCE PROCEDURES - SEARCHRLTAB"         <<00207>>10424000
<<----------------------------------------------------------------------10426000
*                                                                      *10428000
*  RL TABLE MAINTAINENCE PROCEDURES                                    *10430000
*                                                                      *10432000
---------------------------------------------------------------------->>10434000
                                                                        10436000
$ CONTROL SEGMENT = SEG23                                               10438000
LOGICAL PROCEDURE SEARCHRLTAB (INFOADR);                                10440000
   <<SEARCHES THE RL TABLE FOR THE ENTRY HAVING THE GIVEN INFO ADDRESS. 10442000
     IF FOUND, THE RL ENTRY POINTER IS SET TO THE ENTRY AND THE VALUE   10444000
     TRUE IS RETURNED; OTHERWISE THE VALUE FALSE IS RETURNED>>          10446000
   VALUE INFOADR;                                                       10448000
   DOUBLE INFOADR;                                                      10450000
   BEGIN                                                                10452000
   @RLENTP _ @RLTABLE;  <<INIT. ENTRY POINTER>>                         10454000
   TOS _ NRRLENT;  <<ENTRY COUNTER>>                                    10456000
   WHILE <> DO                                                          10458000
      BEGIN                                                             10460000
      IF RLENTDP = INFOADR THEN                                         10462000
         BEGIN                                                          10464000
         SEARCHRLTAB _ TRUE;                                            10466000
         RETURN                                                         10468000
         END;                                                           10470000
      @RLENTP _ @RLENTP+3;  <<NEXT ENTRY>>                              10472000
      TOS _ TOS-1                                                       10474000
      END                                                               10476000
   END;                                                                 10478000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - PARMLEN"          <<00207>>10480000
<<----------------------------------------------------------------------10482000
*                                                                      *10484000
*  CODE SEGMENT PREPARATION PROCEDURES                                 *10486000
*                                                                      *10488000
---------------------------------------------------------------------->>10490000
                                                                        10492000
$ CONTROL SEGMENT = SEG3                                                10494000
INTEGER PROCEDURE PARMLEN (PARMS);                                      10496000
   <<DETERMINES THE NUMBER OF WORDS IN THE SPECIFIED PARAMETER          10498000
     INFORMATION ARRAY>>                                                10500000
   INTEGER ARRAY PARMS;                                                 10502000
   BEGIN                                                                10504000
   INTEGER P = Q+1;                                                     10506000
   TOS _ PARMS.(0:2);  <<VALUE OF P>>                                   10508000
   PARMLEN _ IF = THEN 1 ELSE IF P = 3 THEN PARMS.(2:6)+2 ELSE 2        10510000
   END;                                                                 10512000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - PARMCHECK"        <<00207>>10514000
$ CONTROL SEGMENT = SEG3                                                10516000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                   <<00595>>10518000
   INTEGER ARRAY FORMALP,ACTUALP,PARMS;                        <<00595>>10520000
   BEGIN                                                                10522000
   INTEGER P = Q+1;  <<LEVEL OF CHECKING>>                     <<00595>>10524000
   INTEGER POINTER PARMMAP = Q+2; <<BAD PARMS BIT MAP>>        <<00595>>10526000
                                                                        10528000
   <<* * * LEVEL 0 - NO CHECKING * * *>>                                10530000
                                                                        10532000
   PARMS := 0;                                                 <<00595>>10534000
   MOVE PARMS(1) := PARMS,(4);                                 <<00595>>10536000
   TOS _ MIN2(FORMALP.(0:2),ACTUALP.(0:2));  <<CHECKING LEVEL>>         10538000
   ASSEMBLE(TEST);                                                      10540000
   IF = THEN GO MATCH;                                                  10542000
   TOS := @PARMS(1);  <<INITIALIZE PARMMAP>>                   <<00595>>10544000
                                                                        10546000
   <<* * * LEVEL 1 - PROCEDURE TYPE * * *>>                             10548000
                                                                        10550000
   TOS _ FORMALP(1);                                                    10552000
   IF = THEN GO L1;                                                     10554000
   TOS _ ACTUALP(XREG);                                                 10556000
   IF = THEN GO L1;                                                     10558000
   IF TOS <> TOS OR                                            <<00595>>10560000
      FORMALP.(8:8) <> ACTUALP.(8:8) THEN                      <<00595>>10562000
      BEGIN                                                    <<00595>>10564000
      PARMS := 1;                                              <<00595>>10566000
      RETURN;                                                  <<00595>>10568000
      END;                                                     <<00595>>10570000
   L1: IF P = 1 THEN GO MATCH;                                          10572000
                                                                        10574000
   <<* * * LEVEL 2 - NUMBER OF PARAMETERS * * *>>                       10576000
                                                                        10578000
   TOS _ FORMALP.(2:6);                                                 10580000
   TOS _ ACTUALP.(2:6);                                                 10582000
   ASSEMBLE(DDUP,CMP);                                                  10584000
   IF <> THEN                                                  <<00595>>10586000
      BEGIN                                                    <<00595>>10588000
      PARMS := 2;                                              <<00595>>10590000
      RETURN;                                                  <<00595>>10592000
      END;                                                     <<00595>>10594000
   IF P = 2 THEN GO MATCH;                                              10596000
                                                                        10598000
   <<* * * LEVEL 3 - PARAMETER TYPES * * *>>                            10600000
                                                                        10602000
   ASSEMBLE(DEL,TEST);                                                  10604000
   IF = THEN GO MATCH;  <<CHECK FOR NO PARM'S>>                         10606000
   AGAIN:                                                               10608000
   XREG _ XREG+1;                                                       10610000
   TOS _ FORMALP(XREG);                                                 10612000
   IF = THEN GO DEL1;                                                   10614000
   TOS _ ACTUALP(XREG);                                                 10616000
   IF = THEN GO DEL2;                                                   10618000
                                                               <<02817>>10620000
   << Check for PASCAL user-defined type. >>                   <<02817>>10622000
                                                               <<02817>>10624000
   if FormalP(Xreg) < 0 or ActualP(Xreg) < 0 then              <<02817>>10626000
      begin                                                    <<02817>>10628000
      if FormalP(Xreg) <> ActualP(Xreg) then                   <<02817>>10630000
         begin                                                 <<02817>>10632000
         Parms := 3;                                           <<02817>>10634000
         SetBit(ParmMap, Xreg - 2);                            <<02817>>10636000
         end;                                                  <<02817>>10638000
      go DEL2;                                                 <<02817>>10640000
      end;                                                     <<02817>>10642000
                                                                        10644000
   <<CHECK MODE>>                                                       10646000
                                                                        10648000
   TOS _ FORMALP(XREG).(0:4);                                           10650000
   TOS _ ACTUALP(XREG).(0:4);                                           10652000
   ASSEMBLE(DDUP,CMP);                                                  10654000
   IF <> THEN                                                           10656000
      IF S0 <> 4 AND S1 <> 4 THEN                              <<00595>>10658000
         BEGIN                                                 <<00595>>10660000
         PARMS := 3;                                           <<00595>>10662000
         SETBIT( PARMMAP, XREG-2);                             <<00595>>10664000
         END;                                                  <<00595>>10666000
                                                                        10668000
   <<CHECK STRUCTURE>>                                                  10670000
                                                                        10672000
   TOS _ FORMALP(XREG).(4:6);                                           10674000
   TOS _ ACTUALP(XREG).(4:6);                                           10676000
   ASSEMBLE(DDUP,CMP);                                                  10678000
   IF <> THEN                                                           10680000
      IF S1 <> 0 OR S0 <> 1 AND S0 <> 2 THEN                   <<00595>>10682000
         BEGIN                                                 <<00595>>10684000
         PARMS := 3;                                           <<00595>>10686000
         SETBIT( PARMMAP, XREG-2);                             <<00595>>10688000
         END;                                                  <<00595>>10690000
                                                                        10692000
   <<CHECK TYPE>>                                                       10694000
                                                                        10696000
   TOS _ FORMALP(XREG).(10:6);                                          10698000
   TOS _ ACTUALP(XREG).(10:6);                                          10700000
   ASSEMBLE(DDUP,CMP);                                                  10702000
   IF <> THEN                                                           10704000
      IF S0 <> 11 AND S1 <> 11 THEN                            <<00595>>10706000
         BEGIN                                                 <<00595>>10708000
         PARMS := 3;                                           <<00595>>10710000
         SETBIT( PARMMAP, XREG-2);                             <<00595>>10712000
         END;                                                  <<00595>>10714000
                                                                        10716000
   ASSEMBLE(SUBS 6);                                                    10718000
   DEL2: DEL;                                                           10720000
   DEL1: DEL;                                                           10722000
   ASSEMBLE(DABZ MATCH);                                                10724000
   GO AGAIN;                                                            10726000
                                                                        10728000
   MATCH:                                                      <<00595>>10730000
   END;                                                        <<00595>>10732000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - EMITPLABEL"       <<00207>>10734000
$ CONTROL SEGMENT = SEG21                                               10736000
PROCEDURE EMITPLABEL;                                                   10738000
   <<ALLOCATES (IF NECESSARY) AND INITIALIZES (IF NECESSARY) A          10740000
     P-LABEL IN THE STT.  THE STT NUMBER IS PLACED IN THE SYMBOL        10742000
     TABLE ENTRY AND THE PROCEDURE NAME AND STT NUMBER ARE              10744000
     WRITTEN.  IT IS ASSUMED THAT THE SYMBOL TABLE PARAMETERS ARE       10746000
     SET FOR THE PROCEDURE ENTRY IN QUESTION.  NOTE THAT THIS           10748000
     PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>           10750000
   BEGIN                                                                10752000
                                                                        10754000
   SUBROUTINE PRINTNAME (SEGNR);                                        10756000
      <<PRINTS THE SYMBOL TABLE ENTRY NAME AND STT NUMBER OF THE        10758000
        EXTERNAL STT ENTRY JUST ALLOCATED.  IF THE EXTERNAL LABEL       10760000
        CORRESPONDS TO AN INTERNAL PROCEDURE, IT'S SEGMENT NUMBER       10762000
        IS PRINTED ALSO>>                                               10764000
      VALUE SEGNR; INTEGER SEGNR;                                       10766000
      BEGIN                                                             10768000
      TOS _ @BLINE(3); TOS _ @SNAME&LSL(1)+1;                           10770000
      MOVE * _ *,(SYMNC);                                               10772000
      NTOA(STTNR,8,BLINE(21));  <<STT NR.>>                             10774000
      IF SEGNR = -1                                                     10776000
         THEN BLINE(37) _ "?"  <<EXTERNAL PROCEDURE>>                   10778000
         ELSE NTOA(SEGNR,8,BLINE(37));  <<INTERNAL PROC.>>              10780000
      PRINTLINE                                                         10782000
      END;                                                              10784000
                                                                        10786000
   IF SYMTYPE = 7 THEN  <<EXTERNAL PROCEDURE>>                          10788000
      IF SXNL = 0 OR SXLSEGNR <> CSTNR THEN  <<EMIT P-LABEL?>>          10790000
         BEGIN                                                          10792000
         PRINTNAME(-1);                                                 10794000
         SXNL _ SXNL+1;  <<BUMP P-LABEL COUNT NOW!>>                    10796000
         EXPANDSYMENT(SXPARMS,1);  <<EXPAND ENTRY>>                     10798000
         IF < THEN GO NFG;  <<ERROR?>>                                  10800000
         SXLPLABEL _ CSTNR CAT STTNR (0:8:8);  <<NEW P-LABEL LOCATION>> 10802000
         STTNR _ STTNR+1                                                10804000
         END                                                            10806000
      ELSE                                                              10808000
   ELSE IF SXSTTNR = 0 THEN  <<INTERNAL PROCEDURE>>                     10810000
      BEGIN                                                             10812000
      TOS _ SPLABEL;  <<LOAD DEFINING P-LABEL>>                         10814000
      IF < THEN  <<ILLEGAL P-LABEL?>>                                   10816000
         BEGIN                                                          10818000
         ERRORS(43,SNAME);                                              10820000
         GO NFG                                                         10822000
         END;                                                           10824000
      SETBIT0;  <<SET "EXTERNAL" BIT>>                                  10826000
      STT(-STTNR) _ TOS;  <<INSERT P-LABEL IN STT>>                     10828000
      PRINTNAME(SSEGNR);                                                10830000
      SXSTTNR _ STTNR;  <<INSERT STT NR. OF P-LABEL>>                   10832000
      STTNR _ STTNR+1                                                   10834000
      END;                                                              10836000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    10838000
   GO GETOUT;                                                           10840000
                                                                        10842000
   NFG:                                                                 10844000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 10846000
                                                                        10848000
   GETOUT:                                                              10850000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             10852000
   END;                                                                 10854000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - MAKEPATCHES"      <<00207>>10856000
$ CONTROL SEGMENT = SEG21                                               10858000
PROCEDURE MAKEPATCHES;                                                  10860000
   <<EMPTIES THE PATCH TABLE BY MAKING ALL PATCHES.  NOTE THAT THIS     10862000
     PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>           10864000
   BEGIN                                                                10866000
   DEFINE EXITPROC = ASSEMBLE(EXIT 0)#;                                 10868000
   INTEGER ARRAY BUFFER(0:127);                                         10870000
   INTEGER I,TYPE,RECD,DISP,LINK;                                       10872000
   LOGICAL SUBROUTINE GETNEXTPATCH;                                     10874000
      <<LOOKS AT THE LINK FOR THE NEXT PATCH.  IF THE PATCH IS IN       10876000
        THE CURRENT RECORD, THE DISPLACEMENT ENTRY IN THE CURRENT       10878000
        PATCH ENTRY IS UPDATED.  IF THE PATCH IS IN ANOTHER RECORD,     10880000
        THE DISPLACEMENT ENTRY IN THE CURRENT PATCH ENTRY IS            10882000
        UPDATED AND THE PATCH ENTRY IS MOVED TO THE CORRESPONDING       10884000
        LIST.  IN BOTH CASES A VALUE OF TRUE IS RETURNED.  IF THE       10886000
        PATCH IS FINISHED, THE CURRENT PATCH ENTRY IS REMOVED FROM      10888000
        THE LIST AND A VALUE OF FALSE IS RETURNED.  NOTE THAT IN ALL    10890000
        CASES IT IS ASSUMED THAT THE LINK IS A NEGATIVE DISPLACEMENT    10892000
        TO THE NEXT ENTRY>>                                             10894000
      IF LINK = 0 THEN  <<FINISHED WITH ENTRY?>>                        10896000
         PATCH(I) _ PATCHP(1)  <<REMOVE ENTRY>>                         10898000
      ELSE                                                              10900000
         BEGIN                                                          10902000
         GETRECDDISP(DOUBLE(DISP-LINK),RECD,DISP);                      10904000
         IF RECD <> 0 THEN  <<LIST LEAVES RECORD?>>                     10906000
            BEGIN                                                       10908000
            IF RECD+I < 0 THEN  <<LINK OUT OF SEGMENT?>>                10910000
               BEGIN                                                    10912000
               ERROR(81);                                               10914000
               EXITPROC                                                 10916000
               END;                                                     10918000
            PATCHP.(0:8) _ DISP;  <<INSERT NEW DISP>>                   10920000
            TOS _ PATCHP(1);  <<TEMP SAVE LINK>>                        10922000
            PATCHP(1) _ PATCH(I+RECD);  <<INSERT NEW LINK>>             10924000
            PATCH(I+RECD) _ PATCH(I);                                   10926000
            PATCH(I) _ TOS                                              10928000
            END                                                         10930000
         ELSE GETNEXTPATCH _ TRUE                                       10932000
         END;                                                           10934000
   SUBROUTINE PATCH1;                                                   10936000
      <<MAKES PCAL AND LLBL PATCHES TO THE CURRENT RECORD>>             10938000
      DO BEGIN                                                          10940000
         LINK _ BUFFER(DISP);  <<SAVE LINK>>                            10942000
         TOS _ IF < THEN %033400 ELSE %031000;                          10944000
         TOS _ TOS+PATCHP(2);  <<INSERT STT NR.>>                       10946000
         BUFFER(DISP) _ TOS;  <<INSERT INSTRUCTION>>                    10948000
         LINK _ LINK.(2:14)  <<STRIP FLAG BITS>>                        10950000
         END UNTIL NOT GETNEXTPATCH;                                    10952000
   SUBROUTINE PATCH2;                                                   10954000
      <<MAKES PB ADDRESS OR OWN/DATA POINTER PATCH TO THE CURRENT       10956000
        RECORD>>                                                        10958000
      BEGIN                                                             10960000
      BUFFER(DISP) _ BUFFER(DISP)+PATCHP(2);  <<CORRECT ADR>>           10962000
      PATCH(I) _ PATCHP(1)  <<REMOVE ENTRY>>                            10964000
      END;                                                              10966000
   SUBROUTINE PATCH3;                                                   10968000
      <<MAKES PATCHES FOR EXTERNAL OR COMMON VARIABLES>>                10970000
      DO BEGIN                                                          10972000
         LINK _ BUFFER(DISP).(8:8);  <<SAVE LINK>>                      10974000
         BUFFER(DISP).(8:8) _ PATCHP(2)  <<DB ADDRESS>>                 10976000
         END UNTIL NOT GETNEXTPATCH;                                    10978000
   SUBROUTINE PATCH4;                                                   10980000
      <<MAKES PATCHES FOR FORMAT STRINGS>>                              10982000
      DO BEGIN                                                          10984000
         LINK _ BUFFER(DISP).(2:14);  <<SAVE LINK>>                     10986000
         TOS _ PATCHP(2);  <<WORD DATA LABEL>>                          10988000
         IF BUFFER(DISP) < 0 THEN TOS _ TOS&LSL(1);  <<BYTE LABEL>>     10990000
         BUFFER(DISP) _ TOS  <<INSERT DATA LABEL>>                      10992000
         END UNTIL NOT GETNEXTPATCH;                                    10994000
   subroutine Patch5;                                          <<04102>>10996000
      << NOPs TOOLBOX symbolic debug calls >>                  <<04102>>10998000
      do                                                       <<04102>>11000000
         begin                                                 <<04102>>11002000
         Link := Buffer(Disp).(2:14);  << Link to next PCAL >> <<04102>>11004000
         Buffer(Disp) := 0;            << NOP current PCAL >>  <<04102>>11006000
         end                                                   <<04102>>11008000
      until not GetNextPatch;                                  <<04102>>11010000
   CONDCODE _ CCL;  <<ERROR CONDITION CODE>>                            11012000
   I _ 127;                                                             11014000
   DO BEGIN                                                             11016000
      IF PATCH(I) <> -1 THEN  <<NON-EMPTY PATCH LIST?>>                 11018000
         BEGIN                                                          11020000
         IF SEGRECD+I = TRECD1  <<CODE IN BUFFER?>>                     11022000
            THEN MOVE BUFFER _ TBUF1,(TDISP1)  <<IN BUFFER>>            11024000
            ELSE FREADDIR'(SEGFNUM,BUFFER,SEGRECD+I);  <<ON DISC>>      11026000
         WHILE PATCH(I) <> -1 DO  <<MAKE PATCHES IN LIST>>              11028000
            BEGIN                                                       11030000
            @PATCHP _ @PTABLE(PATCH(I));  <<SET ENTRY POINTER>>         11032000
            DISP _ PATCHP.(0:8);  <<RECORD DISP OF PATCH>>              11034000
            TYPE _ PATCHP.(8:8);  <<PATCH ENTRY TYPE>>                  11036000
            CASE TYPE-1 OF                                              11038000
               BEGIN                                                    11040000
               PATCH1;  <<PCAL INSTRUCTION>>                            11042000
               PATCH2;  <<PB ADR OR OWN/DATA DATA LABEL>>               11044000
               PATCH3;  <<EXTERNAL/COMMON VARIABLE>>                    11046000
               Patch4;  << FORMAT string >>                    <<04102>>11048000
               Patch5;  << NOP symbolic debug PCALs >>         <<04102>>11050000
               END                                                      11052000
            END;                                                        11054000
         IF SEGRECD+I = TRECD1  <<CODE IN BUFFER?>>                     11056000
            THEN MOVE TBUF1 _ BUFFER,(TDISP1)  <<IN BUFFER>>            11058000
            ELSE FWRITEDIR'(SEGFNUM,BUFFER,SEGRECD+I)  <<ON DISC>>      11060000
         END;                                                           11062000
      I _ I-1                                                           11064000
      END UNTIL <;                                                      11066000
   USEDPATCH _ 0;  <<RESET USED SPACE COUNT>>                           11068000
   @DLAVAIL _ @PTABLE;  <<RESET DL AVAILABLE AREA POINTER>>             11070000
   CONDCODE _ CCE  <<OK CONDITION CODE>>                                11072000
   END;                                                                 11074000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER9S"         <<00207>>11076000
$ CONTROL SEGMENT = SEG21                                               11078000
PROCEDURE HEADER9S;                                                     11080000
   <<HEADER TYPE 9 FOR COMMON ARRAY.  NOTE THAT THIS PROCEDURE USES THE 11082000
     CONDITION CODE TO INDICATE AN ERROR>>                              11084000
   BEGIN                                                                11086000
   LOGICAL FLAG := FALSE; <<BLANK COMMON?>>                    <<CM.DM>>11088000
   DOUBLE POINTER SDATALABELD;                                 <<01124>>11090000
                                                               <<01124>>11092000
   LOGICAL SUBROUTINE SEARCHSYMCOM(TYPE,DLABEL);               <<01124>>11094000
      VALUE DLABEL,TYPE;                                       <<01124>>11096000
      INTEGER DLABEL,TYPE;                                     <<01124>>11098000
   BEGIN                                                       <<01124>>11100000
      @SDATALABELD := @SYMP2;                                  <<01124>>11102000
      WHILE @SDATALABELD < @SYMP(SYMNW) DO                     <<01124>>11104000
         BEGIN                                                 <<01124>>11106000
         IF DS2 = SDATALABELD  THEN                            <<01124>>11108000
            BEGIN                                              <<01124>>11110000
            SEARCHSYMCOM := TRUE;                              <<01124>>11112000
            RETURN;                                            <<01124>>11114000
            END;                                               <<01124>>11116000
         @SDATALABELD := @SDATALABELD+2;                       <<01124>>11118000
         END;                                                  <<01124>>11120000
   END;                                                        <<01124>>11122000
                                                               <<01124>>11124000
   IF HEADP(2).(4:4) = 4 THEN  <<NAME = "COM'">>                        11126000
      BEGIN                                                             11128000
      TOS _ @HEADP(XREG)&LSL(1);                                        11130000
      TOS _ @BLANKCOMMON&LSL(1);                                        11132000
      ASSEMBLE(INCA,INCB);                                              11134000
      IF * = *,(4) THEN FLAG := TRUE;                          <<CM.FX>>11136000
      END;                                                              11138000
                                                                        11140000
   <<* * * ALLOCATE COMMON ARRAY * * *>>                                11142000
                                                                        11144000
   IF SEARCHSYM(HEADP(2),SYMCOMMON) THEN                       <<01124>>11148000
      BEGIN  << OLD COMMON >>                                  <<01124>>11150000
      IF HEADP(1) <> SNWCA AND NOT FLAG THEN                   <<01124>>11152000
         WARNS2(67,SNAME,ENAME);                               <<01124>>11154000
      IF HEADP(1) > SNWCA THEN SNWCA := HEADP(1);<<NEW LENGTH>><<01124>>11156000
      END                                                      <<01124>>11158000
   ELSE                                                        <<01124>>11160000
      BEGIN << NEW COMMON ARRAY >>                             <<01124>>11162000
      CREATESYMENT(6,HEADP(2),BUF); <<CREATE SYM. TAB. ENTRY>> <<01124>>11164000
      IF < THEN GO NFG;                                        <<01124>>11166000
      SNWCA := HEADP(1); <<LENGTH OF COMMON ARRAY>>            <<01124>>11168000
      NRCOMENT := NRCOMENT+1;<< FLAG THAT COMMON ARRAYS EXIST>><<01124>>11170000
      END;                                                     <<01124>>11172000
                                                               <<01124>>11174000
   <<* * * PROCESS DATA LABELS * * *>>                         <<01124>>11176000
                                                               <<01124>>11178000
   TOS := @HEADP+SYMNAMENW+2;                                  <<01124>>11180000
   WHILE @PS0 < @HEADP(HEADNW) DO                              <<01124>>11182000
      BEGIN                                                    <<01124>>11184000
      IF NOT SEARCHSYMCOM(PS0.(0:1),PS0(1)) THEN               <<01124>>11186000
         BEGIN                                                 <<01124>>11188000
         EXPANDSYMENT(SYMP2,2);<<MAKE ROOM FOR NEW DATA LABEL>><<01124>>11190000
         IF < THEN GO NFG;                                     <<01124>>11192000
         SYMP2 := PS0.(0:1); <<TYPE>>                          <<01124>>11194000
         SYMP2(1) := PS0(1);  <<DATA LABEL>>                   <<01124>>11196000
         END;                                                  <<01124>>11198000
      TOS := PS0.(2:14); TOS := PS1.(1:1);                     <<01124>>11200000
      TOS := TOS+TOS+TOS+2; <<NEXT ADDRESS SET>>               <<01124>>11202000
      END;                                                     <<01124>>11204000
   IF @PS0 <> @HEADP(HEADNW) THEN  << BOUNDS CHECK >>          <<01501>>11206000
      BEGIN                                                    <<01501>>11208000
      ERRORS2(1,ENAME,HEADP(2));                               <<01501>>11210000
      GO NFG;                                                  <<01501>>11212000
      END;                                                     <<01501>>11214000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11216000
   GO GETOUT;                                                           11218000
                                                                        11220000
   NFG:                                                                 11222000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 11224000
                                                                        11226000
   GETOUT:                                                              11228000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             11230000
   END;                                                                 11232000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER9S'"        <<01124>>11234000
$ CONTROL SEGMENT = SEG23                                      <<01124>>11236000
PROCEDURE HEADER9S';                                           <<01124>>11238000
   BEGIN COMMENT                                               <<01124>>11240000
                                                               <<01124>>11242000
      This procedure allocates the space for the               <<01124>>11244000
      common arrays.                                           <<01124>>11246000
;                                                              <<01124>>11248000
   NRCOMENT := 0;                                              <<01124>>11250000
   @SYMP := @STABLE; <<START OF TABLE>>                        <<01124>>11252000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                        <<01124>>11254000
      BEGIN                                                    <<01124>>11256000
      SYMENTPARMS; <<SET UP PARAMETERS>>                       <<01124>>11258000
      IF SYMTYPE = 6 THEN                                      <<01124>>11260000
         BEGIN <<COMMON ARRAY>>                                <<01124>>11262000
         SSACA := NWSDB;  <<S.A. COMMON ARRAY>>                <<01124>>11264000
         NWSDB := NWSDB+SNWCA; <<ADJ. SEC. DB ARRAY>>          <<01124>>11266000
         IF OVERFLOW THEN OVERFLOWFLAG:=1;                     <<02816>>11268000
         TOS := @SYMP2;                                        <<01124>>11270000
         WHILE @PS0 < @SYMP(SYMNW) DO                          <<01124>>11272000
            BEGIN                                              <<01124>>11274000
            TOS := PS0(1)+SSACA;                               <<01124>>11276000
            IF LPS1 THEN TOS := TOS+SSACA;                     <<01124>>11278000
            IF NOT SEARCHCOMMON(S0,PS1) THEN                   <<01124>>11280000
               BEGIN                                           <<01124>>11282000
               CREATECOMENT(S0,PS1);                           <<01124>>11284000
               IF < THEN GO NFG;  <<ERROR>>                    <<01124>>11286000
               END;                                            <<01124>>11288000
            DEL;                                               <<01124>>11290000
            TOS := TOS+2;                                      <<01124>>11292000
            END;                                               <<01124>>11294000
         DEL;                                                  <<01124>>11296000
         END;                                                  <<01124>>11298000
      @SYMP := @SYMP+SYMNW;                                    <<01124>>11300000
      END;                                                     <<01124>>11302000
                                                               <<01124>>11304000
   TOS := CCE;  <<OK CONDITION CODE>>                          <<01124>>11306000
   GO GETOUT;                                                  <<01124>>11308000
                                                               <<01124>>11310000
   NFG:                                                        <<01124>>11312000
   TOS := CCL;  <<ERROR CONDITION CODE>>                       <<01124>>11314000
                                                               <<01124>>11316000
   GETOUT:                                                     <<01124>>11318000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                   <<01124>>11320000
   END;                                                        <<01124>>11322000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER10S"        <<01124>>11324000
$ CONTROL SEGMENT = SEG21                                               11326000
PROCEDURE HEADER10S;                                                    11328000
   <<HEADER TYPE 10 FOR LOGICAL UNITS.  NOTE THAT THIS PROCEDURE USES   11330000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          11332000
   BEGIN                                                                11334000
   LUSPECIFIED _ TRUE;  <<SET FLAG>>                                    11336000
   TOS _ @HEADP(1);  <<ENTRY POINTER>>                                  11338000
   XREG _ 6;                                                            11340000
   DO BEGIN                                                             11342000
      LOGICALUNITS(XREG) _ LOGICALUNITS(XREG) LOR LPS0(XREG);           11344000
      XREG _ XREG-1                                                     11346000
      END UNTIL <                                                       11348000
   END;                                                                 11350000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER1P"         <<00207>>11352000
$ CONTROL SEGMENT = SEG21                                               11354000
PROCEDURE HEADER1P (RLFLAG);                                            11356000
   <<HEADER TYPE 1 FOR PROCEDURE CALLS.  NOTE THAT THIS PROCEDURE USES  11358000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          11360000
   VALUE RLFLAG;                                                        11362000
   LOGICAL RLFLAG;                                                      11364000
   BEGIN                                                                11366000
   ARRAY PARMS1(0:4)=Q;                                        <<00595>>11368000
   ARRAY PARMS2(0:4)=Q;                                        <<00595>>11370000
   INTEGER POINTER PROCNAME = Q+11;                            <<00595>>11372000
   INTEGER POINTER PROCPARMS = Q+12;                           <<00595>>11374000
   INTEGER NWPARMS = Q+13;                                     <<00595>>11376000
   INTEGER POINTER NEWPARMS = Q+14;                            <<00595>>11378000
                                                                        11380000
   SUBROUTINE UPGRADE;                                                  11382000
      <<UPGRADES A PROCEDURE OR PARAMETER DESCRIPTOR: SELECTS THE NON-  11384000
        UNIVERSAL DESCRIPTOR, NON-UNIVERSAL MODE, NON-UNIVERSAL TYPE    11386000
        AND OVERRIDES AN ARRAY STRUCTURE WITH A SIMPLE VARIABLE         11388000
        STRUCTURE>>                                                     11390000
      BEGIN                                                             11392000
      IF SXPARMS(XREG) = 0 THEN TOS _ PROCPARMS(XREG)                   11394000
      ELSE IF PROCPARMS(XREG) = 0 THEN TOS _ SXPARMS(XREG)              11396000
      ELSE                                                              11398000
         BEGIN                                                          11400000
         TOS _ SXPARMS(XREG);                                           11402000
         TOS.(0:4) _ MIN2(SXPARMS(XREG).(0:4),PROCPARMS(XREG).(0:4));   11404000
         TOS.(4:6) _ MIN2(SXPARMS(XREG).(4:6),PROCPARMS(XREG).(4:6));   11406000
         TOS.(10:6) _ MIN2(SXPARMS(XREG).(10:6),PROCPARMS(XREG).(10:6)) 11408000
         END;                                                           11410000
      NEWPARMS(XREG) _ TOS  <<INSERT NEW DESCRIPTOR>>                   11412000
      END;                                                              11414000
                                                                        11416000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           11418000
                                                                        11420000
   TOS _ @HEADP(2);  <<PROCEDURE NAME>>                                 11422000
   TOS := PROCNAME.(4:3)+1+@PROCNAME;  <<PROC. PARM. INFO>>             11424000
   ASSEMBLE(DDUP,ZROB);                                                 11426000
   TOS := PARMLEN(*);  <<PARM. INFO LENGTH>>                            11428000
   TOS _ 0;                                                             11430000
                                                                        11432000
   <<* * * PROCESS PROCEDURE * * *>>                                    11434000
                                                                        11436000
   if (HeadP(2).(3:1) = 1) and not SymDBug then                <<04102>>11438000
      CreatePatchEnt(5, UnitAdr + HeadP(1))  << Patch the PCAL <<04102>>11440000
   else                                                        <<04102>>11442000
      CreatePatchEnt(1, UnitAdr + HeadP(1)); << NOP the PCAL >><<04102>>11444000
   IF < THEN GO NFG;  <<ERROR?>>                                        11446000
   IF NOT SEARCHSYM(PROCNAME,IF RLFLAG THEN SYMRLPROC ELSE SYMPROC) THEN11448000
      BEGIN                                                             11450000
      CREATESYMENT(7,PROCNAME,PROCPARMS);  <<CREATE SYM. TAB. ENTRY>>   11452000
      IF < THEN GO NFG;  <<ERROR?>>                                     11454000
      SXNL _ 0;  <<INIT. NR. P-LABELS>>                                 11456000
      EMITPLABEL;                                                       11458000
      IF < THEN GO NFG;  <<ERROR?>>                                     11460000
      TOS _ SXLSTTNR  <<STT NR.>>                                       11462000
      END                                                               11464000
   ELSE IF SYMTYPE = 7 THEN  <<OLD EXTERNAL PROCEDURE>>                 11466000
      BEGIN                                                             11468000
      EMITPLABEL;                                                       11470000
      IF < THEN GO NFG; <<ERROR?>>                                      11472000
                                                                        11474000
      <<* * * CHECK PARAMETER CONSISTENCY * * *>>                       11476000
                                                                        11478000
      PARMCHECK(SXPARMS,PROCPARMS,PARMS1);                     <<00595>>11482000
      PARMCHECK(PROCPARMS,SXPARMS,PARMS2);                     <<00595>>11484000
      TOS := 0;  <<FLAG - BAD PARM IN BIT MAP>>                <<00595>>11486000
      XREG := 4;                                               <<00595>>11488000
      DO BEGIN                                                 <<00595>>11490000
         PARMS1(XREG) := PARMS1(XREG) LAND PARMS2(XREG);       <<00595>>11492000
         IF <> THEN TOS := TOS+1;  <<SET FLAG!>>               <<00595>>11494000
         XREG := XREG-1;                                       <<00595>>11496000
         END UNTIL =;                                          <<00595>>11498000
      PARMS1 := MIN2(PARMS1,PARMS2);                           <<00595>>11500000
      IF TOS <> 0 OR PARMS1 < 3 THEN                           <<00595>>11502000
         CASE PARMS1 OF                                        <<00595>>11504000
            BEGIN                                              <<00595>>11506000
            ;         <<NO ERROR>>                             <<00595>>11508000
            BEGIN     <<BAD FUNCTION>>                         <<00595>>11510000
            ERRORS2(49,PROCNAME,ENAME);                        <<00595>>11512000
            PREPERROR := PREPERROR+1;                          <<00595>>11514000
            END;                                               <<00595>>11516000
            BEGIN     <<BAD NR PARMS>>                         <<00595>>11518000
            ERRORS2(50,PROCNAME,ENAME);                        <<00595>>11520000
            PREPERROR := PREPERROR+1;                          <<00595>>11522000
            END;                                               <<00595>>11524000
            BEGIN     <<BAD PARMS>>                            <<00595>>11526000
            ERRORS2(45,PROCNAME,ENAME);                        <<00595>>11528000
            PRINTBITMAP( PARMS1(1));                           <<00595>>11530000
            PREPERROR := PREPERROR+1;                          <<00595>>11532000
            END;                                               <<00595>>11534000
            END; <<CASE>>                                      <<00595>>11536000
      @NEWPARMS _ IF PROCPARMS.(0:2) > SXPARMS.(0:2) THEN               11538000
         @PROCPARMS ELSE @SXPARMS;                                      11540000
                                                                        11542000
      <<UPGRADE PROCEDURE DESCRIPTOR>>                                  11544000
                                                                        11546000
      IF MIN2(SXPARMS.(0:2),PROCPARMS.(0:2)) >= 1 THEN                  11548000
         BEGIN                                                          11550000
         XREG _ 1;                                                      11552000
         UPGRADE                                                        11554000
         END;                                                           11556000
                                                                        11558000
      <<UPGRADE PARAMETER DESCRIPTORS>>                                 11560000
                                                                        11562000
      IF SXPARMS.(0:2) = 3 AND PROCPARMS.(0:2) = 3 THEN                 11564000
         BEGIN                                                          11566000
         XREG _ 2;                                                      11568000
         TOS _ SXPARMS.(2:6);  <<NR. PARAMETERS>>                       11570000
         WHILE <> DO                                                    11572000
            BEGIN                                                       11574000
            UPGRADE;                                                    11576000
            ASSEMBLE(INCX,DECA)                                         11578000
            END                                                         11580000
         END;                                                           11582000
                                                                        11584000
      <<INSERT NEW PARAMETER INFO>>                                     11586000
                                                                        11588000
      TOS _ PARMLEN(NEWPARMS);                                          11590000
      TOS _ PARMLEN(SXPARMS);                                           11592000
      ASSEMBLE(DDUP,CMP);                                               11594000
      IF > THEN  <<EXPAND ENTRY?>>                                      11596000
         BEGIN                                                          11598000
         EXPANDSYMENT(SXPARMS,S1-S0);  <<EXPAND ENTRY>>                 11600000
         IF < THEN GO NFG  <<ERROR?>>                                   11602000
         END;                                                           11604000
                                                                        11606000
      MOVE SXPARMS _ NEWPARMS,(S1);  <<INSERT PARM. INFO>>              11608000
      TOS _ SXLSTTNR  <<STT NR.>>                                       11610000
      END                                                               11612000
   ELSE  <<INTERNAL PROCEDURE>>                                         11614000
      BEGIN                                                             11616000
      PARMCHECK(SPARMS,PROCPARMS,PARMS1);                      <<00595>>11620000
      PREPERROR := PREPERROR+1;                                <<00595>>11622000
      CASE PARMS1 OF                                           <<00595>>11624000
         BEGIN                                                 <<00595>>11626000
         PREPERROR := PREPERROR-1;                             <<00595>>11628000
         ERRORS2(49,PROCNAME,ENAME);                           <<00595>>11630000
         ERRORS2(50,PROCNAME,ENAME);                           <<00595>>11632000
         BEGIN                                                 <<00595>>11634000
            ERRORS2(45,PROCNAME,ENAME);                        <<00595>>11636000
            PRINTBITMAP(PARMS1(1));                            <<00595>>11638000
         END;                                                  <<00595>>11640000
         END;                                                  <<00595>>11642000
      IF SSEGNR = CSTNR THEN  <<USE LOCAL P-LABEL?>>                    11644000
         TOS _ SSTTNR  <<STT NR.>>                                      11646000
      ELSE  <<USE EXTERNAL P-LABEL>>                                    11648000
         BEGIN                                                          11650000
         EMITPLABEL;                                                    11652000
         IF < THEN GO NFG;  <<ERROR?>>                                  11654000
         TOS _ SXSTTNR  <<STT NR.>>                                     11656000
         END                                                            11658000
      END;                                                              11660000
   PATCHP(2) _ TOS;  <<INSERT STT NR.>>                                 11662000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11664000
   GO GETOUT;                                                           11666000
                                                                        11668000
   NFG:                                                                 11670000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 11672000
                                                                        11674000
   GETOUT:                                                              11676000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             11678000
   END;                                                                 11680000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER2P"         <<00207>>11682000
$ CONTROL SEGMENT = SEG21                                               11684000
PROCEDURE HEADER2P;                                                     11686000
   <<HEADER TYPE 2 FOR PB ADDRESSES.  NOTE THAT THIS PROCEDURE USES THE 11688000
     CONDITION CODE TO INDICATE AN ERROR>>                              11690000
   BEGIN                                                                11692000
   TOS _ @HEADP(1);  <<PB ADDRESS POINTER>>                             11694000
   TOS _ HEADNW-1;  <<PB ADDRESS COUNTER>>                              11696000
   WHILE <> DO                                                          11698000
      BEGIN                                                             11700000
      CREATEPATCHENT(2,UNITADR+PS1);  <<CREATE PATCH ENTRY>>            11702000
      IF < THEN  <<ERROR?>>                                             11704000
         BEGIN                                                          11706000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           11708000
         GO GETOUT                                                      11710000
         END;                                                           11712000
      PATCHP(2) _ UNITADR;  <<CORRECTION TERM>>                         11714000
      ASSEMBLE(INCB,DECA)                                               11716000
      END;                                                              11718000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11720000
                                                                        11722000
   GETOUT:                                                              11724000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             11726000
   END;                                                                 11728000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER3P"         <<00207>>11730000
$ CONTROL SEGMENT = SEG21                                               11732000
PROCEDURE HEADER3P;                                                     11734000
   <<HEADER TYPE 3 FOR OWN/DATA VARIABLES.  NOTE THAT THIS PROCEDURE    11736000
     USES THE CONDITION CODE TO INDICATE AN ERROR>>                     11738000
   BEGIN                                                                11740000
   TOS _ @HEADP(1);  <<ADDRESS POINTER>>                                11742000
   TOS _ HEADNW-1;  <<ADDRESS COUNTER>>                                 11744000
   WHILE <> DO                                                          11746000
      BEGIN                                                             11748000
      CREATEPATCHENT(2,UNITADR+PS1.(1:15));  <<CREATE PATCH ENTRY>>     11750000
      IF < THEN  <<ERROR?>>                                             11752000
         BEGIN                                                          11754000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           11756000
         GO GETOUT                                                      11758000
         END;                                                           11760000
      TOS _ SDBADR;  <<WORD CORRECTION TERM>>                           11762000
      IF LPS2.(0:1) THEN TOS _ TOS&LSL(1);  <<BYTE CORRECTION TERM>>    11764000
      PATCHP(2) _ TOS;  <<INSERT CORRECTION TERM>>                      11766000
      ASSEMBLE(INCB,DECA)                                               11768000
      END;                                                              11770000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11772000
                                                                        11774000
   GETOUT:                                                              11776000
   CONDCODE _ TOS  <<STORE CONDITION CDOE>>                             11778000
   END;                                                                 11780000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER4P"         <<00207>>11782000
$ CONTROL SEGMENT = SEG21                                               11784000
PROCEDURE HEADER4P;                                                     11786000
   <<HEADER TYPE 4 FOR SEC. DB/OWN/DATA INITIAL VALUES>>                11788000
   BEGIN                                                                11790000
   IF HEADP(2) < 0                                                      11792000
      THEN BUFFERDATABYTES(SDBADR&LSL(1)+HEADP(1),HEADP(4),HEADP(3),    11794000
         HEADP(2).(1:15))                                               11796000
      ELSE BUFFERDATAWORDS(SDBADR+HEADP(1),HEADP(3),HEADNW-3,HEADP(2))  11798000
   END;                                                                 11800000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER7P"         <<00207>>11802000
$ CONTROL SEGMENT = SEG21                                               11804000
PROCEDURE HEADER7P;                                                     11806000
   <<HEADER TYPE 7 FOR EXTERNAL VARIABLE.  NOTE THAT THIS PROCEDURE     11808000
     USES THE CONDITION CODE TO INDICATE AN ERROR>>                     11810000
   BEGIN                                                                11812000
   IF NOT SEARCHSYM(HEADP(2),SYMGLOBAL) THEN  <<NOT GLOBAL?>>           11814000
      BEGIN                                                             11816000
      ERRORS(63,HEADP(2));                                              11818000
      GO NFG                                                            11820000
      END;                                                              11822000
   IF HEADP(1) <> 0 AND SGTN <> 0 AND HEADP(1) <> SGTN THEN             11824000
      BEGIN                                                             11826000
      ERRORS(64,HEADP(2));                                              11828000
      GO NFG                                                            11830000
      END;                                                              11832000
   TOS _ @HEADP(2)+HEADP(2).(4:3)+1;  <<WORD FOLLOWING NAME>>           11834000
   IF LOGICAL(HEADP(XREG).(0:1)) THEN  <<TRACED?>>                      11836000
      BEGIN                                                             11838000
      PUSTBUF(PS0).(8:8) _ SGDBA;  <<INSERT DB ADR.>>                   11840000
      @PS0 _ @PS0+1  <<SKIP PUST ADR.>>                                 11842000
      END;                                                              11844000
   TOS _ @HEADP(HEADNW)-@PS0;  <<ADDRESS COUNTER>>                      11846000
   WHILE <> DO                                                          11848000
      BEGIN                                                             11850000
      IF PS1 <> -1 THEN  <<NULL LIST?>>                                 11852000
         BEGIN                                                          11854000
         CREATEPATCHENT(3,UNITADR+PS1);  <<CREATE PATCH ENTRY>>         11856000
         IF < THEN GO NFG;  <<ERROR?>>                                  11858000
         PATCHP(2) _ SGDBA  <<INSERT PRIM. DB ADDRESS>>                 11860000
         END;                                                           11862000
      ASSEMBLE(INCB,DECA)                                               11864000
      END;                                                              11866000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11868000
   GO GETOUT;                                                           11870000
                                                                        11872000
   NFG:                                                                 11874000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 11876000
                                                                        11878000
   GETOUT:                                                              11880000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             11882000
   END;                                                                 11884000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER9P"         <<00207>>11886000
$ CONTROL SEGMENT = SEG21                                               11888000
PROCEDURE HEADER9P;                                                     11890000
   <<HEADER TYPE 9 FOR COMMON ARRAY.  NOTE THAT THIS PROCEDURE USES     11892000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          11894000
   BEGIN                                                                11896000
   INTEGER DBADR := 0; <<DATA LABEL DB ADR.>>                  <<01124>>11900000
                                                                        11902000
   <<* * * PROCESS DATA LABELS * * *>>                                  11904000
                                                                        11906000
   SEARCHSYM(HEADP(2),SYMCOMMON);  <<GET SYM. TAB. ENTRY>>              11908000
   TOS _ @HEADP(2)+SYMNAMENW;  <<ADDRESS SET POINTER>>                  11910000
   WHILE @PS0 < @HEADP(HEADNW) DO                                       11912000
      BEGIN                                                             11914000
      TOS _ 0;  <<FOR PROCEDURE RESULT>>                                11916000
      TOS _ PS1(1);  <<DATA LABEL>>                                     11918000
      TOS _ TOS+SSACA;  <<WORD DATA LABEL>>                    <<01124>>11922000
      IF PS2 < 0 THEN TOS _ TOS+SSACA;  <<BYTE DATA LABEL>>    <<01124>>11924000
      TOS _ PS2.(0:1);  <<TYPE BITS>>                          <<01124>>11926000
      SEARCHCOMMON(*,*);  <<FIND DATA LABEL ENTRY>>                     11928000
      DBADR := (@COMP-@COMTAB)&LSR(1)+NWPDB-NRCOMENT;  <<DB ADR.>>      11930000
      IF LPS0.(1:1) THEN PUSTBUF(PS0(2)).(8:8) := DBADR;  <<TRACED?>>   11932000
      TOS _ PS0.(2:14);  <<LIST COUNTER>>                               11934000
      @PS1 _ PS1.(1:1)+2+@PS1;  <<SET POINTER TO FIRST LIST>>           11936000
      ASSEMBLE(TEST);                                                   11938000
      WHILE <> DO                                                       11940000
         BEGIN                                                          11942000
         IF PS1 <> -1 THEN  <<PATCH CODE?>>                             11944000
            BEGIN                                                       11946000
            CREATEPATCHENT(3,UNITADR+PS1);  <<CREATE PATCH>>            11948000
            IF < THEN GO NFG;  <<ERROR?>>                               11950000
            PATCHP(2) := DBADR  <<DATA LABEL ADR.>>                     11952000
            END;                                                        11954000
         ASSEMBLE(INCB,DECA)                                            11956000
         END;                                                           11958000
      DEL                                                               11960000
      END;                                                              11962000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    11964000
   GO GETOUT;                                                           11966000
                                                                        11968000
   NFG:                                                                 11970000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 11972000
                                                                        11974000
   GETOUT:                                                              11976000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             11978000
   END;                                                                 11980000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER11P"        <<00207>>11982000
$ CONTROL SEGMENT = SEG21                                               11984000
PROCEDURE HEADER11P;                                                    11986000
   <<HEADER TYPE 11 FOR FORMAT STRINGS.  NOTE THAT THIS PROCEDURE USES  11988000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          11990000
   BEGIN                                                                11992000
   CREATEPATCHENT(4,UNITADR+HEADP(1));  <<CREATE PATCH ENTRY>>          11994000
   IF < THEN  <<ERROR?>>                                                11996000
      BEGIN                                                             11998000
      TOS _ CCL;  <<ERROR CONDITION CODE>>                              12000000
      GO GETOUT                                                         12002000
      END;                                                              12004000
   PATCHP(2) _ FORMATADR;  <<INSERT S.A. STRING>>                       12006000
   BUFFERDATAWORDS(FORMATADR,HEADP(3),HEADNW-3,1);  <<INSERT STRING>>   12008000
   FORMATADR _ FORMATADR+HEADNW-3;  <<ADJ. S.A. FORMAT AREA>>           12010000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    12012000
                                                                        12014000
   GETOUT:                                                              12016000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             12018000
   END;                                                                 12020000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADERSIP"        <<04102>>12022000
$CONTROL SEGMENT = SEG21                                       <<04102>>12024000
procedure HeaderSIP(FirstSI);                                  <<04102>>12026000
   logical FirstSI;               << false after first header ><<04102>>12028000
                                                               <<04102>>12030000
   << This subroutine processes TOOLBOX SI headers 12, 13      <<04102>>12032000
   << and 14.                                                  <<04102>>12034000
                                                               <<04102>>12036000
   begin << HeaderSIP >>                                       <<04102>>12038000
                                                               <<04102>>12040000
      if SymDBug then                                          <<04102>>12042000
         begin                                                 <<04102>>12044000
         if FirstSI then                                       <<04102>>12046000
            begin                                              <<04102>>12048000
            ToolboxId := ToolboxId + 1;                        <<04102>>12050000
            FirstSI := false;                                  <<04102>>12052000
            end;                                               <<04102>>12054000
         HeadP(1) := ToolboxId;                                <<04102>>12056000
         CoreBufSI(HeadP, HeadNw);                             <<04102>>12058000
         end;                                                  <<04102>>12060000
                                                               <<04102>>12062000
   end; << HeaderSIP >>                                        <<04102>>12064000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - HEADER15P"        <<02817>>12066000
$CONTROL SEGMENT = SEG21                                       <<02817>>12068000
procedure Header15P;                                           <<02817>>12070000
                                                               <<02817>>12072000
<<*************************************************************<<02817>>12074000
<<                                                             <<02817>>12076000
<< This procedure process USL file header type 15 (private     <<02817>>12078000
<< procedure PCAL) for the PREP operation.  For each entry in  <<02817>>12080000
<< the header, an STT entry for the private procedure is allo- <<02817>>12082000
<< cated and initialized with a local P-label, and an entry in <<02817>>12084000
<< the patch table is created for correction of PCALs to the   <<02817>>12086000
<< private procedure.                                          <<02817>>12088000
<<                                                             <<02817>>12090000
<< GLOBAL INPUT:                                               <<02817>>12092000
<<                                                             <<02817>>12094000
<<    HeadNw - This is the number of words in the header.      <<02817>>12096000
<<                                                             <<02817>>12098000
<<    HeadP - This is a pointer to the 1st word of the header. <<02817>>12100000
<<                                                             <<02817>>12102000
<<    SttPpNr - This is the next STT entry to be used for a    <<02817>>12104000
<<       private procedure P-label.  It will be returned       <<02817>>12106000
<<       incremented by the number of P-labels generated.      <<02817>>12108000
<<                                                             <<02817>>12110000
<<    UnitAdr - This is the PB-relative address of the first   <<02817>>12112000
<<       word of code for the RBM being processed.             <<02817>>12114000
<<                                                             <<02817>>12116000
<< GLOBAL OUTPUT:                                              <<02817>>12118000
<<                                                             <<02817>>12120000
<<    Stt - This is a core image of the STT for the segment    <<02817>>12122000
<<       being constructed.  The entries for the P-labels gen- <<02817>>12124000
<<       erated by this procedure will be updated.             <<02817>>12126000
<<                                                             <<02817>>12128000
<<*************************************************************<<02817>>12130000
                                                               <<02817>>12132000
begin << Header15P >>                                          <<02817>>12134000
                                                               <<02817>>12136000
integer pointer HeaderEntry;      << Current entry >>          <<02817>>12138000
integer pointer HeaderEnd;        << End of header + 1 >>      <<02817>>12140000
                                                               <<02817>>12142000
<< Header15P >>                                                <<02817>>12144000
                                                               <<02817>>12146000
   @HeaderEntry := @HeadP(1);                                  <<02817>>12148000
   @HeaderEnd   := @HeadP + HeadNw;                            <<02817>>12150000
                                                               <<02817>>12152000
   while @HeaderEntry < @HeaderEnd do                          <<02817>>12154000
      begin                                                    <<02817>>12156000
      CreatePatchEnt(1, UnitAdr + HeaderEntry);                <<02817>>12158000
      if < then                                                <<02817>>12160000
         go ABORT;                                             <<02817>>12162000
      PatchP(2) := SttPpNr;                                    <<02817>>12164000
      Stt(-SttPpNr) := UnitAdr + HeaderEntry(1);               <<02817>>12166000
      SttPpNr := SttPpNr + 1;                                  <<02817>>12168000
      @HeaderEntry := @HeaderEntry + 2;                        <<02817>>12170000
      end;                                                     <<02817>>12172000
   CondCode := CCE;                                            <<02817>>12174000
   return;                                                     <<02817>>12176000
                                                               <<02817>>12178000
ABORT:                                                         <<02817>>12180000
   CondCode := CCL;                                            <<02817>>12182000
                                                               <<02817>>12184000
end; << Header15P >>                                           <<02817>>12186000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - SCANSEGMENT"               12188000
$ CONTROL SEGMENT = SEG21                                               12190000
PROCEDURE SCANSEGMENT (SEGADR);                                         12192000
   <<THIS PROCEDURE SCANS A SEGMENT AND CALCULATES IT'S ATTRIBUTES:     12194000
     CREATES A SYMBOL TABLE ENTRY FOR EACH ACTIVE ENTRY POINT IN        12196000
        THE SEGMENT, USING CSTNR AS THE SEGMENT NUMBER                  12198000
     CREATES A SYMBOL TABLE ENTRY FOR EACH GLOBAL VARIABLE AND          12200000
        COMMON ARRAY                                                    12202000
     CALCULATES:                                                        12204000
        THE NEXT AVAILABLE STT NUMBER (STTNR)                           12206000
        THE SEGMENT LENGTH (SEGLEN) NOT INCLUDING THE STT               12208000
        THE ADDRESS OF THE PRIMARY O.B. ENTRY POINT (OBADR) IF ANY      12210000
        THE GLOBAL STORAGE REQUIREMENTS (NWPDB AND NWSDB)               12212000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE       12214000
     AN ERROR>>                                                         12216000
   VALUE SEGADR;                                                        12218000
   INTEGER SEGADR;                                                      12220000
   BEGIN                                                                12222000
   switch HeaderSw := H6, H7, OK, H9, H10, OK, HSI, HSI, HSI,  <<04102>>12224000
                      H15;                                     <<04102>>12226000
   INTEGER POINTER PARMS;  <<PARM. INFO POINTER>>                       12228000
                                                                        12230000
   SUBROUTINE HEADER6;                                                  12232000
      <<HEADER TYPE 6 FOR GLOBAL VARIABLES>>                            12234000
      BEGIN                                                             12236000
      TOS _ 5; TOS _ @HEADP(2)&LSL(1); ASSEMBLE(INCA,ZERO);             12238000
      CREATESYMENT(*,*,*);  <<CREATE SYM. TAB. ENTRY>>                  12240000
      IF < THEN GO NFG;  <<ERROR?>>                                     12242000
      SGTN _ HEADP(1); <<DATA TYPE DESCRIPTOR>>                         12244000
      SGDBA _ HEADP(2).(0:8)  <<PRIM. DB ADR.>>                         12246000
      END;                                                              12248000
                                                                        12250000
   <<* * * INITIALIZE PARAMETERS * * *>>                                12252000
                                                                        12254000
   SegLen  := 0;                                               <<02817>>12256000
   SttNr   := 1;                                               <<02817>>12258000
   SttPpNr := 0;                                               <<02817>>12260000
   IF ACTIVE THEN  <<SEGMENT ACTIVE?>>                                  12262000
      BEGIN                                                             12264000
      WHILE GETACTIVEFAMILY(SEGADR) DO                         <<02815>>12266000
         IF ACTIVE THEN  <<ENTRY POINT ACTIVE?>>                        12268000
            BEGIN                                                       12270000
                                                                        12272000
            <<* * * CREATE SYMBOL TABLE ENTRY * * *>>                   12274000
                                                                        12276000
            IF SEARCHSYM(ENAME,SYMANY) THEN  <<MULT. DEF.?>>            12278000
               BEGIN                                                    12280000
               TOS:=73; GO ERRORS1;                            <<04121>>12282000
               END;                                                     12284000
            IF NOT PROGRAMFILE AND BITMAP1&CSR(ENTTYPE) THEN            12286000
               BEGIN                                                    12288000
               TOS := 13; GO ERROR1                                     12290000
               END;                                                     12292000
            TOS := MAP10(ENTTYPE);  <<TYPE NR.>>                        12294000
            TOS := @ENAME&LSL(1);  <<NAME>>                             12296000
            TOS := IF SECONDARYPROC THEN @PARMS ELSE @EPARMS;           12298000
            CREATESYMENT(*,*,*);  <<CREATE SYM. TAB. ENTRY>>            12300000
            IF < THEN GO NFG;  <<ERROR?>>                               12302000
            if PRIMARYOB or PRIMARYPROC then                   <<04102>>12304000
               PMAPNW:=PMAPNW+DOUBLE(ENTNAMENW+PRIENTPMAPLEN)  <<04102>>12306000
            else                                               <<04102>>12308000
               PMAPNW:=PMAPNW+DOUBLE(ENTNAMENW+SECENTPMAPLEN); <<04102>>12310000
            SPLABEL _ CSTNR CAT STTNR (0:8:8);  <<DEFINING P-LABEL>>    12312000
               CASE SYMTYPE-1 OF                                        12314000
               BEGIN                                                    12316000
                                                                        12318000
               <<* * * PRIMARY OUTER BLOCK * * *>>                      12320000
                                                                        12322000
               BEGIN                                                    12324000
               IF OBADR = 0 THEN                                        12326000
                  BEGIN                                                 12328000
                  OBADR _ ENTFILEADR;  <<SAVE O.B. ADDRESS>>            12330000
                  END                                                   12334000
               ELSE                                                     12336000
                  BEGIN                                                 12338000
                  TOS := 61; GO ERROR1                                  12340000
                  END;                                                  12342000
               OBSTACKEST _ ESTACKEST  <<STACK ESTIMATE>>               12344000
               END;                                                     12346000
                                                                        12348000
               <<* * * SECONDARY OUTER BLOCK * * *>>                    12350000
                                                                        12352000
               BEGIN                                                    12354000
               TOS _ ENTFILEADR;  <<SAVE ENTRY ADDRESS>>                12356000
               GETFATHER;  <<GET PRIMARY OB ENTRY>>                     12358000
               IF OBADR <> ENTFILEADR THEN  <<DIFFERENT OB?>>           12360000
                  BEGIN                                                 12362000
                  TOS := 62; GO ERROR1                                  12364000
                  END;                                                  12366000
               IF OBADR = 0 THEN OBADR _ ENTFILEADR;                    12368000
               GETENTRY(*)  <<RESTORE ENTRY>>                           12370000
               END;                                                     12372000
                                                                        12374000
               <<* * * PRIMARY PROCEDURE * * *>>                        12376000
                                                                        12378000
               BEGIN                                                    12380000
               SXSTTNR _ 0;  <<STT NR. OF P-LABEL>>                     12382000
               @PARMS := @SPARMS;  <<SAVE PARM. INFO POINTER>>          12384000
               IF ESTACKEST > PROCSTACKEST THEN                         12386000
                  PROCSTACKEST _ ESTACKEST  <<STACK ESTIMATE>>          12388000
               END;                                                     12390000
                                                                        12392000
               <<* * * SECONDARY PROCEDURE * * *>>                      12394000
                                                                        12396000
               BEGIN                                                    12398000
               SXSTTNR := 0  <<STT NR. OF P-LABEL>>                     12400000
               END                                                      12402000
               END;                                                     12404000
                                                                        12406000
            <<* * * PROCESS CODE MODULE * * *>>                         12408000
                                                                        12410000
            IF BITMAP5&CSR(ENTTYPE) THEN  <<CODE MODULE?>>              12412000
               BEGIN                                                    12414000
               TOS _ ECODE;  <<CODE MODULE DESCRIPTOR>>                 12416000
               IF < THEN  <<FATAL ERROR?>>                              12418000
                  BEGIN                                                 12420000
                  TOS := 46; GO ERRORS1                                 12422000
                  END;                                                  12424000
               TESTBIT1;                                                12426000
               IF <> THEN WARNS(47,ENAME);  <<NON-FATAL ERROR?>>        12428000
               IF NOT PROGRAMFILE THEN  <<SL SEGMENT?>>                 12430000
                  BEGIN                                                 12432000
                  ASSEMBLE(ADDS 4);                                     12434000
                  MOVE AS3 _ ETPDB,(4);                                 12436000
                  ASSEMBLE(OR,OR; OR,DEL);                              12438000
                  IF <> THEN  <<GLOBAL STORAGE REQUIRED?>>              12440000
                     BEGIN                                              12442000
                     TOS := 14; GO ERRORS1                              12444000
                     END                                                12446000
                  END;                                                  12448000
               SEGLEN _ TOS.(2:14)+SEGLEN;  <<ADJ. SEGMENT LENGTH>>     12450000
               IF OVERFLOW THEN                                         12452000
                 BEGIN GETSEGENTRY;GO BIGSEG; END;                      12454000
               SSAPUST _ NWSDB;  <<S.A. OF PUST>>                       12456000
               TOS _ ENWPUST;  <<PUST LENGTH>>                          12458000
               IF <> THEN  <<IS THERE A PUST?>>                         12460000
                  BEGIN                                                 12462000
                  NWSTLT _ NWSTLT+1;  <<ADJ. STLT LENGTH>>              12464000
                  IF PRIMARYOB THEN OBPUSTADR _ NWSDB;  <<PUST ADR.>>   12466000
                  IF S0 > NWPUSTBUF THEN NWPUSTBUF _ S0  <<NEW MAX.?>>  12468000
                  END;                                                  12470000
               SSASDB _ TOS+NWSDB;  <<S.A. OF SDB/OWN/DATA ARRAY>>      12472000
               NWPDB _ NWPDB+ETPDB;  <<NR. WORDS PRIMARY DB>>           12474000
               NWSDB _ NWSDB+ETSDB;  <<NR. WORDS SECONDARY DB>>         12476000
               IF OVERFLOW THEN  <<TOO MUCH DB?>>                       12478000
                  BEGIN                                                 12480000
                  TOS := 38; GO ERROR1                                  12482000
                  END;                                                  12484000
                                                                        12486000
               <<* * * PROCESS HEADERS * * *>>                          12488000
                                                                        12490000
               WHILE GETNEXTHEADER(FALSE,BITMAP7) DO                    12492000
                  BEGIN                                                 12494000
                  GO HEADERSW(HEADTYPE-6); GO OK;                       12496000
                                                                        12498000
                  H6:   HEADER6; GO OK;  <<GLOBAL VARIABLE>>            12500000
                  H7:   IF NOT PROGRAMFILE THEN  <<SL SEGMENT?>>        12502000
                           BEGIN                                        12504000
                           TOS := 111; GO ERRORS1                       12506000
                           END;                                         12508000
                        GO OK;  <<EXTERNAL VARIABLE>>                   12510000
                  H9:   IF NOT PROGRAMFILE THEN  <<SL SEGMENT?>>        12512000
                           BEGIN                                        12514000
                           TOS := 112; GO ERRORS1                       12516000
                           END;                                         12518000
                        HEADER9S; GO TEST;  <<COMMON ARRAY>>            12520000
                  H10:  IF NOT PROGRAMFILE THEN  <<SL SEGMENT?>>        12522000
                           BEGIN                                        12524000
                           TOS := 113; GO ERRORS1                       12526000
                           END;                                         12528000
                        HEADER10S; GO OK; <<LOGICAL UNITS>>             12530000
                  HSI:  SISeen := true; go OK;                 <<04102>>12532000
                  H15:  SttPpNr := SttPpNr + (HeadNw & lsr(1));<<02817>>12534000
                        go OK;                                 <<02817>>12536000
                                                                        12538000
                  TEST: IF < THEN GO NFG;  <<ERROR?>>                   12540000
                  OK:                                                   12542000
                  END;                                                  12544000
               END;                                                     12546000
            STTNR _ STTNR+1  <<BUMP STT NUMBER>>                        12548000
            END;                                                        12550000
                                                                        12552000
      <<* * * CHECK VALIDITY OF SEGMENT * * *>>                         12554000
                                                                        12556000
      IF SEGLEN > MAXCODE THEN  <<CODE SEGMENT OVERFLOW?>>              12558000
         BEGIN                                                          12560000
       BIGSEG:                                                          12562000
         TOS:=40;                                                       12564000
         GO ERRORS1                                                     12566000
         END;                                                           12568000
      if SttNr + SttPpNr > 256 then  << STT overflow? >>       <<02817>>12570000
         BEGIN                                                          12572000
         TOS:=41;                                                       12574000
         GO ERRORS1                                                     12576000
         END                                                            12578000
      END;                                                              12580000
   TOS := CCE;  <<OK CONDITION CODE>>                                   12582000
   GO GETOUT;                                                           12584000
                                                                        12586000
   ERROR1: ERROR(*); GO NFG;                                            12588000
   ERRORS1: ERRORS(*,ENAME);                                            12590000
                                                                        12592000
   NFG:                                                                 12594000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                12596000
                                                                        12598000
   GETOUT:                                                              12600000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            12602000
   END;                                                                 12604000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - GETCHECKSUM"               12606000
$CONTROL SEGMENT=SEG21                                                  12608000
PROCEDURE GETCHECKSUM(FNUM,SEGRECORD,CODELENGTH,CHECKSUM);     <<04257>>12610000
VALUE FNUM,SEGRECORD,CODELENGTH;                               <<04257>>12612000
INTEGER FNUM,SEGRECORD,CODELENGTH;                             <<04257>>12614000
LOGICAL CHECKSUM;                                              <<04257>>12616000
                                                               <<04257>>12618000
<< THIS PROCEDURE GENERATES THE CHECKSUM FOR A SEGMENT. >>     <<04257>>12620000
<<   FNUM      : PROGRAM OR SL FILE NUM WHERE SEGMENT   >>     <<04257>>12622000
<<               RESIDES.                               >>     <<04257>>12624000
<<   SEGRECORD : SEGMENT BEGINNING RECORD NUMBER.       >>     <<04257>>12626000
<<   CODELENGTH : SEGMENT CODE LENGTH.                  >>     <<04257>>12628000
<< ALGORITHM :                                          >>     <<04257>>12630000
<<   CHECKSUM := SUM OF (EACH INSTRUCTION LOR IT'S      >>     <<04257>>12632000
<<                       OFFSET FROM PB)                >>     <<04257>>12634000
                                                               <<04257>>12636000
BEGIN                                                          <<04257>>12638000
                                                               <<04257>>12640000
   LOGICAL ARRAY INSTRBUF(0:127);                              <<04257>>12642000
   INTEGER INSTRDISP,RECDISP;                                  <<04257>>12644000
                                                               <<04257>>12646000
   CHECKSUM:=0;                                                <<04257>>12648000
   INSTRDISP:=0;                                               <<04257>>12650000
   WHILE CODELENGTH > INSTRDISP DO                             <<04257>>12652000
      BEGIN                                                    <<04257>>12654000
         FREADDIR'(FNUM,INSTRBUF,SEGRECORD);                   <<04257>>12656000
         RECDISP:=0;                                           <<04257>>12658000
         WHILE RECDISP < 128 AND CODELENGTH > INSTRDISP DO     <<04257>>12660000
            BEGIN                                              <<04257>>12662000
               CHECKSUM:= CHECKSUM +                           <<04257>>12664000
                          (INSTRBUF(RECDISP) LOR               <<04257>>12666000
                          LOGICAL(INSTRDISP));                 <<04257>>12668000
               RECDISP:=RECDISP+1;                             <<04257>>12670000
               INSTRDISP:=INSTRDISP+1;                         <<04257>>12672000
            END;                                               <<04257>>12674000
         SEGRECORD:=SEGRECORD+1;                               <<04257>>12676000
      END;                                                     <<04257>>12678000
   IF PROGRAMFILE THEN                                         <<04257>>12680000
      TOTALCKSUM:=INTEGER(LOGICAL(TOTALCKSUM)+CHECKSUM);       <<04257>>12682000
END;                                                           <<04257>>12684000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - PREPARESEGMENT"   <<00207>>12686000
$ CONTROL SEGMENT = SEG21                                               12688000
PROCEDURE PREPARESEGMENT (SEGADR,CODEFNUM,CODERECD);                    12690000
   <<THIS PROCEDURE SCANS A SEGMENT AND PREPARES IT'S CODE SEGMENT.     12692000
     TAKES:                                                             12694000
         THE SEGMENT ENTRY ADDRESS IN THE USL FILE (SEGADR)             12696000
         THE FILE NUMBER WHERE THE CODE IS TO BE PLACED (CODEFNUM)      12698000
         THE RECORD NUMBER WHERE THE CODE IS TO START (CODERECD)        12700000
     THE FOLLOWING GLOBAL VARIABLES NEED TO BE INITIALIZED BEFORE       12702000
     THE PROCEDURE IS ENTERED:                                          12704000
         CSTNR - THE LOGICAL SEGMENT NUMBER OF THE SEGMENT              12706000
         STTNR - THE FIRST AVAILABLE STT ENTRY IN THE SEGMENT           12708000
     WHEN THE PROCEDURE IS FINISHED THE FOLLOWING GLOBAL VARIABLES      12710000
     HAVE BEEN ADJUSTED:                                                12712000
         SEGFLAGS - SEGMENT ATTRIBUTES                                  12714000
         SEGLEN - THE FINAL SEGMENT LENGTH (INCLUDING THE STT)          12716000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE       12718000
     AN ERROR>>                                                         12720000
   VALUE SEGADR,CODEFNUM,CODERECD;                                      12722000
   INTEGER SEGADR,CODEFNUM,CODERECD;                                    12724000
   BEGIN                                                                12726000
   DEFINE EXITPROC = ASSEMBLE(EXIT 3)#;                                 12728000
   switch HeaderSw :=  H1,  H2,  H3,  H4,  OK,                 <<02817>>12730000
                       OK,  H7,  H8,  H9,  OK,                 <<02817>>12732000
                      H11,  SI,  SI,  SI, H15;                 <<04102>>12734000
   BYTE ARRAY B0 (0:37)=PB := "   NAME            STT  CODE ENTRY SEG"; 12736000
   INTEGER ARRAY PMAPRECORD(0:MAXPMAPRECLEN-1);                <<04102>>12738000
   logical       FirstSI;         << false after first SI      <<04102>>12740000
                                  << header in each procedure  <<04102>>12742000
                                  << is processed.             <<04102>>12744000
   integer       SegNameNw;       << # words used by seg name ><<04102>>12746000
                                                                        12748000
   SUBROUTINE HEADER8;                                                  12750000
      <<HEADER TYPE 8 FOR PRIMARY DB VALUES>>                           12752000
      BEGIN                                                             12754000
      TOS _ 0;  <<DB ADDRESS>>                                          12756000
      TOS _ @HEADP+HEADNW-NWPDB+NRCOMENT;  <<INIT. VALUE POINTER>>      12758000
      TOS _ 0;  <<DB ADDRESS>>                                          12760000
      TOS _ NWPDB-NRCOMENT;  <<ADDRESS COUNTER>>                        12762000
      WHILE <> DO                                                       12764000
         BEGIN                                                          12766000
         TOS _ PS2(S1);  <<INIT. VALUE>>                                12768000
         IF TESTBIT(HEADP(1),S2&LSL(1)) THEN  <<DATA LABEL?>>           12770000
            BEGIN                                                       12772000
            TOS _ TOS+SDBADR;  <<CORRECT WORD DATA LABEL>>              12774000
            IF TESTBIT(HEADP(1),S2&LSL(1)+1) THEN TOS _ TOS+SDBADR      12776000
            END;                                                        12778000
         PS3(S2) _ TOS;  <<INSERT INIT. VALUE>>                         12780000
         ASSEMBLE(INCB,DECA)                                            12782000
         END;                                                           12784000
      TOS _ TOS+1;  <<PUT 1 ON TOS>>                                    12786000
      BUFFERDATAWORDS(*,*,*,*)                                          12788000
      END;                                                              12790000
                                                                        12792000
   CONDCODE _ CCL;  <<ERROR CONDITION CODE>>                            12794000
   SEGFLAGS _ 0;  <<INIT. SEGMENT FLAGS>>                               12796000
   SEGFNUM _ CODEFNUM;  <<FILE NR. FOR CODE SEGMENT>>                   12798000
   SEGRECD _ CODERECD;  <<STARTING REC. NR. OF SEGMENT>>                12800000
   SEGLEN _ 0;  <<INIT. SEGMENT LENGTH>>                                12802000
   TFNUM1 _ CODEFNUM; TRECD1 _ CODERECD; TDISP1 _ 0;                    12804000
   GETENTRY(SEGADR);  <<GET SEGMENT ENTRY>>                             12806000
   IF ACTIVE THEN  <<SEGMENT ACTIVE?>>                                  12808000
      BEGIN                                                             12810000
                                                               <<04102>>12812000
      <<* * * Build PMAP segment record. * * *>>               <<04102>>12814000
                                                               <<04102>>12816000
      IF FPMAP THEN BEGIN                                      <<04102>>12818000
      NAMENW:=ENTNAMENW;                                       <<04102>>12820000
      MOVE IPMAP'NAME := ENAME,(ENTNAMENW);                    <<04102>>12822000
      IPMAP'TYPE := PMAPSEGTYPE;                               <<04102>>12824000
      IPMAP'STTLEN := 0;                                       <<04102>>12826000
      IPMAP'SEGNUM := 0;                                       <<04102>>12828000
      IPMAP'SEGLEN := 0;                                       <<04102>>12830000
      END;                                                     <<04102>>12832000
      << Record will be written when first active procedure is <<04102>>12834000
      << detected.                                             <<04102>>12836000
                                                                        12838000
      <<* * * PROCESS SEGMENT NAME * * *>>                              12840000
                                                                        12842000
      TOS _ @BLINE; TOS _ @ENAME&LSL(1)+1;                              12844000
      MOVE * _ *,(ENTNC);  <<SEGMENT NAME>>                             12846000
      NTOA(CSTNR,8,BLINE(18));  <<SEGMENT NR.>>                         12848000
      TOS _ @STT; PS0 _ -1;  <<INIT. STT ARRAY>>                        12850000
      ASSEMBLE(DUP,DECB); TOS _ -255; ASSEMBLE(MOVE 3);                 12852000
      WHILE GETACTIVEFAMILY(SEGADR) DO                         <<02815>>12854000
         IF ACTIVE THEN  <<ENTRY POINT ACTIVE?>>                        12856000
            BEGIN                                                       12858000
            SEGPRINTED _ 1;  <<SEGMENT NAME BIT>>                       12860000
            IF = THEN  <<PRINT SEGMENT NAME?>>                          12862000
               BEGIN                                                    12864000
               PRINTLINE;  <<PRINT SEGMENT NAME>>                       12866000
               MOVE BLINE := B0,(38);  <<COLUMN HEADINGS>>              12868000
               PrintLine;                                               12870000
               IF FPMAP THEN                                   <<04102>>12872000
               COREBUFPMAP(PMAPRECORD,NAMENW+SEGPMAPLEN);      <<04102>>12874000
               END;                                                     12876000
                                                                        12878000
            <<* * * GET ENTRY POINT ADDRESS * * *>>                     12880000
                                                                        12882000
            IF BITMAP5&CSR(ENTTYPE) THEN  <<CODE MODULE?>>              12884000
               BEGIN                                                    12886000
               UNITADR _ SEGLEN;  <<S.A. OF PROG. UNIT CODE IN SEG.>>   12888000
               SEGLEN _ SEGLEN+ENWC <<ADJ. SEGMENT LENGTH>>             12890000
               END;                                                     12892000
                                                                        12894000
            <<* * * PROCESS ENTRY POINT * * *>>                         12896000
                                                                        12898000
            SEARCHSYM(ENAME,IF (2 <= ENTTYPE <= 3)                      12900000
               THEN SYMOB ELSE SYMPROC);  <<GET SYM. TAB. ENTRY>>       12902000
            SYMTABADR _ @SYMP;  <<CURRENT SYM. TAB. ADR.>>              12904000
            XREG := IF PRIMARYOB OR PRIMARYPROC THEN 2 ELSE 1;          12906000
            TOS _ ENTP1(XREG);  <<S.A. OF ENTRY POINT>>                 12908000
            IF (2 <= ENTTYPE <= 3) THEN SSACODE _ UNITADR+S0;           12910000
            ENTRYPOINT(*);  <<PRINT ENTRY NAME>>                        12912000
                                                               <<04102>>12914000
            <<* * * Build PMAP entry point record. * * *>>     <<04102>>12916000
                                                               <<04102>>12918000
            IF FPMAP THEN                                      <<04102>>12920000
            if PrimaryOB or PrimaryProc then                   <<04102>>12922000
               begin                                           <<04102>>12924000
               MOVE IPMAP'NAME := ENAME,(ENTNAMENW);           <<04102>>12926000
               NAMENW:=ENTNAMENW;                              <<04102>>12928000
               IPMAP'TYPE := PMAPPROCTYPE;                     <<04102>>12930000
               IPMAP'FLAGS:= 0;                                <<04102>>12932000
               IF HIDDEN THEN IPMAP'HIDDEN:=1;                 <<04102>>12934000
               IPMAP'PROCSTART:=UNITADR;                       <<04102>>12936000
               IPMAP'PROCLEN:=ENWC;                            <<04102>>12938000
               IPMAP'PROCENTRY:=UNITADR+EPUSA;                 <<04102>>12940000
               IPMAP'TBOXLINK1:=0; <<KNOWN LATER>>             <<04102>>12942000
               IPMAP'TBOXLINK2:=0;                             <<04102>>12944000
               IPMAP'TBOXID:=0;                                <<04102>>12946000
               << CoreBufPmap will be done after ToolboxId is  <<04102>>12948000
               << known.                                       <<04102>>12950000
               end                                             <<04102>>12952000
            else                                               <<04102>>12954000
               begin                                           <<04102>>12956000
               MOVE IPMAP'NAME := ENAME,(ENTNAMENW);           <<04102>>12958000
               NAMENW:=ENTNAMENW;                              <<04102>>12960000
               IPMAP'TYPE := PMAPSECTYPE;                      <<04102>>12962000
               IPMAP'FLAGS:= 0;                                <<04102>>12964000
               IF HIDDEN THEN IPMAP'HIDDEN:=1;                 <<04102>>12966000
               IPMAP'SECENTRY:=UNITADR+EPUSEPA;                <<04102>>12968000
               IPMAP'SECENTNUM:=0;                             <<04102>>12970000
               COREBUFPMAP(PMAPRECORD,ENTNAMENW+SECENTPMAPLEN);<<04102>>12972000
               end;                                            <<04102>>12974000
                                                                        12976000
            <<* * * PROCESS CODE MODULE * * *>>                         12978000
                                                                        12980000
            IF BITMAP5&CSR(ENTTYPE) THEN                                12982000
               BEGIN                                                    12984000
               TOS _ SEGFLAGS;  <<LOAD FLAG WORD>>                      12986000
               IF PRIVLEDGED THEN                                       12988000
                  BEGIN                                                 12990000
                  IF NOT USERCAP2.(9:1) THEN  <<NO CAPABILITY?>>        12992000
                     BEGIN                                              12994000
                     ERROR(44);                                         12996000
                     RETURN                                             12998000
                     END;                                               13000000
                  SETBIT0                                               13002000
                  END;                                                  13004000
               IF WARNING THEN SETBIT1;                                 13006000
               SEGFLAGS _ TOS;                                          13008000
               SDBADR _ NWPDB+SSASDB;  <<S.A. OF SEC. DB ARRAY>>        13010000
               FORMATADR _ SDBADR+ENWSDB;  <<S.A OF FORMAT AREA>>       13012000
                                                                        13014000
               <<* * * PROCESS PUST HEADER * * *>>                      13016000
                                                                        13018000
               IF ENWPUST <> 0 THEN  <<IS THERE A PUST?>>               13020000
                  BEGIN                                                 13022000
                  NWSTLT _ NWSTLT+1;  <<ADJ. STLT LENGTH>>              13024000
                  WHILE GETNEXTHEADER(FALSE,%(2)100000) DO              13026000
                     BEGIN                                              13028000
                     IF HEADP(1) <> -1 THEN  <<PATCH CODE?>>            13030000
                        BEGIN                                           13032000
                        CREATEPATCHENT(4,UNITADR+HEADP(1));             13034000
                        IF < THEN RETURN;  <<ERROR?>>                   13036000
                        PATCHP(2) _ NWPDB+SSAPUST  <<S.A. OF PUST>>     13038000
                        END;                                            13040000
                     MOVE PUSTBUF(2) _ HEADP,(HEADNW);  <<MOVE HEADER>> 13042000
                     TOS _ NWPDB+SSASDB;  <<F.A.+1 OF PUST>>            13044000
                     TOS _ UNITADR+EPUSA;  <<S.A. PRIM. ENTRY POINT>>   13046000
                     PUSTDBUF _ TOS;                                    13048000
                     TOS _ UNITADR;  <<S.A. OF CODE MODULE>>            13050000
                     TOS _ UNITADR+ENWC;  <<F.A.+1 OF CODE MODULE>>     13052000
                     PUSTDBUF(1) _ TOS                                  13054000
                     END;                                               13056000
                  USLENTRYPARMS  <<RESTORE ENTRY PARM'S>>               13058000
                  END;                                                  13060000
                                                                        13062000
               <<* * * PROCESS HEADERS AND CODE * * *>>                 13064000
                                                                        13066000
               FirstSI := true;                                <<04102>>13068000
               WHILE GETNEXTHEADER(TRUE,BITMAP9) DO                     13070000
                  BEGIN                                                 13072000
                  XREG _ HEADTYPE;                                      13074000
                  IF < THEN  <<CODE MODULE?>>                           13076000
                     COREBUF1(HEADP,HEADNW)                             13078000
                  ELSE                                                  13080000
                     BEGIN                                              13082000
                     GO HEADERSW(XREG-1); GO OK;                        13084000
                                                                        13086000
                     H1: HEADER1P(FALSE); GO TEST;  <<PCAL>>            13088000
                     H2: HEADER2P; GO TEST;  <<PB ADDRESS>>             13090000
                     H3: HEADER3P; GO TEST;  <<OWN/DATA VARIABLES>>     13092000
                     H4: HEADER4P; GO OK;  <<SDB/OWN/DATA VALUES>>      13094000
                     H7: HEADER7P; GO TEST;  <<EXTERNAL VARIABLE>>      13096000
                     H8: HEADER8; GO OK;  <<PRIMARY DB VALUES>>         13098000
                     H9: HEADER9P; GO TEST;  <<COMMON ARRAY>>           13100000
                     H11: HEADER11P; GO TEST;  <<FORMAT STRING>>        13102000
                     SI:  HeaderSIP(FirstSI); << TOOLBOX header<<04102>>13104000
                          go OK;                               <<04102>>13106000
                     H15: Header15P; go TEST;  << Private Proc.<<02817>>13108000
                                                                        13110000
                     TEST: IF < THEN RETURN;  <<ERROR?>>                13112000
                     OK:                                                13114000
                     END                                                13116000
                  END;                                                  13118000
                                                               <<04102>>13120000
               <<* * * Finish PMAP procedure record. * * *>>   <<04102>>13122000
                                                               <<04102>>13124000
               IF FPMAP THEN BEGIN                             <<04102>>13126000
               if not FirstSI then                             <<04102>>13128000
                  IPMAP'TBOXID:=TOOLBOXID;                     <<04102>>13130000
               COREBUFPMAP(PMAPRECORD,ENTNAMENW+PRIENTPMAPLEN);<<04102>>13132000
               END;                                            <<04102>>13134000
                                                                        13136000
               <<* * * INSERT PUST IN PROGRAM FILE * * *>>              13138000
                                                                        13140000
               IF ENWPUST <> 0 THEN  <<WAS THERE A PUST?>>              13142000
                  BEGIN                                                 13144000
                  @SYMP _ SYMTABADR;  <<CURRENT SYM. TAB. ENTRY>>       13146000
                  SYMENTPARMS;                                          13148000
                  BUFFERDATAWORDS(NWPDB+SSAPUST,PUSTBUF,ENWPUST,1)      13150000
                  END                                                   13152000
               END                                                      13154000
            END;                                                        13156000
                                                                        13158000
      <<* * * APPEND STT TO SEGMENT AND CLEAN UP * * *>>                13160000
                                                                        13162000
      APPENDSTT(CODERECD);                                     <<04257>>13164000
      IF < THEN RETURN  <<ERROR?>>                                      13166000
      END;                                                              13168000
   CONDCODE _ CCE  <<OK CONDITION CODE>>                                13170000
   END;                                                                 13172000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - ENTRYPOINT"       <<00207>>13174000
$ CONTROL SEGMENT = SEG21                                               13176000
PROCEDURE ENTRYPOINT (SAENTRY);                                         13178000
   <<PRINTS THE ENTRY POINT NAME AND INSERTS THE LOCAL P-LABEL IN THE   13180000
     STT.  IT IS ASSUMED THAT THE CURRENT SYMBOL TABLE ENTRY IS THAT    13182000
     OF THE ENTRY POINT>>                                               13184000
   VALUE SAENTRY;                                                       13186000
   INTEGER SAENTRY;                                                     13188000
   BEGIN                                                                13190000
   TOS _ @BLINE(3); TOS _ @SNAME&LSL(1)+1;                              13192000
   MOVE * _ *,(SYMNC);  <<ENTRY POINT NAME>>                            13194000
   NTOA(SSTTNR,8,BLINE(21));  <<STT NR.>>                               13196000
   NTOA(UNITADR,8,BLINE(27));  <<S.A. OF CODE MODULE>>                  13198000
   NTOA(UNITADR+SAENTRY,8,BLINE(33));  <<S.A. OF ENTRY POINT>>          13200000
   PRINTLINE;                                                           13202000
   STT(-SSTTNR) _ (UNITADR+SAENTRY) CAT SNAME (1:1:1)  <<P-LABEL>>      13204000
   END;                                                                 13206000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - APPENDSTT"        <<00207>>13208000
$ CONTROL SEGMENT = SEG21                                               13210000
PROCEDURE APPENDSTT(CODERECD);                                 <<04257>>13212000
VALUE CODERECD;                                                <<04257>>13214000
INTEGER CODERECD;                                              <<04257>>13216000
   <<CHECKS THE VALIDITY OF THE PREPARED SEGMENT, APPENDS THE STT TO    13218000
     THE CODE SEGMENT AND FIXES THE EXTERNAL STT NR. ENTRIES IN THE     13220000
     SYMBOL TABLE>>                                                     13222000
   BEGIN                                                                13224000
LOGICAL CHECKSUM;                                              <<04257>>13226000
INTEGER CODELEN;                                               <<04257>>13228000
INTEGER CKSUMDISP,CKSUMRECD;                                   <<04257>>13230000
INTEGER TEMPPATCH;                                             <<04127>>13232000
   BYTE ARRAY B0 (0:13)=PB _ "SEGMENT LENGTH";                          13234000
   LOGICAL BITMAP0 _ %(2)0000111100011000;                              13236000
   ARRAY PATCHBUF(0:127);                                      <<00629>>13238000
   INTEGER POINTER PASEGNAME := @PATCHBUF;                     <<00629>>13240000
   DOUBLE POINTER DPASEGNAME = PASEGNAME;                      <<00629>>13242000
   DEFINE                                                      <<00629>>13244000
      PAPROGNAME   = PATCHBUF#,                                <<00629>>13246000
      PASPARE      = PASEGNAME(8)#,                            <<00629>>13248000
      PACHECKSUM   = PASEGNAME(9)#,                            <<00629>>13250000
      PAPREPTIME   = DPASEGNAME(5)#,                           <<00629>>13252000
      PAPATCHTIME  = DPASEGNAME(6)#;                           <<00629>>13254000
                                                               <<00629>>13256000
   CODELEN:=SEGLEN;                                            <<04257>>13258000
   TEMPPATCH :=INITPATCH;                                      <<04127>>13260000
   TOS _ SEGLEN;  <<SEGMENT LENGTH>>                                    13262000
   IF <> THEN  <<NON-NULL SEGMENT?>>                                    13264000
      BEGIN                                                             13266000
      IF INITPATCH >= 0 THEN  <<APPEND A PATCH AREA?>>         <<00629>>13268000
         BEGIN                                                 <<00629>>13270000
         IF INITPATCH > MAXCODE THEN GO TOOBIG;                <<00629>>13272000
         SEGLEN := TOS+INITPATCH+STTNR+(IF PROGRAMFILE THEN 19 <<00629>>13274000
                   ELSE 15);                                   <<00629>>13276000
         TOS := SEGLEN.(14:2);                                 <<00629>>13278000
         IF <> THEN ASSEMBLE(LDI 4;XCH,SUB); <<PADDING>>       <<00629>>13280000
         SEGLEN := SEGLEN+S0;  <<FINAL SEGMENT LENGTH>>        <<00629>>13282000
         INITPATCH := INITPATCH+TOS;<<EXPAND PATCH BY PADDING>><<00629>>13284000
         IF NOT PROGRAMFILE THEN  <<SL FILE?>>                 <<00629>>13286000
            MOVE PASEGNAME := SLRSEGNAME,(8)                   <<00629>>13288000
         ELSE                                                  <<00629>>13290000
            BEGIN                                              <<00629>>13292000
            <<BLANK PROGRAM NAME AND SEGMENT NAME>>            <<00629>>13294000
            TOS := @PAPROGNAME;  PS0 := "  ";                  <<00629>>13296000
            ASSEMBLE(DUP,INCB); TOS := 11; ASSEMBLE(MOVE 3);   <<00629>>13298000
            TOS := @PAPROGNAME&LSL(1);                         <<00629>>13300000
            MOVE * := BFILENAME WHILE ANS; <<PROGRAM NAME>>    <<00629>>13302000
            @PASEGNAME := @PAPROGNAME+4;                       <<00629>>13304000
            TOS := @PASEGNAME&LSL(1);                          <<00629>>13306000
            TOS := @ENAME&LSL(1)+1;                            <<00629>>13308000
            MOVE * := *,(ENTNC);  <<SEGMENT NAME>>             <<00629>>13310000
            END;                                               <<00629>>13312000
         PASPARE := 0;                                         <<00629>>13314000
         PACHECKSUM := 0;                                      <<00629>>13316000
         TOS := CALENDAR;                                      <<00629>>13318000
         TOS := CLOCK;                                         <<00629>>13320000
         DEL;  <<DEL SECS, TENTHS OF SECS>>                    <<00629>>13322000
         PAPREPTIME := TOS;                                    <<00629>>13324000
         PAPATCHTIME := 0D;                                    <<00629>>13326000
         CKSUMDISP:=TDISP1+(IF PROGRAMFILE THEN 13             <<04257>>13328000
                            ELSE 9);                           <<04257>>13330000
         CKSUMRECD:=TRECD1;                                    <<04257>>13332000
         IF CKSUMDISP >= 128 THEN                              <<04257>>13334000
            BEGIN                                              <<04257>>13336000
               CKSUMRECD:=CKSUMRECD+1;                         <<04257>>13338000
               CKSUMDISP:=CKSUMDISP-128;                       <<04257>>13340000
            END;                                               <<04257>>13342000
                                                               <<04257>>13344000
         COREBUF1(PATCHBUF,IF PROGRAMFILE THEN 18 ELSE 14);    <<00629>>13346000
         <<INITIALIZE PATCH AREA TO HALT 16'S>>                <<00629>>13348000
         TOS := @PATCHBUF;  PS0 := %30376;                     <<00629>>13350000
         ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3);     <<00629>>13352000
         TOS := INITPATCH;                                     <<00629>>13354000
         WHILE S0 > 128 DO                                     <<00629>>13356000
            BEGIN                                              <<00629>>13358000
            COREBUF1(PATCHBUF,128);                            <<00629>>13360000
            TOS := TOS-128;                                    <<00629>>13362000
            END;                                               <<00629>>13364000
         COREBUF1(PATCHBUF,S0);                                <<00629>>13366000
         COREBUF1(INITPATCH,1);                                <<00629>>13368000
         ASSEMBLE(DEL,ZERO); <<PADDING ALREADY DONE!>>         <<00629>>13370000
         END                                                   <<00629>>13372000
      ELSE                                                     <<00629>>13374000
         BEGIN                                                 <<00629>>13376000
         TOS _ (TOS+STTNR+3)&LSR(2)&LSL(2)-SEGLEN-STTNR;  <<PADDING>>   13378000
         SEGLEN _ SEGLEN+STTNR+S0;  <<FINAL SEGMENT LENGTH>>            13380000
         END;                                                  <<00629>>13382000
                                                                        13384000
      <<* * * APPEND STT TO CODE SEGMENT * * *>>                        13386000
                                                                        13388000
      IF STTNR > P256 THEN  <<STT OVERFLOW?>>                           13390000
         BEGIN                                                          13392000
         ERROR(41);                                                     13394000
         GO NFG                                                         13396000
         END;                                                           13398000
      TOS _ STTNR-1;  <<NR. STT ENTRIES>>                               13400000
      SETBIT1;  <<SET "UNCALLABLE" BIT>>                                13402000
      STT _ TOS;                                                        13404000
      COREBUF1(STT(1-STTNR-S0),STTNR+S0);  <<APPEND STT>>               13406000
      MAKEPATCHES;  <<EMPTY PATCH TABLE>>                               13408000
      IF < THEN GO NFG;  <<ERROR?>>                                     13410000
      IF TDISP1 <> 0 THEN FWRITEDIR'(TFNUM1,TBUF1,TRECD1);              13412000
                                                                        13414000
   IF CHECKSUMSPECIFIED THEN                                   <<04257>>13416000
      BEGIN                                                    <<04257>>13418000
         GETCHECKSUM(TFNUM1,CODERECD,CODELEN,CHECKSUM);        <<04257>>13420000
         REPAIRRECORD'(TFNUM1,CKSUMRECD,CKSUMDISP,             <<04257>>13422000
                       INTEGER(CHECKSUM));                     <<04257>>13424000
         IF NOT PROGRAMFILE AND CKSUMRECD = TRECD1 THEN        <<04552>>13426000
            FREADDIR'(TFNUM1,TBUF1,TRECD1); <<UPDATE TBUF1>>   <<04552>>13428000
      END;                                                     <<04257>>13430000
      <<* * * PRINT CODE SEGMENT LENGTH * * *>>                         13434000
                                                                        13436000
      MOVE BLINE(3) _ B0,(14);  <<"SEGMENT LENGTH">>                    13438000
      NTOA(SEGLEN,8,BLINE(27));  <<SEGMENT LENGTH>>                     13440000
      PRINTLINE;                                                        13442000
      IF SEGLEN > MAXCODE THEN  <<SEGMENT OVERFLOW?>>                   13444000
         BEGIN                                                          13446000
TOOBIG:  ERROR(40);                                            <<00629>>13448000
         GO NFG                                                         13450000
         END;                                                           13452000
      IF SEGLEN > SDBMAXCODE THEN WARN(48);                    <<00.DM>>13454000
                                                                        13456000
      <<* * * FIX SYMBOL TABLE PROCEDURE ENTRIES * * *>>                13458000
                                                                        13460000
      @SYMP _ @STABLE;                                                  13462000
      WHILE @SYMP < @STABLE(USEDSYMBOL) DO                              13464000
         BEGIN                                                          13466000
         SYMENTPARMS;                                                   13468000
         IF BITMAP0&CSR(SYMTYPE) THEN SXSTTNR _ 0;  <<CLEAR STT NR.>>   13470000
         @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                            13472000
         END                                                            13474000
      END;                                                              13476000
   INITPATCH := TEMPPATCH;                                     <<04127>>13478000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    13480000
   GO GETOUT;                                                           13482000
                                                                        13484000
   NFG:                                                                 13486000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 13488000
                                                                        13490000
   GETOUT:                                                              13492000
   CONDCODE _ TOS                                                       13494000
   END;                                                                 13496000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - SCANRL"           <<00207>>13498000
$ CONTROL SEGMENT = SEG23                                               13500000
PROCEDURE SCANRL;                                                       13502000
   <<THIS PROCEDURE SCANS THE USL TO DETERMINE WHICH PROCEDURES ARE     13504000
     EXTERNAL AND TRIES TO SATISFY THEM USING THE SPECIFIED RL LIBRARY  13506000
     FILE.  SYMBOL TABLE ENTRIES AND RL TABLE ENTRIES ARE MADE FOR ALL  13508000
     DIRECTLY REFERENCED AND INDIRECTLY REFERENCED RL PROCEDURES.  THE  13510000
     RL PROCEDURES ARE THEN SCANED TO DETERMINE THEIR GLOBAL            13512000
     REQUIREMENTS.  GLOBAL VARIABLES RETURNED:                          13514000
         THE NEXT AVAILABLE STT NUMBER (STTNR)                          13516000
         THE SEGMENT LENGTH NOT INCLUDING THE STT (SEGLEN)              13518000
         THE GLOBAL STORAGE REQUIREMENTS (NWSDB)                        13520000
         SEGFLAGS.(0:1) SET IF THE SEGMENT CONTAINS PRIV. INSTRUCTIONS  13522000
         SEGFLAGS.(1:1) SET IF THE SEGMENT CONTAINS A NON-FATAL ERROR   13524000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN    13526000
     ERROR>>                                                            13528000
   BEGIN                                                                13530000
   ARRAY PARMS(0:4)=Q;                                         <<00595>>13532000
   BYTE ARRAY B0 (0:10)=PB _ ":RL SEGMENT";                             13534000
   DEFINE EXITPROC = ASSEMBLE(EXIT 0)#;                                 13536000
   switch HeaderSw :=  H1,  OK,  OK,  OK,  OK,                 <<02817>>13538000
                       OK,  OK,  OK,  H9, H10,                 <<02817>>13540000
                       OK, HSI, HSI, HSI, H15;                 <<04102>>13542000
                                                                        13544000
   LOGICAL SUBROUTINE SEARCHRLIB (NAME);                                13546000
      <<SEARCHES THE RL LIBRARY FOR THE ENTRY POINT HAVING THE          13548000
        SPECIFIED NAME.  IF FOUND, THE RESULT TRUE IS RETURNED AND THE  13550000
        ENTRY PARAMETERS ARE SET; OTHERWISE THE RESULT FALSE IS         13552000
        RETURNED>>                                                      13554000
      INTEGER ARRAY NAME;                                               13556000
      BEGIN                                                             13558000
      TOS _ RLIBREC0(RLFHI+HASH(NAME));  <<FIRST REC. IN HASH LIST>>    13560000
      WHILE <> DO                                                       13562000
         BEGIN                                                          13564000
         FREADDIR'(RLIBFNUM,RLIBDIR,S0);                                13566000
         @RLIBP _ @RLIBDIR(2);  <<INIT. ENTRY POINTER>>                 13568000
         WHILE @RLIBP < @RLIBDIR+RLIBDIR(1) DO                          13570000
            BEGIN                                                       13572000
            TOS _ RLIBP.(4:3)+1;  <<NR. WORDS FOR NAME>>                13574000
            @RLIBP1 _ @RLIBP+S0;  <<INIT. SECONDARY POINTER>>           13576000
            TOS _ TOS+4+PARMLEN(RLIBPARMS);  <<NR. WORDS FOR ENTRY>>    13578000
            IF PS3.(4:4) = RLIBNAME.(4:4) THEN  <<NR. CHAR'S SAME?>>    13580000
               BEGIN                                                    13582000
               TOS _ @PS3&LSL(1)+1; TOS _ @RLIBNAME&LSL(1)+1;           13584000
               IF * = *,(RLIBNAME.(4:4)) THEN  <<NAME'S MATCH?>>        13586000
                  BEGIN                                                 13588000
                  DDEL;  <<REMOVE TEMP'S>>                              13590000
                  SEARCHRLIB _ TRUE;                                    13592000
                  RETURN                                                13594000
                  END                                                   13596000
               END;                                                     13598000
            @RLIBP _ TOS+@RLIBP  <<NEXT ENTRY>>                         13600000
            END;                                                        13602000
         DEL;  <<REMOVE REC. NR.>>                                      13604000
         TOS _ RLIBDIR  <<NEXT REC. NR. IN HASH LIST>>                  13606000
         END;                                                           13608000
      DEL  <<REMOVE REC. NR.>>                                          13610000
      END;                                                              13612000
                                                                        13614000
   SUBROUTINE CREATERLENT (INFOADR,SYMENTRY);                           13616000
      <<CREATES AN ENTRY IN THE RL PROCEDURE TABLE AND INITIALIZES THE  13618000
        ENTRY WITH THE ADDRESS OF THE INFO BLOCK AND THE ADDRESS OF THE 13620000
        SYMBOL TABLE ENTRY>>                                            13622000
      VALUE INFOADR;                                                    13624000
      DOUBLE INFOADR;                                                   13626000
      INTEGER ARRAY SYMENTRY;                                           13628000
      BEGIN                                                             13630000
      MAKEROOMINDL(3);                                                  13632000
      IF < THEN EXITPROC;  <<ERROR?>>                                   13634000
      @RLENTP _ @DLAVAIL;  <<INIT. ENTRY POINTER>>                      13636000
      TOS _ @RLENTP; TOS _ @S4; TOS _ 3;                                13638000
      ASSEMBLE(MOVE 2);                                                 13640000
      @DLAVAIL _ TOS;  <<RESET AVAILABLE AREA POINTER>>                 13642000
      NRRLENT _ NRRLENT+1  <<BUMP NR. ENTRIES>>                         13644000
      END;                                                              13646000
                                                                        13648000
   SUBROUTINE HEADER1A;                                                 13650000
      <<SEARCHES THE RL FOR THE GIVEN PROCEDURE IF IT IS NOT SATISFIED  13652000
        ALREADY.  IF THE PROCEDURE IS SATISFIABLE BY THE RL, CREATES    13654000
        A SYMBOL TABLE ENTRY AND A RL TABLE ENTRY (IF NECESSARY).  IF   13656000
        A PROCEDURE IS DETERMINED TO BE EXTERNAL, A SYMBOL TABLE ENTRY  13658000
        IS CREATED AT THIS TIME>>                                       13660000
      BEGIN                                                             13662000
      IF NOT SEARCHSYM(HEADP(2),SYMPROC) THEN  <<NEW EXTERNAL?>>        13664000
         IF SEARCHRLIB(HEADP(2)) THEN  <<SATISFIED BY RL?>>             13666000
            BEGIN                                                       13668000
            TOS _ @RLIBPARMS;  <<RL PARM. INFO>>                        13672000
            TOS _ @HEADP(2); TOS _ TOS+PS0.(4:3)+1;  <<PARM INFO>>      13674000
            PARMCHECK(*,*,PARMS);                              <<00595>>13678000
            PREPERROR := PREPERROR+1;                          <<00595>>13680000
            CASE PARMS OF                                      <<00595>>13682000
               BEGIN                                           <<00595>>13684000
               PREPERROR := PREPERROR-1;                       <<00595>>13686000
               ERRORS2(49,HEADP(2),ENAME);                     <<00595>>13688000
               ERRORS2(50,HEADP(2),ENAME);                     <<00595>>13690000
               BEGIN                                           <<00595>>13692000
                  ERRORS2(45,HEADP(2),ENAME);                  <<00595>>13694000
                  PRINTBITMAP(PARMS(1));                       <<00595>>13696000
               END;                                            <<00595>>13698000
               END;                                            <<00595>>13700000
            IF RLIBFATAL THEN  <<FATAL ERROR?>>                         13702000
               BEGIN                                                    13704000
               ERRORS(46,HEADP(2));                                     13706000
               EXITPROC                                                 13708000
               END;                                                     13710000
            IF RLIBWARNING THEN WARNS(47,HEADP(2));  <<NON-FATAL?>>     13712000
            IF SEARCHRLTAB(RLIBINFO) THEN  <<NEW ENTRY POINT?>>         13714000
               BEGIN                                                    13716000
               CREATESYMENT(9,RLIBNAME,RLIBPARMS);                      13718000
               IF < THEN EXITPROC;  <<ERROR?>>                          13720000
               PMAPNW:=PMAPNW+DOUBLE(SYMNAMENW+SECENTPMAPLEN); <<04102>>13722000
               SRLINDEX := @RLENTP-@RLTABLE  <<PRIMARY ENTRY INDEX>>    13724000
               END                                                      13726000
            ELSE  <<NEW PROCEDURE>>                                     13728000
               BEGIN                                                    13730000
               CREATESYMENT(8,RLIBNAME,RLIBPARMS);                      13732000
               IF < THEN EXITPROC;  <<ERROR?>>                          13734000
               PMAPNW:=PMAPNW+DOUBLE(SYMNAMENW+PRIENTPMAPLEN); <<04102>>13736000
               SRLCODE _ RLIBCODE;  <<CODE MODULE DESCRIPTOR>>          13738000
               CREATERLENT(RLIBINFO,SYMP);  <<CREATE RL ENTRY>>         13740000
               SEGLEN _ SEGLEN+RLIBNWC;  <<ADJ SEG LENGTH>>             13742000
               IF OVERFLOW THEN GO BIGSEG;                              13744000
               END;                                                     13746000
            SPLABEL _ CSTNR CAT STTNR (0:8:8);  <<ENTRY P-LABEL>>       13748000
            SXSTTNR _ 0;                                                13750000
            SRLENTRY _ RLIBENTRY;  <<CODE MODULE ENTRY POINT>>          13752000
            STTNR _ STTNR+1  <<BUMP STT NR.>>                           13754000
            END                                                         13756000
         ELSE  <<EXTERNAL PROCEDURE>>                                   13758000
            BEGIN                                                       13760000
            TOS _ 7;                                                    13762000
            TOS _ @HEADP(2)&LSL(1);                                     13764000
            TOS _ @HEADP(XREG); TOS _ TOS+PS0.(4:3)+1;                  13766000
            CREATESYMENT(*,*,*);  <<CREATE SYM. TAB. ENTRY>>            13768000
            IF < THEN EXITPROC;  <<ERROR?>>                             13770000
            SXNL _ 0  <<INIT. NR. LABELS>>                              13772000
            END                                                         13774000
      END;                                                              13776000
                                                                        13778000
   SUBROUTINE HEADER1B;                                                 13780000
      <<CHECKS TO SEE IF THE RL EXTERNAL IS SATISFIED WITHIN THE RL.    13782000
        IF SO, A SYMBOL TABLE ENTRY IS CREATED AND A RL TABLE ENTRY IS  13784000
        CREATED (IF NECESSARY).  NOTE THAT IF THE EXTERNAL IS NOT       13786000
        SATISFIED AN EXTERNAL SYMBOL TABLE ENTRY IS NOT CREATED>>       13788000
      BEGIN                                                             13790000
      IF LOGICAL(HEADP(6).(0:1)) THEN  <<SATISFIED BY RL?>>             13792000
         IF NOT SEARCHSYM(HEADP(6),SYMRLPROC) THEN  <<NEW ENTRY POINT?>>13794000
            BEGIN                                                       13796000
            IF LOGICAL(HEADP(1).(0:1)) THEN  <<FATAL ERROR?>>           13798000
               BEGIN                                                    13800000
               ERRORS(46,HEADP(6));                                     13802000
               EXITPROC                                                 13804000
               END;                                                     13806000
            IF LOGICAL(HEADP(1).(1:1)) THEN WARNS(47,HEADP(6));         13808000
            BUF := 0;  <<NULL PARM. INFO>>                              13810000
            IF SEARCHRLTAB(HEADDP(1)) THEN  <<NEW ENTRY POINT?>>        13812000
               BEGIN                                                    13814000
               CREATESYMENT(11,HEADP(6),BUF);  <<CREATE SYM. TAB. ENT.>>13816000
               IF < THEN EXITPROC;  <<ERROR?>>                          13818000
               PMAPNW:=PMAPNW+DOUBLE(SYMNAMENW+SECENTPMAPLEN); <<04102>>13820000
               SRLINDEX := @RLENTP-@RLTABLE  <<PRIMARY ENTRY INDEX>>    13822000
               END                                                      13824000
            ELSE  <<NEW PROCEDURE>>                                     13826000
               BEGIN                                                    13828000
               CREATESYMENT(10,HEADP(6),BUF);  <<CREATE SYM. TAB. ENT.>>13830000
               IF < THEN EXITPROC;  <<ERROR?>>                          13832000
               PMAPNW:=PMAPNW+DOUBLE(SYMNAMENW+PRIENTPMAPLEN); <<04102>>13834000
               SRLCODE _ HEADP(1);  <<CODE MODULE DESCRIPTOR>>          13836000
               CREATERLENT(HEADDP(1),SYMP);  <<CREATE RL TABLE ENTRY>>  13838000
               SEGLEN _ SEGLEN+SRLNWC;  <<ADJ SEG LENGTH>>              13840000
               IF OVERFLOW THEN GOTO BIGSEG;                            13842000
               END;                                                     13844000
            SPLABEL _ CSTNR CAT STTNR (0:8:8);  <<ENTRY P-LABEL>>       13846000
            SXSTTNR _ 0;  <<INIT. EXTN. P-LABEL STT NR.>>               13848000
            SRLENTRY _ HEADP(4);  <<CODE MODULE ENTRY ADR.>>            13850000
            STTNR _ STTNR+1  <<BUMP STT NR.>>                           13852000
            END                                                         13854000
      END;                                                              13856000
                                                                        13858000
   CONDCODE _ CCL;  <<ERROR CONDITION CODE>>                            13860000
                                                                        13862000
   <<* * * OPEN RL LIBRARY FILE * * *>>                                 13864000
                                                                        13866000
  RLIBFNUM _ FOPEN(RLIBFNAME,%(2)10000000011,%(2)111110000);            13868000
   IF < THEN  <<ERROR?>>                                                13870000
      BEGIN                                                             13872000
      TOS _ 30;                                                         13874000
      TOS _ 0D; FCHECK(0,S0);                                           13876000
      ERRORN(*,*);                                                      13878000
      RETURN                                                            13880000
      END;                                                              13882000
                                                                        13884000
   <<* * * CHECK FOR EQUALITY OF RL LIBRARY AND RL FILE * * *>>         13886000
                                                                        13888000
   ASSEMBLE(DZRO,DZRO; DZRO,ZERO);                                      13890000
   FGETINFO(RLIBFNUM,,,,,,S5,,S6,,,,,,,,,,,DS4);                        13892000
   IF RLFNUM <> 0 THEN FGETINFO(RLFNUM,,,,,,S2,,,,,,,,,,,,,DS1);        13894000
   TOS _ @S2&LSL(1); TOS _ @S6&LSL(1); TOS _ 6;                         13896000
   ASSEMBLE(CMPB 3);                                                    13898000
   ASSEMBLE(SUBS 6);                                                    13900000
   IF = THEN  <<SAME FILES?>>                                           13902000
      BEGIN                                                             13904000
      FIXUPRL;  <<COMPLETE ANY BINDING>>                                13906000
      TOS _ @RLREC0;  <<RECORD 0 BUFFER>>                               13908000
      TOS _ @RLDIR;  <<DIRECTORY RECORD BUFFER>>                        13910000
      TOS _ TRUE                                                        13912000
      END                                                               13914000
   ELSE  <<DIFFERENT FILE>>                                             13916000
      BEGIN                                                             13918000
      FLOCK(RLIBFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                   13920000
      MAKEROOMINDL(PROGDLBUFS2);                                        13922000
      IF < THEN RETURN;  <<ERROR?>>                                     13924000
      FREADDIR'(RLIBFNUM,DLAVAIL,0);  <<READ RECORD 0>>                 13926000
      IF TOS <> RLFILECODE OR DLAVAIL <> RLFILEID THEN  <<TYPE RL?>>    13928000
         BEGIN                                                          13930000
         ERROR(22);                                                     13932000
         RETURN                                                         13934000
         END;                                                           13936000
      TOS _ @DLAVAIL;  <<RECORD 0 BUFFER>>                              13938000
      TOS _ @DLAVAIL+128;  <<DIRECTORY RECORD BUFFER>>                  13940000
      @DLAVAIL _ @DLAVAIL+P256;                                         13942000
      TOS _ FALSE                                                       13944000
      END;                                                              13946000
   RLIBEQUALRL _ TOS;                                                   13948000
   @RLIBDIR _ TOS;                                                      13950000
   @RLIBREC0 _ TOS;                                                     13952000
   @RLTABLE _ @DLAVAIL;                                                 13954000
                                                                        13956000
   <<* * * GET DIRECTLY REFERENCED RL PROCEDURES * * *>>                13958000
                                                                        13960000
   SegLen  := 0;                                               <<02817>>13962000
   SttNr   := 1;                                               <<02817>>13964000
   SttPpNr := 0;                                               <<02817>>13966000
   TOS _ USLSL;  <<FIRST SEGMENT ENTRY ADR.>>                           13968000
   DO BEGIN                                                             13970000
      GETENTRY(S0);  <<GET SEGMENT ENTRY>>                              13972000
      IF ACTIVE THEN  <<ACTIVE SEGMENT?>>                               13974000
         WHILE GETFAMILY(S0) DO  <<GET ENTRY POINTS>>                   13976000
            IF ACTIVE AND BITMAP5&CSR(ENTTYPE) THEN                     13978000
               WHILE GETNEXTHEADER(FALSE,%(2)10) DO                     13980000
                  HEADER1A;  <<PCAL HEADER>>                            13982000
      DEL;                                                              13984000
      TOS _ EBL;  <<NEXT SEGMENT ENTRY ADR.>>                           13986000
      IF <> THEN GETBROTHER;                                            13988000
      END UNTIL =;                                                      13990000
                                                                        13992000
   <<* * * GET INDIRECTLY REFERENCED RL PROCEDURES * * *>>              13994000
                                                                        13996000
      @ENTP:=@RLSEG;  << POINTER TO RL SEG ENTRY SO >>         <<04780>>13998000
                      << ENAME IS "RLSEG"           >>         <<04780>>14000000
   USLINFOINCORE _ FALSE;  <<CLEAR FLAG>>                               14002000
   INFOADR _ DOUBLE(-MAXHEAD);                                          14004000
   HEADRECD _ -255;                                                     14006000
   TOS _ 0;  <<RL ENTRY TABLE INDEX>>                                   14008000
   WHILE @RLTABLE(S0) <> @RLTABLE+3*NRRLENT DO                          14010000
      BEGIN                                                             14012000
      @RLENTP _ @RLTABLE(XREG);  <<INIT. ENTRY POINTER>>                14014000
      @SYMP _ RLENTP(2);  <<INIT. SYM. TAB. POINTER>>                   14016000
      SYMENTPARMS;                                                      14018000
      SETUPRLHEADERS(RLENTDP+3D+DOUBLE(LOGICAL(SRLNWC)));      <<04755>>14020000
      SSASDB _ NWSDB;  <<S.A. OF SEC. DB ARRAY>>                        14022000
      NWSDB _ NWSDB+HEADP(3);  <<ADJ. SEC. DB COUNT>>                   14024000
      IF OVERFLOW THEN  <<DATA SEGMENT OVERFLOW?>>                      14026000
         BEGIN                                                          14028000
         ERROR(38);                                                     14030000
         RETURN                                                         14032000
         END;                                                           14034000
      WHILE GETNEXTRLHEADER DO                                          14036000
         BEGIN                                                          14038000
         GO HEADERSW(HEADTYPE-1); GO OK;                                14040000
                                                                        14042000
         H1: HEADER1B; GO OK;  <<PCAL>>                                 14044000
         H9: HEADER9S; GO TEST;  <<COMMON ARRAY>>                       14046000
         H10: HEADER10S; GO OK;  <<LOGICAL UNITS>>                      14048000
         HSI: SISeen := true; go OK;                           <<04102>>14050000
         H15: SttPpNr := SttPpNr + (HeadNw & lsr(1)); go OK;   <<02817>>14052000
                                                                        14054000
         TEST: IF < THEN RETURN;  <<ERROR?>>                            14056000
         OK:                                                            14058000
         END;                                                           14060000
      TOS _ TOS+3  <<NEXT ENTRY INDEX>>                                 14062000
      END;                                                              14064000
                                                                        14066000
   <<* * * CHECK VALIDITY OF SEGMENT * * *>>                            14068000
                                                                        14070000
   IF SEGLEN>MAXCODE THEN                                               14072000
     BEGIN BIGSEG: TOS_40; GO RLSEGERROR; END;                          14074000
   if SttNr + SttPpNr > 256 then  << STT overflow? >>          <<02817>>14076000
     BEGIN TOS_41;GO RLSEGERROR; END;                                   14078000
   GOTO LOK;                                                            14080000
                                                                        14082000
 RLSEGERROR:                                                            14084000
   MOVE BBUF_B0,(11);                                                   14086000
   ERRORS(*,BUF);                                                       14088000
   RETURN;                                                              14090000
                                                                        14092000
 LOK:                                                                   14094000
   CONDCODE _ CCE  <<OK CONDITION CODE>>                                14096000
   END;                                                                 14098000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - PREPARERL"        <<00207>>14100000
$ CONTROL SEGMENT = SEG23                                               14102000
PROCEDURE PREPARERL (CODERECD);                                         14104000
   <<THIS PROCEDURE COMPOSES THE RL CODE SEGMENT AND INITIALIZES THE    14106000
     GLOBAL VARIABLES ASSOCIATED WITH THE RL PROCEDURES.  THE CODE      14108000
     SEGMENT IS PLACED IN THE PROGRAM FILE BEGINNING AT RECORD SEGRECD. 14110000
     GLOBAL VARIABLES RETURNED:                                         14112000
         SEGFLAGS.(0:1) SET IF THE SEGMENT CONTAINS PRIV. INSTRUCTIONS  14114000
         SEGFLAGS.(1:1) IF THE SEGMENT CONTAINS A NON-FATAL ERROR       14116000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN    14118000
     ERROR>>                                                            14120000
   VALUE CODERECD;                                                      14122000
   INTEGER CODERECD;                                                    14124000
   BEGIN                                                                14126000
   BYTE ARRAY B0 (0:9)=PB _ "RL SEGMENT";                               14128000
   switch HeaderSw :=  H1,  H2,  H3,  H4,  OK,                 <<02817>>14130000
                       OK,  H7,  OK,  H9,  OK,                 <<02817>>14132000
                      H11, HSI, HSI, HSI, H15;                 <<04102>>14134000
   INTEGER ARRAY PMAPRECORD(0:MAXPMAPRECLEN-1);                <<04102>>14136000
   byte    array PmapRecordB(*) = PmapRecord;                  <<04102>>14138000
   logical    FirstSI;            << false after first SI >>   <<04102>>14140000
                                  << header in each procedure  <<04102>>14142000
                                  << is processed.             <<04102>>14144000
   CONDCODE _ CCL;  <<ERROR CONDITION CODE>>                            14146000
   SEGFLAGS _ 0;  <<INIT. SEGMENT FLAGS>>                               14148000
   TOS _ CODERECD; ASSEMBLE(ZERO,DDUP);                                 14150000
   SEGLEN _ TOS; SEGRECD _ TOS;                                         14152000
   TDISP1 _ TOS; TRECD1 _ TOS;                                          14154000
   INFOADR _ DOUBLE(-MAXHEAD);                                          14156000
   HEADRECD _ -255;                                                     14158000
                                                                        14160000
   <<* * * PROCESS SEGMENT NAME * * *>>                                 14162000
                                                                        14164000
   MOVE BLINE _ B0,(10);  <<"RL SEGMENT">>                              14166000
   NTOA(CSTNR,8,BLINE(18));  <<SEGMENT NR.>>                            14168000
                                                               <<04102>>14170000
   <<* * * Build PMAP segment record. * * *>>                  <<04102>>14172000
                                                               <<04102>>14174000
   IF FPMAP THEN BEGIN                                         <<04102>>14176000
   MOVE PMAPRECORDB(1):="$RL0";                                <<04102>>14178000
   NAMENW:=3;                                                  <<04102>>14180000
   IPMAP'TYPE:=PMAPSEGTYPE;                                    <<04102>>14182000
   IPMAP'NAMENUMCH:=4;                                         <<04102>>14184000
   IPMAP'STTLEN:=0;                                            <<04102>>14186000
   IPMAP'SEGNUM:=0;                                            <<04102>>14188000
   IPMAP'SEGLEN:=0;                                            <<04102>>14190000
   END;                                                        <<04102>>14192000
   << The record will be written when first procedure is de-   <<04102>>14194000
   << tected.                                                  <<04102>>14196000
                                                                        14198000
   <<* * * PROCESS RL PROCEDURES * * *>>                                14200000
                                                                        14202000
   TOS _ @STT; PS0 _ -1;  <<INIT. STT ARRAY>>                           14204000
   ASSEMBLE(DUP,DECB); TOS _ -255; ASSEMBLE(MOVE 3);                    14206000
   @RLENTP _ @RLTABLE;  <<INIT. ENTRY POINTER>>                         14208000
   TOS _ NRRLENT;  <<ENTRY COUNTER>>                                    14210000
   WHILE <> DO                                                          14212000
      BEGIN                                                             14214000
      SEGPRINTED _ 1;  <<SEGMENT NAME BIT>>                             14216000
      if = then                                                <<04102>>14218000
         begin                                                 <<04102>>14220000
         PrintLine;               << Print segment name >>     <<04102>>14222000
         IF FPMAP THEN                                         <<04102>>14224000
         COREBUFPMAP(PMAPRECORD,3+SEGPMAPLEN);<<$RL0 REC>>     <<04102>>14226000
         end;                                                  <<04102>>14228000
      @SYMP _ RLENTP(2);  <<INIT. ENTRY POINTER>>                       14230000
      SYMENTPARMS;                                                      14232000
      SYMTABADR _ @SYMP;  <<SAVE SYM. TAB. ENTRY ADR.>>                 14234000
                                                                        14236000
      <<* * * PROCESS PROCEDURE ENTRY POINTS * * *>>                    14238000
                                                                        14240000
      UNITADR _ SEGLEN;  <<S.A OF CODE MODULE>>                         14242000
      SEGLEN _ SEGLEN+SRLNWC;  <<ADJ. SEGMENT LENGTH>>                  14244000
      ENTRYPOINT(SRLENTRY);  <<PRINT ENTRY NAME>>                       14246000
                                                               <<04102>>14248000
      <<* * * Build PMAP procedure record. * * *>>             <<04102>>14250000
                                                               <<04102>>14252000
      IF FPMAP THEN  BEGIN                                     <<04102>>14254000
               MOVE IPMAP'NAME := SNAME,(SYMNAMENW);           <<04102>>14256000
               NAMENW:=SYMNAMENW;                              <<04102>>14258000
               IPMAP'TYPE := PMAPPROCTYPE;                     <<04102>>14260000
               IPMAP'FLAGS:= 0;                                <<04102>>14262000
               IPMAP'PROCSTART:=UNITADR;                       <<04102>>14264000
               IPMAP'PROCLEN:=SRLNWC;                          <<04102>>14266000
               IPMAP'PROCENTRY:=UNITADR+SRLENTRY;              <<04102>>14268000
               IPMAP'TBOXLINK1:=0; <<KNOWN LATER>>             <<04102>>14270000
               IPMAP'TBOXLINK2:=0;                             <<04102>>14272000
               IPMAP'TBOXID:=0;                                <<04102>>14274000
      END;                                                     <<04102>>14276000
                                                               <<04102>>14278000
      @SYMP _ @STABLE;                                                  14280000
      WHILE @SYMP < @STABLE(USEDSYMBOL) DO                              14282000
         BEGIN                                                          14284000
         SYMENTPARMS;                                                   14286000
         IF (SYMTYPE = 9 OR  SYMTYPE = 11) AND                          14288000
            SRLINDEX = @RLENTP-@RLTABLE THEN                            14290000
            ENTRYPOINT(SRLENTRY);  <<PRINT ENTRY POINT>>                14292000
         @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                            14294000
         END;                                                           14296000
      @SYMP _ SYMTABADR;  <<RESTORE ENTRY POINTER>>                     14298000
      SYMENTPARMS;                                                      14300000
                                                                        14302000
      <<* * * PROCESS CODE MODULE * * *>>                               14304000
                                                                        14306000
      TOS _ (RLENTDP+3D)&DLSL(9);                                       14308000
      TOS _ TOS&LSR(9);                                                 14310000
      IF S0+SRLNWC+6 < MAXHEAD THEN  <<FITS INTO BUFFER?>>              14312000
         BEGIN                                                          14314000
         FREADMR''(RLIBFNUM,HEAD,MAXHEAD,S1);                           14316000
         COREBUF1(HEAD(S0),SRLNWC);                            <<04755>>14318000
         @HEADP _ TOS+@HEAD+SRLNWC;  <<INIT. HEADER POINTER>>  <<04755>>14320000
         HEADRECD _ TOS;  <<SAVE REC. NR.>>                             14322000
         HEADNW _ 6  <<PHONEY HEADER LENGTH>>                           14324000
         END                                                            14326000
      ELSE                                                              14328000
         BEGIN                                                          14330000
         MASTERBUF(PROGFNUM,RLIBFNUM,TBUF1,TRECD1,TDISP1,               14332000
            TRUE,RLENTDP+3D,BUF,SRLNWC);                       <<04755>>14334000
         SETUPRLHEADERS(RLENTDP+3D+DOUBLE(LOGICAL(SRLNWC)));   <<04755>>14336000
         DDEL                                                           14338000
         END;                                                           14340000
      TOS _ SEGFLAGS;                                                   14342000
      IF SPRIVILEGED THEN  <<PRIV. MODE?>>                              14344000
         BEGIN                                                          14346000
         IF NOT USERCAP2.(9:1) THEN  <<HAS CAPABILITY?>>                14348000
            BEGIN                                                       14350000
            ERROR(44);                                                  14352000
            RETURN                                                      14354000
            END;                                                        14356000
         SETBIT0                                                        14358000
         END;                                                           14360000
      IF SRLWARNING THEN SETBIT1;  <<NON-FATAL ERROR?>>                 14362000
      SEGFLAGS _ TOS;                                                   14364000
                                                                        14366000
      <<* * * PROCESS HEADERS * * *>>                                   14368000
                                                                        14370000
      SDBADR _ NWPDB+SSASDB;  <<S.A. OF SEC. DB ARRAY>>                 14372000
      FORMATADR _ SDBADR+HEADP(4);  <<S.A. OF FORMAT AREA>>             14374000
      FirstSI := true;                                         <<04102>>14376000
      WHILE GETNEXTRLHEADER DO                                          14378000
         BEGIN                                                          14380000
         GO HEADERSW(HEADTYPE-1); GO OK;                                14382000
                                                                        14384000
         H1:   @HEADP _ @HEADP+4;  <<ADJ. HEADER POINTER>>              14386000
               HEADER1P(TRUE);  <<PCAL>>                                14388000
               IF < THEN RETURN;  <<ERROR?>>                            14390000
               @HEADP _ @HEADP-4;  <<RESET HEADER POINTER>>             14392000
               GO OK;                                                   14394000
         H2: HEADER2P; GO TEST;  <<PB ADDRESS>>                         14396000
         H3: HEADER3P; GO TEST;  <<OWN/DATA VARIABLES>>                 14398000
         H4: HEADER4P; GO OK;  <<SDB/OWN/DATA VALUES>>                  14400000
         H7: HEADER7P; GO TEST;  <<EXTERNAL VARIABLE>>                  14402000
         H9: HEADER9P; GO TEST;  <<COMMON ARRAY>>                       14404000
         H11: HEADER11P; GO TEST;  <<FORMAT STRING>>                    14406000
         HSI: HeaderSIP(FirstSI); go OK; << TOOLBOX SI >>      <<04102>>14408000
         H15: Header15P; go TEST; << Private procs >>          <<02817>>14410000
                                                                        14412000
         TEST: IF < THEN RETURN;  <<ERROR?>>                            14414000
         OK:                                                            14416000
         END;                                                           14418000
                                                               <<04102>>14420000
      <<* * * Finish PMAP procedure record. * * *>>            <<04102>>14422000
                                                               <<04102>>14424000
      IF FPMAP THEN  BEGIN                                     <<04102>>14426000
      @Symp := RlEntP(2) ;        << Restore entry pointer >>  <<04102>>14428000
      SymEntParms;                                             <<04102>>14430000
      if not FirstSI then                                      <<04102>>14432000
         IPMAP'TBOXID:=TOOLBOXID;                              <<04102>>14434000
      COREBUFPMAP(PMAPRECORD,SYMNAMENW+PRIENTPMAPLEN);         <<04102>>14436000
                                                               <<04102>>14438000
      <<* * * Generate PMAP secondary entry point records * * *<<04102>>14440000
                                                               <<04102>>14442000
      @SymP := @STable;                                        <<04102>>14444000
      while @SymP < @STable(UsedSymbol) do                     <<04102>>14446000
         begin                                                 <<04102>>14448000
         SymEntParms;                                          <<04102>>14450000
         if (SymType = 9 or SymType = 11) and                  <<04102>>14452000
            SRLIndex = @RLEntP - @RLTable then                 <<04102>>14454000
            begin                                              <<04102>>14456000
            MOVE IPMAP'NAME := SNAME,(SYMNAMENW);              <<04102>>14458000
            NAMENW:=SYMNAMENW;                                 <<04102>>14460000
            IPMAP'TYPE := PMAPSECTYPE;                         <<04102>>14462000
            IPMAP'FLAGS:= 0;                                   <<04102>>14464000
            IPMAP'SECENTRY:=UNITADR+SRLENTRY;                  <<04102>>14466000
            IPMAP'SECENTNUM:=0;                                <<04102>>14468000
            COREBUFPMAP(PMAPRECORD,SYMNAMENW+SECENTPMAPLEN);   <<04102>>14470000
            end;                                               <<04102>>14472000
         @SymP := @SymP + SymNw;                               <<04102>>14474000
         end;                                                  <<04102>>14476000
      END;                                                     <<04102>>14478000
      @RLENTP _ @RLENTP+3;  <<NEXT ENTRY>>                              14480000
      TOS _ TOS-1                                                       14482000
      END;                                                              14484000
                                                                        14486000
   <<* * * APPEND STT TO CODE SEGMENT * * *>>                           14488000
                                                                        14490000
   APPENDSTT(CODERECD);                                        <<04257>>14492000
   IF < THEN RETURN;  <<ERROR?>>                                        14494000
   CONDCODE _ CCE  <<OK CONDITION CODE>>                                14496000
   END;                                                                 14498000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - SETUPRLHEADERS"   <<00207>>14500000
$ CONTROL SEGMENT = SEG23                                               14502000
PROCEDURE SETUPRLHEADERS (ADR);                                         14504000
   <<LOADS THE HEADER SET PREAMBLE BLOCK AND INITIALIZES THE HEADER     14506000
     PARAMETERS>>                                                       14508000
   VALUE ADR;                                                           14510000
   DOUBLE ADR;                                                          14512000
   BEGIN                                                                14514000
   EQUATE MAXRECDS = MAXHEAD/128-1;                                     14516000
   TOS _ ADR&DLSL(9);                                                   14518000
   TOS _ TOS&LSR(9);                                                    14520000
   IF NOT (HEADRECD <= S1 <= HEADRECD+MAXRECDS) THEN  <<OUT OF BUFFER?>>14522000
      BEGIN                                                             14524000
      HEADRECD _ S1;  <<SAVE REC. NR.>>                                 14526000
      FREADMR''(RLIBFNUM,HEAD,MAXHEAD,HEADRECD)                         14528000
      END                                                               14530000
   ELSE TOS _ TOS+(S1-HEADRECD)&LSL(7);  <<ADJ. BUFFER DISP.>>          14532000
   @HEADP _ TOS+@HEAD;  <<INIT. HEADER POINTER>>                        14534000
   HEADNW _ 6  <<PHONEY HEADER LENGTH>>                                 14536000
   END;                                                                 14538000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - GETNEXTRLHEADER"  <<00207>>14540000
$ CONTROL SEGMENT = SEG23                                               14542000
LOGICAL PROCEDURE GETNEXTRLHEADER;                                      14544000
   <<LOADS THE NEXT HEADER IN THE HEADER LIST AND SETS THE HEADER       14546000
     PARAMETERS.  IF THERE ARE NO MORE HEADERS, THE VALUE FALSE IS      14548000
     RETURNED; OTHERWISE THE VALUE TRUE IS RETURNED>>                   14550000
   BEGIN                                                                14552000
   @HEADP _ @HEADP+HEADNW;  <<NEXT HEADER>>                             14554000
   IF HEADP <> -1 THEN  <<END OF LIST?>>                                14556000
      BEGIN                                                             14558000
      HEADNW _ HNW;  <<NR. WORDS FOR HEADER>>                           14560000
      HEADTYPE _ HTYPE;  <<HEADER TYPE NR.>>                            14562000
      IF @HEADP+HEADNW >= @HEAD+MAXHEAD THEN  <<OUT OF BUFFER?>>        14564000
         BEGIN                                                          14566000
         HEADRECD _ HEADRECD+(@HEADP-@HEAD)&LSR(7);                     14568000
         FREADMR''(RLIBFNUM,HEAD,MAXHEAD,HEADRECD);                     14570000
         @HEADP := @HEAD+(@HEADP-@HEAD).(9:7)  <<RESET HEADER POINTER>> 14572000
         END;                                                           14574000
      GETNEXTRLHEADER _ TRUE                                            14576000
      END                                                               14578000
   END;                                                                 14580000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - CREATEPMAPSCRATCH"<<04102>>14582000
$CONTROL SEGMENT=SEG23                                         <<04102>>14584000
procedure CreatePmapScratch(NrPmapSegs, Status);               <<04102>>14586000
   value NrPmapSegs;                                           <<04102>>14588000
   integer NrPmapSegs;            << # of segments in PMAP >>  <<04102>>14590000
   integer Status;                << Status code returned >>   <<04102>>14592000
                                                               <<04102>>14594000
begin << CreatePmapScratch >>                                  <<04102>>14596000
                                                               <<04102>>14598000
   << Purge any existing Pmap scratch file. >>                 <<04102>>14600000
                                                               <<04102>>14602000
   PmapFileNr := FOpen(PmapScratch, %2002, %500);              <<04102>>14604000
   if = then                                                   <<04102>>14606000
      begin                                                    <<04102>>14608000
      FClose(PmapFileNr, 4, 0);                                <<04102>>14610000
      if < then                                                <<04102>>14612000
         begin                                                 <<04102>>14614000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>14616000
         Status := STATUS'BAD;                                 <<04102>>14618000
         return;                                               <<04102>>14620000
         end;                                                  <<04102>>14622000
      end;                                                     <<04102>>14624000
                                                               <<04102>>14626000
   << Open a new temporary Pmap scratch file. >>               <<04102>>14628000
                                                               <<04102>>14630000
   PmapFileNr := FOpen(PmapScratch, %2000, %424, 128,,,,,,     <<04102>>14632000
                       (PmapNw & dlsr(7)) + 6D, 16,,           <<04102>>14634000
                       PROGFILECODE);                          <<04102>>14636000
   if <> then                                                  <<04102>>14638000
      begin                                                    <<04102>>14640000
      Error(MSG'CANTOPENSCRATCH);                              <<04102>>14642000
      Status := STATUS'BAD;                                    <<04102>>14644000
      return;                                                  <<04102>>14646000
      end;                                                     <<04102>>14648000
                                                               <<04102>>14650000
   << Make record 0 look like that of a program file. >>       <<04102>>14652000
   PmapBuf := 0;                  << Clear record 0 >>         <<04102>>14654000
   move PmapBuf(1) := PmapBuf, (127);                          <<04102>>14656000
   PmapBuf     := %4000;          << Means record 0 was zeroed <<04102>>14658000
   PmapBuf(1)  := NrPmapSegs;     << # of segments in the PMAP <<04102>>14660000
   PmapBuf(16) := 1;              << PMAP area begins in rec 1 <<04102>>14662000
   FWriteDir'(PmapFileNr, PmapBuf, 0);                         <<04102>>14664000
                                                               <<04102>>14666000
   << CONSTRUCT ENTRY TYPE TABLE >>                            <<04102>>14668000
   TYPETABLELEN:=NRPMAPTYPE+1;             <<PMAP RECORDS :    <<04102>>14670000
   SEGTYPELEN:=SEGPMAPLEN;                 <<!----------------!<<04102>>14672000
   PRITYPELEN:=PRIENTPMAPLEN;              <<!TYPETABLELEN    !<<04102>>14674000
   SECTYPELEN:=SECENTPMAPLEN;              <<!LEN OF TYPE 0   !<<04102>>14676000
   PMAPRECNR :=1;                          <<!LEN OF TYPE 1   !<<04102>>14678000
   PMAPBUFDISP:=0;                         <<!ETC.            !<<04102>>14680000
   COREBUFPMAP(TYPETABLE,TYPETABLELEN);    <<!----------------!<<04102>>14682000
                                           <<!  POPINTERS     !<<04102>>14684000
   << SKIP WORDS FOR SEGMENT PMAP POINTER    !                !<<04102>>14686000
   PMAPRECNR:=1+(NRPMAPSEGS*2+TYPETABLELEN)<<!----------------!<<04102>>14688000
                /128;                      <<! PMAP RECORDS   !<<04102>>14690000
   PMAPBUFDISP:=(NRPMAPSEGS*2+TYPETABLELEN)<<!                !<<04102>>14692000
                MOD 128;                   <<!----------------!<<04102>>14694000
   STATUS:=STATUS'OK;                                          <<04102>>14696000
END; <<CREATEPMAPSCRATCH >>                                    <<04102>>14698000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - CREATESISCRATCH"  <<04102>>14700000
$CONTROL SEGMENT=SEG23                                         <<04102>>14702000
procedure CreateSIScratch(Status);                             <<04102>>14704000
   integer Status;                << Status code returned >>   <<04102>>14706000
                                                               <<04102>>14708000
begin << CreateSIScratch >>                                    <<04102>>14710000
                                                               <<04102>>14712000
   << Purge any existing SI scratch file. >>                   <<04102>>14714000
                                                               <<04102>>14716000
   SIFileNr := FOpen(SIScratch, %2002, %500);                  <<04102>>14718000
   if = then                                                   <<04102>>14720000
      begin                                                    <<04102>>14722000
      FClose(SIFileNr, 4, 0);                                  <<04102>>14724000
      if < then                                                <<04102>>14726000
         begin                                                 <<04102>>14728000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>14730000
         Status := STATUS'BAD;                                 <<04102>>14732000
         return;                                               <<04102>>14734000
         end;                                                  <<04102>>14736000
      end;                                                     <<04102>>14738000
                                                               <<04102>>14740000
   << Open a new temporary SI scratch file. >>                 <<04102>>14742000
                                                               <<04102>>14744000
   SIFileNr := FOpen(SIScratch, %2000, %421, 128,,,,,,         <<04102>>14746000
                     fixr(real(USLFL & dlsr(7)) * 1.15), 32);  <<04102>>14748000
   if <> then                                                  <<04102>>14750000
      begin                                                    <<04102>>14752000
      Error(MSG'CANTOPENSCRATCH);                              <<04102>>14754000
      Status := STATUS'BAD;                                    <<04102>>14756000
      return;                                                  <<04102>>14758000
      end;                                                     <<04102>>14760000
                                                               <<04102>>14762000
   << Start writing at record 0, word 0. >>                    <<04102>>14764000
   SIRecNr := 0;                                               <<04102>>14766000
   SIBufDisp := 0;                                             <<04102>>14768000
   Status := STATUS'OK;                                        <<04102>>14770000
                                                               <<04102>>14772000
end; << CreateSIScratch >>                                     <<04102>>14774000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - ACTIVATETOOLBOX"  <<04102>>14776000
$CONTROL SEGMENT=SEG23                                         <<04102>>14778000
procedure ActivateToolbox(SegPointer, NrPmapSegs, Status);     <<04102>>14780000
   value NrPmapSegs;                                           <<04102>>14782000
   integer array SegPointer;      << PMAP seg rec pointers >>  <<04102>>14784000
   integer NrPmapSegs;            << # of PMAP segments >>     <<04102>>14786000
   integer Status;                << Status code returned >>   <<04102>>14788000
                                                               <<04102>>14790000
begin << ActivateToolbox >>                                    <<04102>>14792000
                                                               <<04102>>14794000
   integer       TboxError;       << Returned by CreateProcess <<04102>>14796000
   integer       TboxPin;         << PIN of TOOLBOX son process<<04102>>14798000
   integer array ItemNrs(0:3);    << Parameter codes >>        <<04102>>14800000
   integer array Items(0:2);      << Parameters >>             <<04102>>14802000
   integer       Zero := 0;       << For call by reference >>  <<04102>>14804000
                                                               <<04102>>14806000
   <<* * * Copy segment pointers to the PMAP scratch file. * * <<04102>>14808000
                                                               <<04102>>14810000
   if PmapRecNr <> 1 then                                      <<04102>>14812000
      begin                                                    <<04102>>14814000
      FWriteDir'(PmapFileNr, PmapBuf, PmapRecNr);              <<04102>>14816000
      PmapRecNr := 1;                                          <<04102>>14818000
      FReadDir'(PmapFileNr, PmapBuf, PmapRecNr);               <<04102>>14820000
      end;                                                     <<04102>>14822000
   PMAPBUFDISP:=TYPETABLELEN;                                  <<04102>>14824000
   CoreBufPmap(SegPointer, NrPmapSegs * 2);                    <<04102>>14826000
   FWriteDir'(PmapFileNr, PmapBuf, PmapRecNr);                 <<04102>>14828000
                                                               <<04102>>14830000
   if SymDBug then                                             <<04102>>14832000
      begin                                                    <<04102>>14834000
                                                               <<04102>>14836000
      <<* * * Close the PMAP scratch file. * * *>>             <<04102>>14838000
                                                               <<04102>>14840000
      FClose(PmapFileNr, %12, 0); << Save temp, return unused ><<04102>>14842000
      if <> then                                               <<04102>>14844000
         begin                                                 <<04102>>14846000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>14848000
         Status := STATUS'BAD;                                 <<04102>>14850000
         return;                                               <<04102>>14852000
         end;                                                  <<04102>>14854000
                                                               <<04102>>14856000
      <<* * * Close the SI scratch file. * * *>>               <<04102>>14858000
                                                               <<04102>>14860000
      CoreBufSI(Zero, 1);         << SI terminator >>          <<04102>>14862000
      FWriteDir'(SIFileNr, SIBuf, SIRecNr);                    <<04102>>14864000
      FClose(SIFileNr, 2, 0);     << Save temp, keep unused >> <<04102>>14866000
      if <> then                                               <<04102>>14868000
         begin                                                 <<04102>>14870000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>14872000
         Status := STATUS'BAD;                                 <<04102>>14874000
         return;                                               <<04102>>14876000
         end;                                                  <<04102>>14878000
                                                               <<04102>>14880000
      <<* * * Create TOOLBOX process. * * *>>                  <<04102>>14882000
                                                               <<04102>>14884000
      ItemNrs    := 3;            << Load option flags >>      <<04102>>14886000
      ItemNrs(1) := 11;           << Info string pointer >>    <<04102>>14888000
      ItemNrs(2) := 12;           << Info string byte length >><<04102>>14890000
      ItemNrs(3) := 0;            << End-of-list >>            <<04102>>14892000
      Items      := 1;            << Wake up if son terminates <<04102>>14894000
      Items(1)   := @TboxFiles;   << Info string >>            <<04102>>14896000
      Items(2)   := 20;           << Info string length >>     <<04102>>14898000
                                                               <<04102>>14900000
      CreateProcess(TboxError, TboxPin, SEGSYM, ItemNrs,       <<04102>>14902000
                    Items);                                    <<04102>>14904000
      if <> then                                               <<04102>>14906000
         begin                                                 <<04102>>14908000
         Warn(MSG'CANTPREPSYMDEBUG);                           <<04102>>14910000
         SymDBug := false;                                     <<04102>>14912000
         end                                                   <<04102>>14914000
      else                                                     <<04102>>14916000
         begin                                                 <<04102>>14918000
         Activate(TboxPin, 2);                                 <<04102>>14920000
         if <> then                                            <<04102>>14922000
            begin                                              <<04102>>14924000
            Warn(MSG'CANTPREPSYMDEBUG);                        <<04102>>14926000
            SymDBug := false;                                  <<04102>>14928000
            end                                                <<04102>>14930000
         else                                                  <<04102>>14932000
            Kill(TboxPin);                                     <<04102>>14934000
         end;                                                  <<04102>>14936000
                                                               <<04102>>14938000
      <<* * * Open the scratch files again. * * *>>            <<04102>>14940000
                                                               <<04102>>14942000
      PmapFileNr := FOpen(PmapScratch, %2002, %520);           <<04102>>14944000
      if <> then                                               <<04102>>14946000
         begin                                                 <<04102>>14948000
         Error(MSG'CANTOPENSCRATCH);                           <<04102>>14950000
         Status := STATUS'BAD;                                 <<04102>>14952000
         return;                                               <<04102>>14954000
         end;                                                  <<04102>>14956000
                                                               <<04102>>14958000
      if SymDBug then                                          <<04102>>14960000
         begin                                                 <<04102>>14962000
         SIFileNr := FOpen(SIScratch, %2002, %520);            <<04102>>14964000
         if <> then                                            <<04102>>14966000
            begin                                              <<04102>>14968000
            Error(MSG'CANTOPENSCRATCH);                        <<04102>>14970000
            Status := STATUS'BAD;                              <<04102>>14972000
            return;                                            <<04102>>14974000
            end;                                               <<04102>>14976000
         end;                                                  <<04102>>14978000
      end;                                                     <<04102>>14980000
                                                               <<04102>>14982000
   Status := STATUS'OK;                                        <<04102>>14984000
                                                               <<04102>>14986000
end; << ActivateToolbox >>                                     <<04102>>14988000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - PREPAREPROGRAM"            14990000
$ CONTROL SEGMENT = SEG20                                               14992000
PROCEDURE PREPAREPROGRAM;                                               14994000
   <<PREPARES A PROGRAM FILE FROM THE CURRENT USL FILE>>                14996000
   BEGIN                                                                14998000
                                                                        15002000
   << General-purpose variables: >>                                     15004000
                                                                        15006000
   byte    array B0(0:8) = PB := "$NEWPASS ";                           15008000
   double        OldTimer;        << Initial elapsed time >>            15010000
   double        OldProcTime;     << Initial process time >>            15012000
   logical       NewProg   := 0;  << New program file? >>               15014000
   integer       ProgRecd  := 0;  << Record counter/number >>           15016000
   double        NWCode    := 0D; << # words of code >>                 15018000
   integer       ErrorFlag := 0;  << Error flag >>                      15020000
   integer       SAFlut    := -1; << Starting address of FLUT >>        15022000
   integer       SaveDlArea1;     << Old DL area limit >>               15024000
   integer       SATrapCom := -1; << Starting addr of TrapCom>><<04102>>15026000
   logical       FOption;         << Actual prog file FOptions><<04102>>15028000
   logical       FCode;           << Actual program file code ><<04102>>15030000
   integer       CurrentSeg;      << Addr of current seg entry >>       15032000
   integer       Status;          << Status returned from procs>>       15034000
   integer       CstIndex;        << Loop index >>                      15036000
   double  array SegPointer(0:255); << PMAP segment pointers >><<04102>>15038000
   ARRAY          TEMPBUF(*) = SEGPOINTER;                     <<04781>>15040000
   integer       Zero := 0;       << For call by reference >>  <<04102>>15042000
   INTEGER       PERMFNUM;                                     <<04781>>15044000
   LOGICAL       PERMFLAG;                                     <<04781>>15046000
   INTEGER       FERR;                                         <<04781>>15048000
                                                               <<04102>>15050000
   << Variables for program file PMAP generation. >>           <<04102>>15052000
                                                               <<04102>>15054000
   integer array SegInfo(0:1);    << Last 2 words of PMAP seg- <<04102>>15056000
                                  << ment record.              <<04102>>15058000
   integer       SaveRecNr;       << Save area for PMAP rec # ><<04102>>15060000
   integer       SaveBufDisp;     << Save area for PMAP displ. <<04102>>15062000
   INTEGER       NREXTN;          << PROGRAM FILE EXTENT       <<04102>>15064000
   DOUBLE        PFSIZEWORD;      << PROGRAM FILE SIZE IN WORD <<04102>>15066000
   DOUBLE        PFSIZERECORD;    << PROG FILE SIZE IN RECORD  <<04102>>15068000
   DOUBLE        TEMPSIZE;                                     <<04102>>15070000
   INTEGER       ERRORCODE;                                    <<04102>>15072000
$PAGE "CODE SEGMENT PREPARATION PROCEDURE - PREPAREPROGRAM"             15074000
SUBROUTINE FCLOSE'(FNUM,DISP);                                 <<04781>>15076000
                                                               <<04781>>15078000
   VALUE FNUM,DISP;                                            <<04781>>15080000
   INTEGER FNUM,DISP;                                          <<04781>>15082000
                                                               <<04781>>15084000
BEGIN                                                          <<04781>>15086000
   FGETINFO(FNUM,,,,,,,,,,,,,,,,NREXTN);                       <<04781>>15088000
   IF (DISP = SAVE OR DISP = TEMPFILE) AND NREXTN = 1 THEN     <<04781>>15090000
      DISP := DISP + %(2)1000;                                 <<04781>>15092000
   FCLOSE(FNUM,DISP,0);                                        <<04781>>15094000
   IF < THEN                                                   <<04781>>15096000
      FCHECK(FNUM,FERR)                                        <<04781>>15098000
   ELSE                                                        <<04781>>15100000
      FERR := -1;                                              <<04781>>15102000
END;                                                           <<04781>>15104000
                                                               <<04781>>15106000
SUBROUTINE COPYPROGFILE;                                       <<04781>>15108000
                                                               <<04781>>15110000
BEGIN                                                          <<04781>>15112000
   TOS := 0D;                                                  <<04781>>15114000
   FGETINFO(PERMFNUM,,,,,,,,,,,DS1);                           <<04781>>15116000
   TOS := FEOF(PROGFNUM);                                      <<04781>>15118000
   IF S1 > S0 THEN << OLD PERM PROG FILE IS BIG ENOUGH >>      <<04781>>15120000
      BEGIN                                                    <<04781>>15122000
         WHILE S0 > 0 DO                                       <<04781>>15124000
            BEGIN                                              <<04781>>15126000
               S0:=S0-1;                                       <<04781>>15128000
               FREADDIR'(PROGFNUM,TEMPBUF,S0);                 <<04781>>15130000
               FWRITEDIR'(PERMFNUM,TEMPBUF,S0);                <<04781>>15132000
            END;                                               <<04781>>15134000
      END                                                      <<04781>>15136000
   ELSE                                                        <<04781>>15138000
      BEGIN                                                    <<04781>>15140000
         ERRORFLAG := 1;                                       <<04781>>15142000
         ERROR(MSG'PFILETOOSMALL);                             <<04781>>15144000
      END;                                                     <<04781>>15146000
   FCLOSE'(PERMFNUM,NOCHANGE);                                 <<04781>>15148000
   FCLOSE'(PROGFNUM,NOCHANGE);                                 <<04781>>15150000
   DDEL;DEL;                                                   <<04781>>15152000
END;                                                           <<04781>>15154000
$PAGE                                                                   15156000
   subroutine PostScan(SegNameNw);                             <<04102>>15158000
      value SegNameNw;                                         <<04102>>15160000
      integer SegNameNw;          << # words in seg name >>    <<04102>>15162000
      BEGIN                                                             15164000
      IF SEGLEN <> 0 THEN  <<NULL SEGMENT?>>                            15166000
         BEGIN                                                          15168000
         PMAP(CSTNR) _ STTNR;  <<SAVE FIRST AVAIL. STT NR.>>            15170000
         SttPpCount(CstNr) := SttPpNr;                         <<02817>>15172000
         PMAPNW:=PMAPNW+DOUBLE(SEGNAMENW+SEGPMAPLEN);          <<04102>>15174000
         << ADJ. NR. REC'S >>                                  <<01113>>15176000
         TOS := SEGLEN;                                        <<01113>>15178000
         IF INITPATCH >= 0 THEN TOS := TOS+INITPATCH+19;       <<01113>>15180000
         ProgRecd := ProgRecd + (tos + SttPpNr + 127) / 128;   <<04102>>15182000
         CSTNR _ CSTNR+1  <<BUMP SEGMENT NR.>>                          15184000
         END                                                            15186000
      END;                                                              15188000
                                                                        15190000
   subroutine PostPrepare(SegNameNw);                          <<04102>>15192000
      value SegNameNw;                                         <<04102>>15194000
      integer SegNameNw;          << # words in seg name >>    <<04102>>15196000
                                                               <<04102>>15198000
      BEGIN                                                             15200000
      IF SEGLEN <> 0 THEN  <<NULL SEGMENT?>>                            15202000
         BEGIN                                                          15204000
         TOS _ SEGLEN;  <<SEGMENT LENGTH>>                              15206000
         TOS.(0:1) _ SEGPRIVILEGED;  <<PRIV. MODE BIT>>                 15208000
         PDESCRIP(CSTNR) _ TOS;  <<STORE SEG. DESCRIPTOR>>              15210000
         PWARNING _ LOGICAL(PWARNING) LOR LOGICAL(SEGWARNING);          15212000
         PMODE _ LOGICAL(PMODE) LOR SEGPRIVILEGED;                      15214000
         NWCODE _ NWCODE+DOUBLE(LOGICAL(SEGLEN));  <<ADJ. TOTAL CODE>>  15216000
         PROGRECD _ PROGRECD+(SEGLEN+127)&LSR(7);  <<NEXT REC. NR.>>    15218000
                                                               <<04102>>15220000
         IF FPMAP THEN                                         <<04102>>15222000
         BEGIN                                                 <<04102>>15224000
         SaveRecNr   := PmapRecNr;                             <<04102>>15226000
         SaveBufDisp := PmapBufDisp;                           <<04102>>15228000
         GetRecdDisp(SegPointer(CstNr) + double(SegNameNw),    <<04102>>15230000
                     PmapRecNr, PmapBufDisp);                  <<04102>>15232000
         if SaveRecNr <> PmapRecNr then                        <<04102>>15234000
            begin                                              <<04102>>15236000
            FWriteDir'(PmapFileNr, PmapBuf, SaveRecNr);        <<04102>>15238000
            FReadDir'(PmapFileNr, PmapBuf, PmapRecNr);         <<04102>>15240000
            end;                                               <<04102>>15242000
         SegInfo    := CstNr cat SttNr (0:8:8);                <<04102>>15244000
         SegInfo(1) := SegLen;                                 <<04102>>15246000
         CoreBufPmap(SegInfo, 2);                              <<04102>>15248000
         if SaveRecNr <> PmapRecNr then                        <<04102>>15250000
            begin                                              <<04102>>15252000
            FWriteDir'(PmapFileNr, PmapBuf, PmapRecNr);        <<04102>>15254000
            FReadDir'(PmapFileNr, PmapBuf, SaveRecNr);         <<04102>>15256000
            end;                                               <<04102>>15258000
         PmapRecNr   := SaveRecNr;                             <<04102>>15260000
         PmapBufDisp := SaveBufDisp;                           <<04102>>15262000
         END;                                                  <<04102>>15264000
                                                               <<04102>>15266000
         CSTNR _ CSTNR+1  <<BUMP SEGMENT NR.>>                          15268000
         END                                                            15270000
      ELSE CLEARLINE  <<CLEAR SEGMENT NAME IF NOT PRINTED>>             15272000
      END;                                                              15274000
$PAGE                                                                   15278000
   << Initialization. >>                                                15280000
                                                                        15282000
   OldTimer     := Timer;                                               15284000
   OldProcTime  := ProcTime;                                            15286000
   SaveDlArea1  := @DlArea1;                                            15288000
   PrepError    := 0;                                                   15290000
   OverflowFlag := 0;                                                   15292000
   SISeen       := false;                                      <<04102>>15294000
   ToolboxId    := 0;                                          <<04102>>15296000
                                                                        15298000
   << Allocate DL buffers. >>                                           15300000
                                                                        15302000
   MakeRoomInDL(PROGDLBUFS1);                                           15304000
   if < then                                                            15306000
      go NFG;                                                           15308000
   @Symbol       := @DLArea1      - 95;                                 15310000
   @Patch        := @Symbol       - 128;                                15312000
   @STT          := @Patch        - 1;                                  15314000
   @DirtyData    := @STT          - 271;                                15316000
   @STable       := @DirtyData;                                         15318000
   @DLArea1      := @STable;                                            15320000
                                                                        15322000
   @LogicalUnits := @DLArea2;                                           15324000
   @Prog0        := @LogicalUnits + 7;                                  15326000
   @Pmap         := @Prog0        & lsl(1) + 56;                        15328000
   @Common       := @Prog0        + 256;                                15330000
   @ComTab       := @Common       + 19;                                 15332000
   @DLAvail      := @ComTab       + 512;                                15334000
                                                                        15336000
   << Initialize DL buffers. >>                                         15338000
                                                                        15340000
   Symbol := 0;                   << Symbol hash table >>               15342000
   move Symbol(1) := Symbol, (94);                                      15344000
   UsedSymbol := 0;                                                     15346000
                                                                        15348000
   Patch := -1;                   << Patch record table >>              15350000
   move Patch(1) := Patch, (127);                                       15352000
   UsedPatch := 0;                                                      15354000
                                                                        15356000
   DirtyData := 0;                << Data segment table >>              15358000
   move DirtyData(1) := DirtyData, (15);                                15360000
   TRecD2 := 0;                                                         15362000
                                                                        15364000
   Prog0 := 0;                    << Program file record 0 >>  <<04102>>15366000
   move Prog0(1) := Prog0, (255);                              <<04102>>15368000
                                                                        15370000
   Common := %177774;             << Common table >>           <<04102>>15372000
   move Common(1) := Common, (BND4);                                    15374000
   NrComEnt := 0;                                                       15376000
                                                                        15378000
   LogicalUnits := 0;             << Logical unit table >>              15380000
   move LogicalUnits(1) := LogicalUnits, (34);                          15382000
   LUSpecified := false;                                                15384000
                                                                        15386000
   << Prepare to make first pass over program units. >>                 15388000
                                                                        15390000
   PmapNw       := 0D;                                         <<04102>>15392000
   CstNr        := 0;                                                   15394000
   NwPdb        := 0;                                                   15396000
   NwSdb        := 0;                                                   15398000
   ObAdr        := 0;                                                   15400000
   Pflags       := %4000;                                      <<04102>>15402000
   ProcStackEst := 0;                                                   15404000
   NwPustBuf    := 0;                                                   15406000
   NwSTLT       := NWSTLTPREFACE;                                       15408000
   ObPustAdr    := -1;                                                  15410000
   ProgramFile  := true;                                                15412000
   PutInfo;                       << Save INFO buffer >>                15414000
                                                                        15416000
   << Perform first pass over USL program units. >>                     15418000
                                                                        15420000
   CurrentSeg := UslSl;                                                 15422000
   while CurrentSeg <> 0 do                                             15424000
      begin                                                             15426000
      GetEntry(CurrentSeg);                                             15428000
      ScanSegment(EntFileAdr);                                          15430000
      if < then                                                         15432000
         go NFG;                                                        15434000
      PostScan(EntNameNw);                                     <<04102>>15436000
      CurrentSeg := EBL;                                                15438000
      end;                                                              15440000
                                                                        15442000
   if CstNr = 0 then                                                    15444000
      begin                                                             15446000
      Error(MSG'NOPROGTOPREP);    << No active segments >>              15448000
      go NFG;                                                           15450000
      end;                                                              15452000
                                                                        15454000
   if ObAdr = 0 then                                                    15456000
      begin                                                             15458000
      Error(MSG'NOOUTERBLOCK);    << No outer block >>                  15460000
      go NFG;                                                           15462000
      end;                                                              15464000
                                                                        15466000
   <<* * * SCAN RL PROCEDURES * * *>>                                   15468000
                                                                        15470000
   IF RLIBFNAME <> " " THEN  <<SEARCH RL?>>                             15472000
      BEGIN                                                             15474000
      SCANRL;                                                           15476000
      IF < THEN GO NFG;  <<ERROR?>>                                     15478000
      PostScan(3);                                             <<04102>>15480000
      END;                                                              15482000
                                                                        15484000
   if not SISeen then                                          <<04102>>15486000
      SymDBug := false;                                        <<04102>>15488000
   IF SYMDBUG THEN FPMAP:=1;                                   <<04102>>15490000
   PmapNw := PmapNw + 1D;         << For 0 terminator >>       <<04102>>15492000
                                                                        15494000
   <<* * * PARTIALLY INITIALIZE RECORD 0,1 * * *>>                      15496000
                                                                        15498000
   IF CSTNR > MAXCST THEN  <<TOO MANY SEGMENTS?>>                       15500000
      BEGIN                                                             15502000
      ERROR(39);                                                        15504000
      GO NFG                                                            15506000
      END;                                                              15508000
   @PDESCRIP _ @PROG0+(CSTNR+57)&LSR(1);  <<INIT. SEG. DESCRIP. PNTR>>  15510000
   PNS _ CSTNR;  <<NR. SEGMENTS>>                                       15512000
   TOS _ 1; IF CSTNR > 66 THEN TOS _ TOS+1; PSAG _ TOS;                 15514000
                                                                        15516000
   <<* * * ALLOCATE SPACE FOR COMMON ARRAYS * * *>>            <<01124>>15518000
                                                               <<01124>>15520000
   IF NRCOMENT <> 0 THEN                                       <<01124>>15522000
      BEGIN                                                    <<01124>>15524000
      HEADER9S';  << ALLOCATE DB AREA FOR COMMON ARRAYS >>     <<01124>>15526000
      IF < THEN GO NFG;                                        <<01124>>15528000
      END;                                                     <<01124>>15530000
                                                               <<04553>>15532000
   <<* * * CHECK DB OVERFLOW * * *>>                           <<04553>>15534000
                                                               <<04553>>15536000
   IF OVERFLOWFLAG THEN                                        <<04553>>15538000
      BEGIN                                                    <<04553>>15540000
         ERROR(38);                                            <<04553>>15542000
         GO NFG;                                               <<04553>>15544000
      END;                                                     <<04553>>15546000
                                                               <<01124>>15548000
   <<* * * OPEN PROGRAM FILE * * *>>                                    15550000
                                                                        15552000
                                                               <<04102>>15556000
   <<  ESTIMATE PROGRAM FILE SIZE  >>                          <<04102>>15558000
                                                               <<04102>>15560000
   PFSIZEWORD:=DOUBLE(NWPDB+       << PRIMARY DB      >>       <<04102>>15562000
                      NWSDB+       << SECONDARY DB    >>       <<04102>>15564000
                      NRCOMENT+    << COMMON LABELS   >>       <<04102>>15566000
                      NWSTLT);     << STLT            >>       <<04102>>15568000
   IF SEARCHSYM(BLANKCOMMON,SYMCOMMON) THEN                    <<04102>>15570000
      PFSIZEWORD:=PFSIZEWORD+DOUBLE(SNWCA); << COMMON DATA >>  <<04102>>15572000
   PFSIZERECORD:=(PFSIZEWORD+127D)&DLSR(7)+ << NR. REC'S   >>  <<04102>>15574000
                 DOUBLE(PSAG+               <<RECORD(S) 0,1>>  <<04102>>15576000
                        PROGRECD+      <<NR. REC'S FOR CODE>>  <<04102>>15578000
                        25 + 2 * CSTNR); << ENT. AND EXT. >>   <<04525>>15580000
   TEMPSIZE:=PFSIZERECORD; <<SAVE PROGRAM FILE SIZE WITHOUT>>  <<04102>>15582000
                           <<PMAP AND SI INFO              >>  <<04102>>15584000
   IF SYMDBUG THEN                                             <<04102>>15586000
         PFSIZERECORD:=PFSIZERECORD                            <<04102>>15588000
                       +USLFL&DLSR(7)        << SI REC'S   >>  <<04102>>15590000
                       +(PMAPNW+DOUBLE(CSTNR*2+  <<PMAP REC'S>><<04102>>15592000
                        NRPMAPTYPE+1)+127D)&DLSR(7)            <<04102>>15594000
   ELSE                                                        <<04102>>15596000
      IF FPMAP THEN                                            <<04102>>15598000
         PFSIZERECORD:=PFSIZERECORD+(PMAPNW+DOUBLE(CSTNR*2+    <<04102>>15600000
                                   NRPMAPTYPE+1)+127D)&DLSR(7);<<04102>>15602000
   NREXTN:=INTEGER(PFSIZERECORD/TEMPSIZE);                     <<04102>>15604000
   IF NREXTN > 16 THEN NREXTN:=16;                             <<04525>>15606000
                                                               <<04102>>15608000
   << CHECK PROGRAM FILE DOMAIN :                >>            <<04102>>15610000
   <<   IF IT IS OLD PERMANENT FILE,             >>            <<04102>>15612000
   <<    --CHECK FILE CODE, SET EOF TO RECORD 0; >>            <<04102>>15614000
   <<      THEN CREATE A NEW FILE.               >>            <<04781>>15616000
   <<      IF NEW FILE CAN NOT BE CREATED THEN   >>            <<04781>>15618000
   <<      SET PROGFNUM := PERMFNUM.             >>            <<04781>>15620000
   <<   IF IT IS OLD TEMPERARY FILE,             >>            <<04102>>15622000
   <<    --PURGE IT THEN CREATE A NEW FILE;      >>            <<04102>>15624000
   <<   IF IT IS NOT EXISTED,                    >>            <<04102>>15626000
   <<    --CREATE A NEW FILE;                    >>            <<04102>>15628000
   <<   IF IT IS $NEWPASS,                       >>            <<04102>>15630000
   <<    --CREATE A NEW FILE.                    >>            <<04102>>15632000
                                                               <<04102>>15634000
   PERMFLAG := FALSE;                                          <<04781>>15636000
   IF BFILENAME = B0,(8) THEN GO NEWFILE;                      <<04102>>15638000
                                                               <<04102>>15640000
   << FOPEN AN OLD PERM/TEMP FILE               >>             <<04102>>15642000
   <<  NECESSARY TO SPECIFY THE FILE SIZE AND   >>             <<04102>>15644000
   <<  FILE CODE IN CASE OF :FILE COMMAND       >>             <<04102>>15646000
   <<  SPECIFYING THE FILE                      >>             <<04102>>15648000
                                                               <<04102>>15650000
   PERMFNUM:=FOPEN(BFILENAME,%(2)10000000011,%(2)101010100,    <<04781>>15652000
                   ,,,,,,PFSIZERECORD,NREXTN,,PROGFILECODE);   <<04102>>15654000
   IF < THEN      << OPEN FAILED? >>                           <<04102>>15656000
      BEGIN                                                    <<04102>>15658000
         FCHECK(0,ERRORCODE);                                  <<04102>>15660000
         IF ERRORCODE=58 THEN  << NO $OLDPASS >>               <<04102>>15662000
            BEGIN                                              <<04102>>15664000
               MOVE BFILENAME:=B0,(9);                         <<04102>>15666000
               GO NEWFILE;                                     <<04102>>15668000
            END;                                               <<04102>>15670000
         IF NOT (52<=ERRORCODE<=53) THEN  << ERROR OTHER THAN  <<04102>>15672000
            BEGIN                         << NONEXISTENT FILE  <<04102>>15674000
               ERRORN(MSG'CANTOPENPROGFILE,DOUBLE(ERRORCODE)); <<04102>>15676000
               GO NFG;                                         <<04102>>15678000
            END;                                               <<04102>>15680000
      END                                                      <<04102>>15682000
   ELSE         << OPEN SUCCEEDED >>                           <<04102>>15684000
      BEGIN                                                    <<04102>>15686000
         FGETINFO(PERMFNUM,,FOPTION,,,,,,FCODE);               <<04781>>15688000
         IF FOPTION.(14:2)=1 THEN  << OLD PERMANENT FILE >>    <<04102>>15690000
            BEGIN                                              <<04102>>15692000
               IF FCODE <> PROGFILECODE THEN                   <<04102>>15694000
                  BEGIN                                        <<04102>>15696000
                     ERROR(MSG'BADPROGFILE);                   <<04102>>15698000
                     GO BADFILE;                               <<04102>>15700000
                  END;                                         <<04102>>15702000
               FCONTROL(PERMFNUM,6,I);                         <<04781>>15704000
               PERMFLAG := TRUE;                               <<04781>>15706000
               GO NEWFILE;                                     <<04781>>15708000
            END;                                               <<04102>>15710000
         IF FOPTION.(14:2)=2 THEN  << OLD TEMPARARY FILE >>    <<04102>>15712000
            BEGIN                                              <<04781>>15714000
               FCLOSE(PERMFNUM,4,0);                           <<04781>>15716000
               PERMFNUM := 0;                                  <<04781>>15718000
            END;                                               <<04781>>15720000
      END;                                                     <<04102>>15722000
   NEWFILE:                                                    <<04102>>15724000
                                                               <<04102>>15726000
   << FOPEN AS A NEW FILE >>                                   <<04102>>15728000
                                                               <<04102>>15730000
   PROGFNUM:=FOPEN(BFILENAME,%(2)10000000000,%(2)101010100,    <<04102>>15732000
                  ,,,,,,PFSIZERECORD,NREXTN,,PROGFILECODE);    <<04102>>15734000
   IF < THEN                                                   <<04102>>15736000
      BEGIN                                                    <<04102>>15738000
         IF PERMFLAG THEN                                      <<04781>>15740000
            PROGFNUM := PERMFNUM                               <<04781>>15742000
         ELSE                                                  <<04781>>15744000
            BEGIN                                              <<04781>>15746000
               FCHECK(0,ERRORCODE);                            <<04781>>15748000
               ERRORN(MSG'CANTOPENPROGFILE,DOUBLE(ERRORCODE)); <<04781>>15750000
               GO NFG;                                         <<04781>>15752000
            END;                                               <<04781>>15754000
      END;                                                     <<04102>>15756000
                                                               <<04102>>15760000
   BLANKLINE;                                                  <<04102>>15762000
   TOS:=PROGFNUM;                                              <<04102>>15764000
   MOVE BLINE:="PROGRAM FILE ",2;                              <<04102>>15766000
   FGETINFO (*,*);                                             <<04102>>15768000
   PRINTLINE;                                                  <<04102>>15770000
   BLANKLINE;                                                  <<04102>>15772000
                                                               <<04102>>15774000
                                                                        15776000
   <<* * * ALLOCATE BLANK COMMON AND INITIALIZE DATA LABELS * * *>>     15778000
                                                                        15780000
   IF NRCOMENT <> 0 THEN ALLOCATECOMMON;  <<COMMON DATA LABELS?>>       15782000
                                                                        15784000
   <<* * * COMPOSE FLUT * * *>>                                         15786000
                                                                        15788000
   IF LUSPECIFIED THEN SAFLUT _ COMPOSEFLUT;  <<LOGICAL UNITS?>>        15790000
                                                                        15792000
   <<* * * COMPOSE STLT * * *>>                                         15794000
                                                                        15796000
   SASTLT _ -1;  <<INIT. STLT ADR.>>                                    15798000
   IF NWSTLT <> NWSTLTPREFACE THEN COMPOSESTLT;  <<TRACED?>>            15800000
                                                                        15802000
   IF SEARCHSYM (TRAPCOM',SYMCOMMON) THEN SATRAPCOM := SSACA + NWPDB;   15804000
   <<* * * PARTIALLY INITIALIZE RECORD 0,1 * * *>>                      15806000
                                                                        15808000
   TOS _ PFLAGS;                                                        15810000
   TOS.(2:1) _ ZERODB;  <<ZERO DB?>>                                    15812000
   TOS := USERCAP2;  <<USER'S RESOURCE CAPABILITIES>>                   15814000
   TOS := CAPABILITY;  <<CAPABILITIES SPECIFIED>>                       15816000
   IF = THEN  <<USE IA,BA DEFAULT?>>                                    15818000
      BEGIN                                                             15820000
      TOS := %(2)0110000000;  <<IA,BA MASK>>                            15822000
      ASSEMBLE(DELB,AND)  <<IA,BA SUBSET>>                              15824000
      END                                                               15826000
   ELSE  <<CHECK FOR LEGAL SUBSET>>                                     15828000
      BEGIN                                                             15830000
      ASSEMBLE(DDUP,AND; LCMP,DEL);  <<SUBSET>>                         15832000
      IF <> THEN  <<ILLEGAL SPECIFICATION?>>                            15834000
         BEGIN                                                          15836000
         ERROR(33);                                                     15838000
         GO NFG                                                         15840000
         END;                                                           15842000
      TOS := CAPABILITY; <<CAPABILITIES SPECIFIED>>            <<01504>>15844000
      IF LS0 LAND %600 <> 0 THEN                               <<01504>>15846000
         TOS := TOS LOR (USERCAP2 LAND %600);                  <<01504>>15848000
      END;                                                              15850000
   TOS.(6:10) _ TOS;  <<PROG. CAPABILITIES>>                            15852000
   PFLAGS _ TOS;  <<FLAG WORD>>                                         15854000
   TOS _ NWPDB+NWSDB;  <<GLOBAL SIZE>>                                  15856000
   IF OVERFLOW OR OVERFLOWFLAG OR S0 > MAXDATA THEN            <<02816>>15858000
      BEGIN                                                             15860000
      ERROR(38);                                                        15862000
      GO NFG                                                            15864000
      END;                                                              15866000
   PGS _ TOS;  <<GLOBAL AREA SIZE>>                                     15868000
   PSAS _ PSAG+(PGS+127)&LSR(7);  <<REC. NR. OF SEGMENT SET>>           15870000
   IF INITSTACK = -1 THEN  <<CALCULATE DEFAULT STACK SIZE?>>            15872000
      BEGIN                                                             15874000
      TOS _ OBSTACKEST+PROCSTACKEST+P256;  <<STACK ESTIMATE>>           15876000
      IF LUSPECIFIED THEN TOS := TOS+P384; << FORMATTER EST. >>         15878000
      TOS := SDBDEFAULTSTACK;                                  <<00.DM>>15880000
      ASSEMBLE(DDUP,CMP);                                               15882000
      IF > THEN ASSEMBLE(XCH);  <<LEAVE LARGEST ON TOS>>                15884000
      IF NWSTLT <> NWSTLTPREFACE THEN TOS := TOS+461  <<TRACE EST.>>    15886000
      END                                                               15888000
   ELSE  <<USE SPECIFIED VALUE>>                                        15890000
      BEGIN                                                             15892000
      TOS := INITSTACK;                                                 15894000
      IF < THEN  <<ILLEGAL VALUE?>>                                     15896000
         BEGIN                                                          15898000
         ERROR(70);                                                     15900000
         GO NFG                                                         15902000
         END                                                            15904000
      END;                                                              15906000
   PISS _ TOS;  <<STACK ESTIMATE>>                                      15908000
   IF INITDL = -1 THEN  <<CALCULATE DEFAULT DL SIZE?>>                  15910000
      TOS := DEFAULTDL  <<DEFAULT DL SIZE>>                             15912000
   ELSE  <<USE SPECIFIED VALUE>>                                        15914000
      BEGIN                                                             15916000
      TOS := INITDL;                                                    15918000
      IF < THEN  <<ILLEGAL VALUE?>>                                     15920000
         BEGIN                                                          15922000
         ERROR(71);                                                     15924000
         GO NFG                                                         15926000
         END                                                            15928000
      END;                                                              15930000
   PIDL := TOS;  <<DL SIZE>>                                            15932000
   IF INITMAXDATA = -1 THEN  <<CALCULATE DEFAULT MAXDATA SIZE?>>        15934000
      TOS := DEFAULTMAXDATA  <<DEFAULT MAXDATA SIZE>>                   15936000
   ELSE  <<USE SPECIFIED VALUE>>                                        15938000
      BEGIN                                                             15940000
      TOS := INITMAXDATA;                                               15942000
      IF < THEN  <<ILLEGAL VALUE?>>                                     15944000
         BEGIN                                                          15946000
         ERROR(72);                                                     15948000
         GO NFG                                                         15950000
         END                                                            15952000
      END;                                                              15954000
   PMAXD := TOS;  <<MAX. DATA SEGMENT SIZE>>                            15956000
   PSASTLT _ SASTLT;  <<DB ADR. OF STLT>>                               15958000
   PSAFLUT _ SAFLUT;  <<DB ADR. OF FLUT>>                               15960000
   PSATRAPCOM := SATRAPCOM;  <<DB ADR. OF TRAPCOM'>>           <<00.BV>>15962000
                                                                        15964000
   <<* * * TRUNCATE DL AREA 2 TABLES * * *>>                            15966000
                                                                        15968000
   TOS _ @PDESCRIP(CSTNR);  <<NEW S.A. COMMON HASH LINK TABLE>>         15970000
   TOS _ @COMMON;  <<OLD S.A. COMMON HASH LINK TABLE>>                  15972000
   TOS _ 19;  <<TABLE LENGTH>>                                          15974000
   @COMMON _ S2;  <<UPDATE POINTER>>                                    15976000
   ASSEMBLE(MOVE 2);                                                    15978000
   TOS _ @COMTAB;  <<OLD S.A. OF COMMON TABLE>>                         15980000
   TOS _ NRCOMENT&LSL(1);  <<TABLE LENGTH>>                             15982000
   @COMTAB _ S2;  <<UPDATE POINTER>>                                    15984000
   ASSEMBLE(MOVE 2);                                                    15986000
   TOS _ @RLTABLE;  <<OLD S.A. OF RL TABLE>>                            15988000
   TOS _ 3*NRRLENT;  <<TABLE LENGTH>>                                   15990000
   @RLTABLE _ S2;  <<UPDATE POINTER>>                                   15992000
   ASSEMBLE(MOVE 2);                                                    15994000
   @DLAVAIL _ TOS;                                                      15996000
   MAKEROOMINDL(NWPUSTBUF);                                             15998000
   IF < THEN GO NFG;  <<ERROR?>>                                        16000000
   @PUSTBUF _ @DLAVAIL;  <<S.A. PUST BUFFER>>                           16002000
   @PTABLE _ @PUSTBUF+NWPUSTBUF;  <<S.A. PATCH TABLE>>                  16004000
   @DLAVAIL _ @PTABLE;  <<S.A. DL AVAILABLE AREA>>                      16006000
                                                               <<04102>>16008000
   <<* * * Open the PMAP scratch file * * *>>                  <<04102>>16010000
                                                               <<04102>>16012000
   IF FPMAP THEN                                               <<04102>>16014000
   BEGIN                                                       <<04102>>16016000
   CreatePmapScratch(CstNr, Status);                           <<04102>>16018000
   if Status <> STATUS'OK then                                 <<04102>>16020000
      go NFG;                                                  <<04102>>16022000
   END;                                                        <<04102>>16024000
                                                               <<04102>>16026000
   <<* * * Open the SI scratch file * * *>>                    <<04102>>16028000
                                                               <<04102>>16030000
   if SymDBug then                                             <<04102>>16032000
      begin                                                    <<04102>>16034000
      CreateSIScratch(Status);                                 <<04102>>16036000
      if Status <> STATUS'OK then                              <<04102>>16038000
         go NFG;                                               <<04102>>16040000
      end;                                                     <<04102>>16042000
                                                                        16044000
   <<* * * PREPARE USL PROGRAM UNITS * * *>>                            16046000
                                                                        16048000
   CSTNR _ 0;  <<RE-INIT. SEGMENT NR.>>                                 16050000
   NWSTLT _ NWSTLTPREFACE;  <<RE-INIT. NR. WORDS IN STLT>>              16052000
   PROGRECD _ PSAS;  <<REC. NR. OF FIRST SEGMENT>>                      16054000
   GETINFO;  <<RE-LOAD INFO BLOCK IF POSSIBLE>>                         16056000
   GETENTRY(USLSL);  <<GET FIRST SEGMENT ENTRY>>                        16058000
   DO BEGIN                                                             16060000
      SttPpNr := Pmap(CstNr); << 1st STT for private procs >>  <<02817>>16062000
      SttNr   := SttPpNr + SttPpCount(CstNr); << 1st extern STT<<02817>>16064000
      IF FPMAP THEN                                            <<04102>>16066000
      SegPointer(CstNr) := double(PmapRecNr) * 128D +          <<04102>>16068000
                           double(PmapBufDisp);                <<04102>>16070000
      PREPARESEGMENT(ENTFILEADR,PROGFNUM,PROGRECD);                     16072000
      IF < THEN GO NFG;  <<ERROR?>>                                     16074000
      PostPrepare(EntNameNw);                                  <<04102>>16076000
      TOS _ EBL;  <<NEXT SEGMENT ENTRY>>                                16078000
      IF <> THEN GETENTRY(*)                                            16080000
      END UNTIL =;                                                      16082000
                                                                        16084000
   <<* * * PREPARE RL SEGMENT * * *>>                                   16086000
                                                                        16088000
   IF RLIBFNAME <> " " THEN  <<SEARCH RL?>>                             16090000
      BEGIN                                                             16092000
      SttPpNr := Pmap(CstNr); << 1st STT for private procs >>  <<02817>>16094000
      SttNr   := SttPpNr + SttPpCount(CstNr); << 1st extern STT<<02817>>16096000
      IF FPMAP THEN                                            <<04102>>16098000
      SegPointer(CstNr) := double(PmapRecNr) * 128D +          <<04102>>16100000
                           double(PmapBufDisp);                <<04102>>16102000
      @ENTP:=@RLSEG;  << POINTER TO RL SEG ENTRY SO >>         <<04780>>16104000
                      << ENAME IS "RLSEG"           >>         <<04780>>16106000
      PREPARERL(PROGRECD);                                              16108000
      IF < THEN GO NFG;  <<ERROR?>>                                     16110000
      PostPrepare(3);                                          <<04102>>16112000
      END;                                                              16114000
                                                                        16116000
   <<* * * APPLY ALL ACTIVE BLOCK DATA PROGRAM UNITS * * *>>            16118000
                                                                        16120000
   IF USLBDL <> 0 THEN  <<BLOCK DATA'S?>>                               16122000
      BEGIN                                                             16124000
      APPLYBLOCKDATAS;                                                  16126000
      IF < THEN GO NFG  <<ERROR?>>                                      16128000
      END;                                                              16130000
                                                                        16132000
   <<* * * COMPLETE DATA SEGMENT INITIALIZATION * * *>>                 16134000
                                                                        16136000
   IF TDISP2 <> 0 THEN  <<NON-EMPTY BUFFER?>>                           16138000
      BEGIN                                                             16140000
      FWRITEDIR'(PROGFNUM,TBUF2,TRECD2);                                16142000
      SETBIT(DIRTYDATA,TRECD2-PSAG)                                     16144000
      END;                                                              16146000
   IF ZERODB THEN  <<ZERO REMAINING RECORDS?>>                          16148000
      BEGIN                                                             16150000
      TOS := @TBUF2; PS0 := 0;                                          16152000
      ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3);                 16154000
      TOS := PSAS-PSAG;  <<NR. REC'S>>                                  16156000
      WHILE <> DO                                                       16158000
         BEGIN                                                          16160000
         IF NOT TESTBIT(DIRTYDATA,S0-1) THEN                            16162000
            FWRITEDIR'(PROGFNUM,TBUF2,S0-1+PSAG);                       16164000
         TOS := TOS-1                                                   16166000
         END                                                            16168000
      END;                                                              16170000
                                                                        16172000
   <<* * * COMPOSE EXTERNAL LIST * * *>>                                16174000
                                                                        16176000
   PSAX _ PROGRECD;  <<REC. NR. OF EXTERNAL LIST>>                      16178000
   TRECD1 _ PROGRECD;                                                   16180000
   TDISP1 _ 0;                                                          16182000
   @SYMP _ @STABLE;                                                     16184000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 16186000
      BEGIN                                                             16188000
      SYMENTPARMS;                                                      16190000
      IF SYMTYPE = 7 THEN COREBUF1(SNAME,SYMNW-2);                      16192000
      @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                               16194000
      END;                                                              16196000
   TBUF1(TDISP1) _ 0;  <<LIST TERMINATOR>>                              16198000
   FWRITEDIR'(PROGFNUM,TBUF1,TRECD1);                                   16200000
   PROGRECD _ TRECD1+1;  <<NEXT AVAIL. REC. NR.>>                       16202000
                                                                        16204000
   <<* * * COMPOSE ENTRY POINT LIST * * *>>                             16206000
                                                                        16208000
   PSAE _ PROGRECD;  <<REC. NR. OF ENTRY POINT LIST>>                   16210000
   TRECD1 _ PROGRECD;                                                   16212000
   TDISP1 _ 0;                                                          16214000
   @SYMP _ @STABLE;                                                     16216000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 16218000
      BEGIN                                                             16220000
      SYMENTPARMS;                                                      16222000
      IF (1 <= SYMTYPE <= 2) THEN  <<O.B. ENTRY POINT?>>                16224000
         BEGIN                                                          16226000
         IF SYMTYPE = 1 THEN OBSYMTABADR := @SYMP;             <<01124>>16228000
         TOS _ @BUF;                                                    16230000
         MOVE BUF _ SNAME,(SYMNAMENW),2;                                16232000
         TOS _ SSACODE;  <<PB ADR.>>                                    16234000
         TOS _ SSTTNR;  <<STT NR.>>                                     16236000
         DPS2 _ TOS;                                                    16238000
         COREBUF1(*,TOS+2-@BUF)                                         16240000
         END;                                                           16242000
      @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                               16244000
      END;                                                              16246000
   TBUF1(TDISP1) _ 0;  <<LIST TERMINATOR>>                              16248000
   FWRITEDIR'(PROGFNUM,TBUF1,TRECD1);                                   16250000
   PROGRECD _ TRECD1+1;  <<NEXT AVAIL. REC. NR.>>                       16252000
                                                               <<04102>>16254000
   <<* * * Pass scratch files to TOOLBOX son process. * * *>>  <<04102>>16256000
                                                               <<04102>>16258000
   IF FPMAP THEN  BEGIN                                        <<04102>>16260000
   CoreBufPmap(Zero, 1);          << PMAP terminator >>        <<04102>>16262000
   ActivateToolbox(SegPointer, CstNr, Status);                 <<04102>>16264000
   if Status <> STATUS'OK then                                 <<04102>>16266000
      go NFG;                                                  <<04102>>16268000
                                                               <<04102>>16270000
   <<* * * Copy PMAP scratch file to program file. * * *>>     <<04102>>16272000
                                                               <<04102>>16274000
   PsaPmap := ProgRecd;                                        <<04102>>16276000
   Trecd1  := ProgRecd;                                        <<04102>>16278000
   Tdisp1  := 0;                                               <<04102>>16280000
   for CstIndex := 0 until CstNr - 1 do                        <<04102>>16282000
      SegPointer(CstIndex) := double(ProgRecd) & dlsl(7) +     <<04102>>16284000
                              SegPointer(CstIndex) - 128D;     <<04102>>16286000
   COREBUF1(TYPETABLE,TYPETABLELEN);                           <<04102>>16288000
   COREBUF1(SEGPOINTER,CSTNR*2);                               <<04102>>16290000
   MasterBufd(ProgFnum, PmapFileNr, Tbuf1, Trecd1, Tdisp1,     <<04102>>16292000
             TRUE,DOUBLE(128+TYPETABLELEN+CSTNR*2),TBUF1,      <<04102>>16294000
             PmapNw);                                          <<04102>>16296000
   if TDisp1 <> 0 then                                         <<04102>>16298000
      begin                                                    <<04102>>16300000
      FWriteDir'(ProgFNum, TBuf1, TRecd1);                     <<04102>>16302000
      TRecd1 := TRecd1 + 1;                                    <<04102>>16304000
      end;                                                     <<04102>>16306000
   FClose(PmapFileNr, 4, 0);                                   <<04102>>16308000
   if <> then                                                  <<04102>>16310000
      begin                                                    <<04102>>16312000
      Error(MSG'CANTCLOSESCRATCH);                             <<04102>>16314000
      go NFG;                                                  <<04102>>16316000
      end;                                                     <<04102>>16318000
   ProgRecd := Trecd1;                                         <<04102>>16320000
   END;                                                        <<04102>>16322000
                                                               <<04102>>16324000
   <<* * * Copy SI scratch file to program file. * * *>>       <<04102>>16326000
                                                               <<04102>>16328000
   if SymDBug then                                             <<04102>>16330000
      begin                                                    <<04102>>16332000
      PsaSym := ProgRecd;                                      <<04102>>16334000
      Trecd1 := ProgRecd;                                      <<04102>>16336000
      Tdisp1 := 0;                                             <<04102>>16338000
      MasterBufd(ProgFnum, SIFileNr, Tbuf1, Trecd1, Tdisp1,    <<04102>>16340000
                true, 0D, Tbuf1,double(FEOF(SIFileNr))*128d);  <<04102>>16342000
      FClose(SIFileNr, 4, 0);                                  <<04102>>16344000
      if <> then                                               <<04102>>16346000
         begin                                                 <<04102>>16348000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>16350000
         go NFG;                                               <<04102>>16352000
         end;                                                  <<04102>>16354000
      ProgRecd := Trecd1;                                      <<04102>>16356000
      end;                                                     <<04102>>16358000
                                                                        16360000
   <<* * * COMPLETE INITIALIZATION OF RECORD 0,1 * * *>>                16362000
                                                                        16364000
   @SYMP _ OBSYMTABADR;  <<O.B. SYM. TAB. ADR.>>                        16366000
   SYMENTPARMS;                                                         16368000
   PSSEG _ SSEGNR;  <<STARTING SEG. NR.>>                               16370000
   PSADR _ SSACODE;  <<PB STARTING ADR.>>                               16372000
   PSSTT _ SSTTNR;  <<STARTING STT NR.>>                                16374000
   IF CHECKSUMSPECIFIED THEN                                   <<04257>>16376000
      PCKSUM:=1;                                               <<04257>>16378000
   IF INITPATCH >= 0 THEN                                      <<04257>>16380000
      PPATCH:=1;                                               <<04257>>16382000
   XREG _ CSTNR-1;                                                      16384000
   DO BEGIN                                                             16386000
      PMAP(XREG) _ XREG;                                                16388000
      XREG _ XREG-1                                                     16390000
      END UNTIL <;                                                      16392000
   FWRITEMR'(PROGFNUM,PROG0,PSAG&LSL(7),0);                             16394000
                                                                        16396000
   <<* * * PRINT PROGRAM FILE PARAMETERS * * *>>                        16398000
                                                                        16400000
   IF PREPERROR <> 0 THEN GO NFG; << ERRORS? >>                <<01.DM>>16402000
   BLANKLINE;                                                           16404000
   MOVE BLINE _ "PRIMARY DB"; NTOA(NWPDB,8,BLINE(20));                  16406000
   MOVE BLINE(25) _ "INITIAL STACK"; NTOA(PISS,8,BLINE(45));            16408000
   MOVE BLINE(50) _ "CAPABILITY"; NTOA(PCAP,8,BLINE(70));               16410000
   PRINTLINE;                                                           16412000
   MOVE BLINE _ "SECONDARY DB"; NTOA(NWSDB,8,BLINE(20));                16414000
   MOVE BLINE(25) _ "INITIAL DL"; NTOA(PIDL,8,BLINE(45));               16416000
   MOVE BLINE(50) _ "TOTAL CODE"; DNTOA(NWCODE,8,BLINE(70));            16418000
   PRINTLINE;                                                           16420000
   MOVE BLINE _ "TOTAL DB"; NTOA(NWPDB+NWSDB,8,BLINE(20));              16422000
   MOVE BLINE(25) _ "MAXIMUM DATA";                                     16424000
   IF PMAXD = -1 THEN BLINE(45) _ "?" ELSE NTOA(PMAXD,8,BLINE(45));     16426000
   MOVE BLINE(50) _ "TOTAL RECORDS"; NTOA(PROGRECD,8,BLINE(70));        16428000
   PRINTLINE;                                                           16430000
   TOS _ 0;                                                             16432000
   FGETINFO(PROGFNUM,,,,,,,,,,,,,,,S0);                                 16434000
   IF TOS < PSAX THEN WARN(34);  <<MORE THAN ONE EXTENT?>>              16436000
   GO AOK;                                                              16438000
                                                                        16440000
   <<* * * DEALLOCATE DL BUFFERS * * *>>                                16442000
                                                                        16444000
   NFG:                                                                 16446000
   IF PROGFNUM <> 0 THEN  <<PROG. FILE OPEN?>>                          16448000
      BEGIN                                                             16450000
      FPOINT(PROGFNUM,0D);                                              16452000
      FCONTROL(PROGFNUM,6,I)  <<SET EOF TO 0>>                          16454000
      END;                                                              16456000
   BADFILE:                                                             16458000
   ERRORFLAG := ERRORFLAG+1;  <<SET ERROR FLAG>>                        16460000
                                                                        16462000
   AOK:                                                                 16464000
   USLINFOINCORE _ FALSE;  <<INFO BLOCK MODIFIED!>>                     16466000
   INFOADR := DOUBLE(-MAXHEAD);  <<CLEAR INFO ADR.>>                    16468000
   GETINFO;  <<TRY TO RELOAD INFO BLOCK>>                               16470000
   NRRLENT _ 0;  <<MARK RL TABLE EMPTY>>                                16472000
   @DLAREA1 _ SAVEDLAREA1;  <<RESET DL AREA 1 LIMIT>>                   16474000
   @DLAVAIL _ @DLAREA2;  <<RESET DL AVAILABLE AREA LIMIT>>              16476000
                                                                        16478000
   <<* * * CLOSE RL LIBRARY FILE * * *>>                                16480000
                                                                        16482000
   TOS _ RLIBFNUM;                                                      16484000
   IF <> THEN  <<RL LIBRARY FILE OPEN?>>                                16486000
      BEGIN                                                             16488000
      FCLOSE(*,0,0);                                                    16490000
      IF < THEN  <<ERROR?>>                                             16492000
         BEGIN                                                          16494000
         TOS _ 23;                                                      16496000
         TOS _ 0D; FCHECK(RLIBFNUM,S0);  <<FILE SYS. ERROR NR.>>        16498000
         ERRORN(*,*)                                                    16500000
         END;                                                           16502000
      TOS := 0                                                          16504000
      END;                                                              16506000
   RLIBFNUM _ TOS;                                                      16508000
                                                                        16510000
   <<* * * CLOSE PROGRAM FILE * * *>>                                   16512000
                                                                        16514000
   IF LOGICAL(ERRORFLAG) THEN                                  <<04781>>16518000
      BEGIN                                                    <<04781>>16520000
         IF PERMFNUM <> 0 THEN FCLOSE(PERMFNUM,NOCHANGE,0);    <<04781>>16522000
         IF PROGFNUM <> 0 THEN FCLOSE(PROGFNUM,NOCHANGE,0);    <<04781>>16524000
      END                                                      <<04781>>16526000
   ELSE                                                        <<04781>>16528000
   IF PERMFLAG THEN                                            <<04781>>16530000
      BEGIN                                                    <<04781>>16532000
         IF PROGFNUM = PERMFNUM THEN                           <<04781>>16534000
            BEGIN                                              <<04781>>16536000
               FCLOSE'(PROGFNUM,SAVE);                         <<04781>>16538000
               IF FERR <> -1 THEN                              <<04781>>16540000
                  ERRORN(MSG'CANTCLOSEPROGFILE,DOUBLE(FERR));  <<04781>>16542000
            END                                                <<04781>>16544000
         ELSE                                                  <<04781>>16546000
            BEGIN                                              <<04781>>16548000
               FCLOSE'(PROGFNUM,SAVE);                         <<04781>>16550000
               IF FERR <> -1 THEN                              <<04781>>16552000
                  IF FERR = DUP'NAME THEN                      <<04781>>16554000
                     BEGIN                                     <<04781>>16556000
                        FCLOSE'(PERMFNUM,DELETE);              <<04781>>16558000
                        IF FERR <> -1 THEN                     <<04781>>16560000
                           COPYPROGFILE                        <<04781>>16562000
                        ELSE                                   <<04781>>16564000
                           BEGIN                               <<04781>>16566000
                              FCLOSE'(PROGFNUM,SAVE);          <<04781>>16568000
                              IF FERR <> -1 THEN               <<04781>>16570000
                                 ERRORN(36,DOUBLE(FERR));      <<04781>>16572000
                           END;                                <<04781>>16574000
                     END                                       <<04781>>16576000
                  ELSE                                         <<04781>>16578000
                     COPYPROGFILE                              <<04781>>16580000
               ELSE                                            <<04781>>16582000
                  FCLOSE'(PERMFNUM,DELETE);                    <<04781>>16584000
            END                                                <<04781>>16586000
      END                                                      <<04781>>16588000
   ELSE                                                        <<04781>>16590000
      BEGIN                                                    <<04781>>16592000
         FCLOSE'(PROGFNUM,TEMPFILE);                           <<04781>>16594000
         IF FERR <> -1 THEN                                    <<04781>>16596000
            ERRORN(MSG'CANTCLOSEPROGFILE,DOUBLE(FERR));        <<04781>>16598000
      END;                                                     <<04781>>16600000
   PERMFNUM:=0;                                                <<04781>>16602000
   PROGFNUM:=0;                                                <<04781>>16604000
                                                                        16606000
   <<* * * PRINT ELAPSED TIME AND PROCESS TIME * * *>>                  16608000
                                                                        16610000
   IF NOT LOGICAL(ERRORFLAG) THEN  <<NO ERRORS?>>                       16612000
      BEGIN                                                             16614000
      MOVE BLINE := "ELAPSED TIME   00:00:00.000";                      16616000
      TOS := TIMER-OLDTIMER;  <<ELAPSED TIME>>                          16618000
      TOS := 1000; ASSEMBLE(LDIV); NTOA(*,10,BLINE(26));  <<MILLISEC.>> 16620000
      TOS := 60; ASSEMBLE(DIV); NTOA(*,10,BLINE(22));  <<SECONDS>>      16622000
      TOS := 60; ASSEMBLE(DIV); NTOA(*,10,BLINE(19));  <<MINUTES>>      16624000
      NTOA(*,10,BLINE(16));  <<HOURS>>                                  16626000
      MOVE BLINE(45) := "PROCESSOR TIME   00:00.000";                   16628000
      TOS := PROCTIME-OLDPROCTIME;  <<PROCESSOR TIME>>                  16630000
      TOS := 1000; ASSEMBLE(LDIV); NTOA(*,10,BLINE(70));  <<MILLISEC.>> 16632000
      TOS := 60; ASSEMBLE(DIV); NTOA(*,10,BLINE(66));  <<SECONDS>>      16634000
      NTOA(*,10,BLINE(63));  <<MINUTES>>                                16636000
      PRINTLINE                                                         16638000
      END;                                                              16640000
   EJECTPAGE                                                            16642000
   END;                                                                 16644000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - ALLOCATECOMMON"   <<00207>>16646000
$ CONTROL SEGMENT = SEG23                                               16648000
PROCEDURE ALLOCATECOMMON;                                               16650000
  <<ALLOCATES THE BLANK COMMON ARRAY AND INITIALIZES THE DATA           16652000
     LABELS>>                                                           16654000
   BEGIN                                                                16656000
   BYTE ARRAY B0 (0:22)=PB := "COMMON ARRAY ALLOCATION";                16658000
   byte array B1(*) = PB := "NAME              ADR   LEN";     <<02817>>16660000
                                                               <<01124>>16664000
   <<* * * PUT DATA LABEL IN BUFFER * * *>>                    <<01124>>16666000
                                                               <<01124>>16668000
   NWPDB := NWPDB+NRCOMENT;                                    <<01124>>16670000
   IF OVERFLOW THEN OVERFLOWFLAG:=1;                           <<02816>>16672000
   @COMP := @COMTAB;                                           <<01124>>16674000
   TOS := @BUF;                                                <<01124>>16676000
   TOS := NRCOMENT;                                            <<01124>>16678000
   DO BEGIN                                                    <<01124>>16680000
      TOS := COMP(1)+NWPDB;                                    <<01124>>16682000
      IF LOGICAL(COMP) THEN TOS := TOS+NWPDB;                  <<01124>>16684000
      PS2 := TOS;                                              <<01124>>16686000
      @COMP := @COMP+2;                                        <<01124>>16688000
      ASSEMBLE(INCB,DECA);                                     <<01124>>16690000
      END UNTIL =;                                             <<01124>>16692000
   BUFFERDATAWORDS(NWPDB-NRCOMENT,BUF,NRCOMENT,1);  <<DATA LABELS>>     16694000
                                                                        16696000
   <<* * * PRINT COMMON ARRAY ALLOCATION MAP * * *>>                    16698000
                                                                        16700000
   MOVE BLINE := B0,(23);                                               16702000
   PRINTLINE;                                                           16704000
   BLANKLINE;                                                           16706000
   move Bline(3) := B1, (27);                                  <<02817>>16708000
   PRINTLINE;                                                           16710000
   @SYMP := @STABLE;  <<INIT. ENTRY POINTER>>                           16712000
   DO BEGIN                                                             16714000
      SYMENTPARMS;  <<SET ENTRY PARM'S>>                                16716000
      IF SYMTYPE = 6 THEN  <<COMMON ARRAY ENTRY?>>                      16718000
         BEGIN                                                          16720000
         TOS := @BLINE(3); TOS := @SNAME&LSL(1)+1;                      16722000
         MOVE * := *,(SYMNC);  <<COMMON NAME>>                          16724000
         IF SNWCA = 0 THEN  <<BASIC COMMON?>>                           16726000
            BEGIN                                                       16728000
            BLINE(23) := "?";  <<DB ADDRESS>>                           16730000
            BLINE(29) := "?"  <<LENGTH>>                                16732000
            END                                                         16734000
         ELSE  <<REGULAR COMMON>>                                       16736000
            BEGIN                                                       16738000
            NTOA(NWPDB+SSACA,8,BLINE(23));  <<DB ADDRESS>>              16740000
            NTOA(SNWCA,8,BLINE(29))  <<LENGTH>>                         16742000
            END;                                                        16744000
         PRINTLINE                                                      16746000
         END;                                                           16748000
      @SYMP := @SYMP+SYMNW  <<NEXT ENTRY>>                              16750000
      END UNTIL @SYMP = @STABLE(USEDSYMBOL);                            16752000
   BLANKLINE;                                                  <<01124>>16754000
   END;                                                                 16756000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - COMPOSEFLUT"      <<00207>>16758000
$ CONTROL SEGMENT = SEG23                                               16760000
INTEGER PROCEDURE COMPOSEFLUT;                                          16762000
   <<COMPOSES THE FORTRAN LOGICAL UNIT TABLE (FLUT) AND INSERTS IT      16764000
     INTO THE PROGRAM FILE.  THE DB STARTING ADDRESS OF THE FLUT IS     16766000
     THEN RETURNED>>                                                    16768000
   BEGIN                                                                16770000
   INTEGER SAFLUT = COMPOSEFLUT;                                        16772000
   TOS := @BUF;  <<FLUT BUFFER>>                                        16774000
   XREG := 99;  <<LOGICAL UNIT NR.>>                                    16776000
   DO BEGIN                                                             16778000
      IF TESTBIT(LOGICALUNITS,XREG) THEN  <<LOGICAL UNIT SPECIFIED?>>   16780000
         BEGIN                                                          16782000
         PS0 := XREG&LSL(8);  <<FLUT ENTRY>>                            16784000
         @PS0 := @PS0+1  <<BUMP TABLE INDEX>>                           16786000
         END;                                                           16788000
      XREG := XREG-1                                                    16790000
      END UNTIL =;                                                      16792000
   PS0 := -1;  <<TABLE TERMINATOR>>                                     16794000
   TOS := TOS-@BUF+1;  <<FLUT LENGTH>>                                  16796000
   SAFLUT := NWPDB+NWSDB;  <<S.A. OF FLUT>>                             16798000
   BUFFERDATAWORDS(SAFLUT,BUF,S0,1);  <<INSERT FLUT>>                   16800000
   NWSDB := TOS + NWSDB;  <<ADJ. SEC. DB COUNTER>>             <<02816>>16802000
   IF OVERFLOW THEN OVERFLOWFLAG:=1;                           <<02816>>16804000
   END;                                                                 16806000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - COMPOSESTLT"      <<00207>>16808000
$ CONTROL SEGMENT = SEG23                                               16810000
PROCEDURE COMPOSESTLT;                                                  16812000
   <<COMPOSES THE SYMBOL TABLE LOCATION TABLE (STLT) FOR TRACE AND      16814000
     INSERTS IT INTO THE PROGRAM FILE>>                                 16816000
   BEGIN                                                                16818000
                                                                        16820000
   <<* * * COMPOSE AND INSERT STLT PREFACE * * *>>                      16822000
                                                                        16824000
   SASTLT _ NWPDB+NWSDB;  <<S.A. OF STLT>>                              16826000
   TOS _ @BUF; PS0 _ 0;  <<CLEAR BUFFER>>                               16828000
   ASSEMBLE(DUP,INCB); TOS _ NWSTLTPREFACE; ASSEMBLE(MOVE 3);           16830000
   BUF _ SASTLT+NWSTLT;  <<F.A.+1 OF STLT>>                             16832000
   BUF(7) _ IF OBPUSTADR = -1 THEN -1 ELSE NWPDB+OBPUSTADR;             16834000
   BUFFERDATAWORDS(SASTLT,BUF,NWSTLTPREFACE,1);  <<STLT PREFACE>>       16836000
                                                                        16838000
   <<* * * COMPOSE AND INSERT STLT ENTRIES * * *>>                      16840000
                                                                        16842000
   TOS _ SASTLT+NWSTLTPREFACE;  <<INIT. DB ADR.>>                       16844000
   @SYMP_ @STABLE;                                                      16846000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 16848000
      BEGIN                                                             16850000
      SYMENTPARMS;                                                      16852000
      IF SYMTYPE = 1 OR SYMTYPE = 3 THEN                                16854000
         BEGIN                                                          16856000
         TOS _ SSASDB-SSAPUST;  <<PUST LENGTH>>                         16858000
         IF <> THEN  <<IS THERE A PUST?>>                               16860000
            BEGIN                                                       16862000
            TOS _ NWPDB+SSAPUST;  <<S.A. OF PUST>>                      16864000
            BUFFERDATAWORDS(S2,AS0,1,1);  <<S.A. OF PUST>>              16866000
            ASSEMBLE(DEL,INCB)                                          16868000
            END;                                                        16870000
         DEL                                                            16872000
         END;                                                           16874000
      @SYMP _ @SYMP+SYMNW  <<NEXT ENTRY>>                               16876000
      END;                                                              16878000
                                                                        16880000
   NWSDB := NWSDB + NWSTLT;  <<ADJ. SEC. DB COUNTER>>          <<02816>>16882000
   IF OVERFLOW THEN OVERFLOWFLAG:=1;                           <<02816>>16884000
   END;                                                                 16886000
$PAGE "CODE SEGMENT PREPARATION PROCEDURES - APPLYBLOCKDATAS"  <<00207>>16888000
$ CONTROL SEGMENT = SEG23                                               16890000
PROCEDURE APPLYBLOCKDATAS;                                              16892000
   <<APPLYS ALL ACTIVE BLOCK DATA PROGRAM UNITS.  NOTE THAT THIS        16894000
     PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>           16896000
   BEGIN                                                                16898000
   DEFINE FATAL' = (LOGICAL(ENTP(2).(1:1)))#,                           16900000
          WARNING' = (LOGICAL(ENTP(2).(2:1)))#;                         16902000
   TOS _ USLBDL;  <<FIRST BLOCK DATA ADR.>>                             16904000
   WHILE <> DO                                                          16906000
      BEGIN                                                             16908000
      GETENTRY(*);                                                      16910000
      IF ACTIVE THEN                                                    16912000
         BEGIN                                                          16914000
         IF FATAL' THEN  <<FATAL ERROR?>>                               16916000
            BEGIN                                                       16918000
            ERRORS(46,ENAME);                                           16920000
            GO NFG                                                      16922000
            END;                                                        16924000
         IF WARNING' THEN WARNS(47,ENAME);  <<NON-FATAL ERROR?>>        16926000
         DO BEGIN                                                       16928000
            IF NOT SEARCHSYM(BDP(1),SYMCOMMON) THEN  <<NO COMMON?>>     16930000
               BEGIN                                                    16932000
               WARNS(68,BDP(1));                               <<00299>>16934000
                 <<SKIP TO NEXT COMMON DECLARATION>>           <<00299>>16936000
               WHILE GETNEXTHEADER(FALSE,%(2)10000) DO;        <<00299>>16938000
               GO NEXTCOM;                                     <<00299>>16940000
               END;                                                     16942000
            IF BDP <> SNWCA THEN  <<DIFFERENT LENGTH?>>                 16944000
               BEGIN                                                    16946000
               ERRORS(69,BDP(1));                                       16948000
               PREPERROR := PREPERROR+1;                       <<01.DM>>16950000
               END;                                                     16952000
            SDBADR _ NWPDB+SSACA;                                       16954000
            WHILE GETNEXTHEADER(FALSE,%(2)10000) DO                     16956000
               HEADER4P; <<SDB/OWN/DATA INIT. VALUES>>         <<00299>>16958000
NEXTCOM:                                                       <<00299>>16960000
            END UNTIL NOT BLOCKDATARESET                                16962000
         END;                                                           16964000
      TOS _ EBL  <<NEXT BLOCK DATA ENTRY ADR.>>                         16966000
      END;                                                              16968000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    16970000
   GO GETOUT;                                                           16972000
                                                                        16974000
   NFG:                                                                 16976000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 16978000
                                                                        16980000
   GETOUT:                                                              16982000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             16984000
   END;                                                                 16986000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - OPENSL"               <<00207>>16988000
<<----------------------------------------------------------------------16990000
*                                                                      *16992000
*  SL FILE MAINTAINENCE PROCEDURES                                     *16994000
*                                                                      *16996000
---------------------------------------------------------------------->>16998000
                                                                        17000000
$ CONTROL SEGMENT = SEG30                                               17002000
PROCEDURE OPENSL (NEWFILE);                                             17004000
   <<PRESERVES ANY INFORMATION IN CORE THAT MAY BE DESTROYED BY         17006000
     LOADING THE SL, THEN LOADS THE SL AND INITIALIZES THE NECESSARY    17008000
     GLOBAL PARAMETERS.  IF NEWFILE IS SET, RECORD 0 IS INITIALIZED     17010000
     ACCORDING TO THE PARAMETERS IN THE COMMAND BUFFER; OTHERWISE       17012000
     RECORD 0 IS LOADED>>                                               17014000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      17016000
   BEGIN                                                                17018000
   INTEGER SAVEDLAREA1;                                        <<00.DM>>17020000
   INTEGER EXTSIZE;    <<EXTENT SIZE>>                         <<00.DM>>17022000
   DOUBLE FLSIZE;      <<FILE SIZE>>                           <<00.DM>>17024000
   INTEGER FLAG := 0;  <<DL BUFFERS JUST ALLOCATED?>>          <<00.DM>>17026000
   INTEGER AOPTIONS := 0;                                      <<00563>>17028000
                                                                        17030000
   SUBROUTINE CLEAR (FLAG,BITMAP);                                      17032000
      LOGICAL FLAG;                                                     17034000
      ARRAY BITMAP;                                                     17036000
      BEGIN                                                             17038000
      FLAG _ FALSE;                                                     17040000
      TOS _ @BITMAP; PS0 _ 0;                                           17042000
      ASSEMBLE(DUP,INCB); TOS _ 15; ASSEMBLE(MOVE 3)                    17044000
      END;                                                              17046000
                                                                        17048000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           17050000
                                                                        17052000
   SAVEDLAREA1 _ @DLAREA1;  <<SAVE DL AREA 1 LIMIT>>           <<00.DM>>17054000
                                                                        17056000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  17058000
                                                                        17060000
   IF NOT SLBUFALLOC THEN  <<BUFFERS ALLOCATED?>>                       17062000
      BEGIN                                                             17064000
      MAKEROOMINDL(SLDLBUFS1);                                          17066000
      IF < THEN GO NFG;  <<ERROR?>>                                     17068000
      @SLMAP _ @DLAREA1-128;                                            17070000
      @SPLREC1 _ @SLMAP-128;                                            17072000
      @SPLREC0 _ @SPLREC1-128;                                          17074000
      @SPLDIR _ @SPLREC0-128;                                           17076000
      @RTBUF _ @SPLDIR-128;                                             17078000
      @ADDEDSEGS _ @RTBUF-16;                                           17080000
      @DELETEDSEGS _ @ADDEDSEGS-16;                                     17082000
      @MODIFIEDSEGS _ @DELETEDSEGS-16;                                  17084000
      @DLAREA1 := @MODIFIEDSEGS;  <<NEW DL AREA 1 LIMIT>>               17086000
      SLBUFALLOC := TRUE;  <<SET FLAG>>                                 17088000
      FLAG := FLAG+1  <<SET FLAG>>                                      17090000
      END;                                                              17092000
                                                                        17094000
   <<* * * PRESERVE OVERLAYABLE INFORMATION * * *>>                     17096000
                                                                        17098000
   CLOSESL;                                                             17100000
   IF < THEN GO NFG;  <<ERROR?>>                                        17102000
                                                                        17104000
   <<* * * LOAD NEW SL INFORMATION * * *>>                              17106000
                                                                        17108000
   IF SCRATCHFNUM = 0 THEN  <<OPEN SCRATCH FILE?>>                      17110000
      BEGIN                                                             17112000
      SCRATCHFNUM _ FOPEN(,%(2)10000000000,%(2)111010100,,,,,,,160D);   17114000
      IF < THEN  <<ERROR?>>                                             17116000
         BEGIN                                                          17118000
         TOS _ 82;                                                      17120000
         TOS _ 0D; FCHECK(0,S0);                                        17122000
         ERRORN(*,*);                                                   17124000
         GO NFG                                                         17126000
         END                                                            17128000
      END;                                                              17130000
   IF NEWFILE THEN  <<INIT. RECORD 0 AND 1?>>                           17132000
      BEGIN                                                             17134000
      IF NOT (MINSL <= FILESIZE <= MAXSL) THEN                          17136000
         BEGIN                                                          17138000
         BADSPEC:                                                       17140000
         ERROR(17);                                                     17142000
         GO NFG                                                         17144000
         END;                                                           17146000
      SPLFNUM _ FOPEN(BFILENAME,%(2)10000000000,%(2)111010100,,,,,,,    17148000
         DOUBLE(LOGICAL(FILESIZE)),NREXTENTS,,SLFILECODE);              17150000
      IF < THEN  <<ERROR?>>                                             17152000
         BEGIN                                                          17154000
         FOPENERROR:                                                    17156000
         TOS _ 18;                                                      17158000
         TOS _ 0D; FCHECK(0,S0);  <<FILE SYS. ERROR NR.>>               17160000
         ERRORN(*,*);                                                   17162000
         GO NFG                                                         17164000
         END;                                                           17166000
                                                                        17168000
      <<* * * INITIALIZE RECORD 0 * * *>>                               17170000
                                                                        17172000
      TOS _ @SPLREC0; PS0 _ 0;                                          17174000
      ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);                  17176000
      SPLLID := SLFILEID;  <<VERSION NR.>>                              17178000
      SPLFL _ FILESIZE;  <<FILE LENGTH (IN RECORDS)>>                   17180000
      << GET NR REC'S IN EXTENT >>                             <<00.DM>>17182000
      FGETINFO(SPLFNUM,,,,,,,,,,,,,,,SPLEL);                   <<00.DM>>17184000
      IF SPLEL < MINSLEL THEN GO BADSPEC; <<TOO SMALL>>        <<00.DM>>17186000
      SPLFRTL _ -1;  <<S.A. OF FREE REF. TABLE ENTRY LIST>>             17188000
      SLNS _ (LOGICAL(FILESIZE)+2047)&LSR(11);  <<NR. SECTIONS>>        17190000
                                                                        17192000
      <<* * * INITIALIZE FREE STORAGE MAPS * * *>>                      17194000
                                                                        17196000
      TOS _ SLNS;  <<SECTION COUNTER>>                                  17198000
      DO BEGIN                                                          17200000
         TOS _ @SLMAP; PS0 _ -1;  <<INIT. MAP BUFFER>>                  17202000
         ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);               17204000
         IF S0 = 1 THEN  <<FIRST SECTION?>>                             17206000
            BEGIN                                                       17208000
            XREG _ SLNS+1;                                              17210000
            DO BEGIN                                                    17212000
               CLEARBIT(SLMAP,XREG);                                    17214000
               XREG _ XREG-1                                            17216000
               END UNTIL <                                              17218000
            END;                                                        17220000
         IF S0 = SLNS THEN  <<LAST SECTION?>>                           17222000
            BEGIN                                                       17224000
            TOS _ SPLFL.(5:11);                                         17226000
            WHILE <> DO                                                 17228000
               BEGIN                                                    17230000
               CLEARBIT(SLMAP,S0);                                      17232000
               TOS _ (TOS+1).(5:11)                                     17234000
               END;                                                     17236000
            DEL                                                         17238000
            END;                                                        17240000
         FWRITEDIR'(SPLFNUM,SLMAP,S0+1);                                17242000
         TOS _ TOS-1                                                    17244000
         END UNTIL =;                                                   17246000
      TOS _ FALSE;  <<BYPASS SL CHECKS>>                                17248000
      SLSTATE.(1:2) := %(2)11  <<INIT. STATE WORD>>                     17250000
      END                                                               17252000
   ELSE  <<LOAD RECORDS 0 AND 1>>                                       17254000
      BEGIN                                                             17256000
      GETPRIVMODE;  <<GET INTO PRIV. MODE>>                             17258000
      SPLFNUM _ FOPEN(BFILENAME,%(2)10000000011,%(2)111110110);         17260000
      IF < THEN  <<ERROR?>>                                             17262000
         BEGIN                                                          17264000
         GETUSERMODE;  <<BACK INTO USER MODE>>                          17266000
         GO FOPENERROR                                                  17268000
         END;                                                           17270000
      GETUSERMODE;  <<BACK INTO USER MODE>>                             17272000
      ASSEMBLE(ADDS 5);                                                 17276000
      FGETINFO(SPLFNUM,BBUF,S4,AOPTIONS,,,S1,,S0,,,FLSIZE,,,,  <<00563>>17278000
               EXTSIZE,NREXTENTS,,,DS3);                       <<00563>>17280000
      IF AOPTIONS.(7:9) <> %766 THEN                           <<00563>>17282000
         BEGIN                                                 <<00563>>17284000
         ERROR(96);                                            <<00563>>17286000
         CLOSESL;                                              <<00563>>17288000
         GO NFG;                                               <<00563>>17290000
         END;                                                  <<00563>>17292000
      FLOCK(SPLFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>           <<00563>>17294000
      FREADMR'(SPLFNUM,SPLREC0,P384,0); <<RECORDS 0,1 AND MAP>><<00563>>17296000
      IF TOS <> SLFILECODE OR SPLLID <> SLFILEID THEN                   17298000
         BEGIN                                                          17300000
         ERROR(19);                                                     17302000
         GO NFG                                                         17304000
         END;                                                           17306000
      IF NREXTENTS <> 1 THEN                                   <<00.DM>>17308000
         IF INTEGER(FLSIZE) <> SPLFL OR EXTSIZE <> SPLEL THEN  <<00.DM>>17310000
            BEGIN                                              <<00.DM>>17312000
            CLOSESL;                                           <<00198>>17314000
            ERROR(19);  <<INVALID SL FILE>>                    <<00.DM>>17316000
            GO NFG;                                            <<00.DM>>17318000
            END;                                               <<00.DM>>17320000
      BS2 _ TOS;  <<INSERT LOGICAL DEVICE NR.>>                         17322000
      SLKEY _ TOS;  <<SL FILE KEY>>                                     17324000
      ASSEMBLE(ZERO,XCH);                                               17326000
      IF TOS AND BBUF = "SL." THEN TOS _ TOS+1;  <<REAL SL FILE?>>      17328000
      SLSTATE.(1:2) := %(2)00  <<INIT. STATE WORD>>                     17330000
      END;                                                              17332000
   REALSL _ TOS;  <<SL CHECK FLAG>>                                     17334000
   IF BBUF = "SL.PUB.SYS " THEN                                <<00807>>17336000
     BEGIN                                                     <<00807>>17338000
       GETPRIVMODE;                                            <<00807>>17340000
       INITLOADCACHE;                                          <<00807>>17342000
       GETUSERMODE;                                            <<00807>>17344000
     END;                                                      <<00807>>17346000
                                                                        17348000
   <<* * * INIT. GLOBAL PARAMETERS * * *>>                              17350000
                                                                        17352000
   ASSEMBLE(DZRO,DZRO);                                                 17354000
   SLMAPRECD _ 2; SLMAPMODIFIED _ TOS;                                  17356000
   LIBENTRYMODIFIED _ TOS;                                              17358000
   RTRECD _ TOS; RTMODIFIED _ TOS;                                      17360000
   CLEAR(SEGSADDED,ADDEDSEGS);                                          17362000
   CLEAR(SEGSDELETED,DELETEDSEGS);                                      17364000
   CLEAR(SEGSMODIFIED,MODIFIEDSEGS);                                    17366000
   GO GETOUT;                                                           17368000
                                                                        17370000
   NFG:                                                                 17372000
   IF LOGICAL(FLAG) THEN  <<DEALLOCATE BUFFERS?>>                       17374000
      BEGIN                                                             17376000
      @DLAREA1 := SAVEDLAREA1;  <<RESTORE DL AREA 1 LIMIT>>             17378000
      SLBUFALLOC := FALSE  <<CLEAR FLAG>>                               17380000
      END;                                                              17382000
                                                                        17384000
   GETOUT:                                                              17386000
   END;                                                                 17388000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - CLOSESL"              <<00207>>17390000
$ CONTROL SEGMENT = SEG30                                               17392000
PROCEDURE CLOSESL;                                                      17394000
   <<IF A SL FILE IS OPENED, SAVES THE INFORMATION IN CORE THAT         17396000
     HAS BEEN MODIFIED: SAVES RECORDS 0 AND 1, IF MODIFIED, AND         17398000
     TAKES THE TRANSITIVE CLOSURE OF THE REFERENCE MATRIX, IF           17400000
     NECESSARY.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO    17402000
     INDICATE AN ERROR>>                                                17404000
   BEGIN                                                                17406000
   TOS := SPLFNUM;  <<SL FILE NR.>>                                     17408000
   IF <> THEN  <<SL OPENED?>>                                           17410000
      BEGIN                                                             17412000
      FIXUPSL(FALSE);                                                   17414000
      FCLOSE(SPLFNUM,SLNEW,0);  <<CLOSE SL FILE>>                       17416000
      IF < THEN  <<ERROR?>>                                             17418000
         BEGIN                                                          17420000
         TOS _ 10;                                                      17422000
         TOS _ 0D; FCHECK(SPLFNUM,S0);  <<FILE SYS. ERROR NR.>>         17424000
         ERRORN(*,*);                                                   17426000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           17428000
         GO GETOUT                                                      17430000
         END;                                                           17432000
      SLSTATE.(1:2) := %(2)00;  <<RE-SET STATE WORD>>                   17434000
      SPLFNUM := 0  <<CLEAR FILE NR.>>                                  17436000
      END;                                                              17438000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    17440000
                                                                        17442000
   GETOUT:                                                              17444000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             17446000
   END;                                                        <<00207>>17448000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - FINDSLSPACE"          <<00207>>17452000
$ CONTROL SEGMENT = SEG30                                               17454000
INTEGER PROCEDURE FINDSLSPACE (NRRECS);                                 17456000
   <<FINDS SPACE IN THE SL FILE FOR A BLOCK OF NRRECS RECORDS SUCH THAT 17458000
     THE BLOCK DOES NOT SPAN AN EXTENT.  THE FIRST RECORD OF THE BLOCK  17460000
     IS RETURNED AS THE RESULT.  NOTE THAT THIS PROCEDURE USES THE      17462000
     CONDITION CODE TO INDICATE AN ERROR>>                              17464000
   VALUE NRRECS;                                                        17466000
   INTEGER NRRECS;                                                      17468000
   BEGIN                                                                17470000
   INTEGER SECTIONNR = Q+1;                                             17472000
   INTEGER BLOCKNR = Q+2;                                               17474000
   INTEGER BLOCKS = Q+3;                                                17476000
                                                                        17478000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           17480000
                                                                        17482000
   TOS _ 0;  <<SECTION NR.>>                                            17484000
   TOS _ 0;  <<BLOCK NR.>>                                              17486000
   TOS _ NRRECS;  <<NR. BLOCKS NEEDED>>                                 17488000
                                                                        17490000
   <<* * * SEARCH FREE STORAGE MAPS * * *>>                             17492000
                                                                        17494000
   TOS _ SLNS;  <<SECTION COUNTER>>                                     17496000
   DO BEGIN                                                             17498000
      GETSLMAP(SECTIONNR);  <<LOAD SECTION MAP>>                        17500000
      BLOCKNR _ 0;                                                      17502000
      TOS _ 2048;  <<BLOCK COUNTER>>                                    17504000
      DO BEGIN                                                          17506000
         IF TESTBIT(SLMAP,BLOCKNR) AND                                  17508000
            (NRRECS = 1 OR                                     <<00465>>17510000
            (SECTIONNR&LSL(11)+BLOCKNR+1) MOD SPLEL <> 0) THEN <<00465>>17512000
            BEGIN                                                       17514000
            BLOCKS _ BLOCKS-1;  <<ADJ. BLOCKS NEEDED>>                  17516000
            IF = THEN GO FOUNDSPACE                                     17518000
            END                                                         17520000
         ELSE <<BLOCK NOT USABLE>>                                      17522000
            BEGIN                                                       17524000
            BLOCKS _ NRRECS;  <<RESET BLOCKS NEEDED>>                   17526000
            FINDSLSPACE :=       <<UPDATE S.A. OF SPACE>>               17528000
            (LOGICAL (SECTIONNR)&LSL (11))+LOGICAL (BLOCKNR)+1;         17530000
            END;                                                        17532000
         BLOCKNR _ BLOCKNR+1;                                           17534000
         TOS _ TOS-1                                                    17536000
         END UNTIL =;                                                   17538000
      SECTIONNR _ SECTIONNR+1;                                          17540000
      ASSEMBLE(DEL,DECA)                                                17542000
      END UNTIL =;                                                      17544000
   ERROR(11);  <<NO ROOM>>                                              17546000
   GO NFG;                                                              17548000
                                                                        17550000
   <<* * * ALLOCATE SPACE * * *>>                                       17552000
                                                                        17554000
   FOUNDSPACE:                                                          17556000
   DO BEGIN                                                             17558000
      CLEARBIT(SLMAP,BLOCKNR);  <<MARK BLOCK "USED">>                   17560000
      SLMAPMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      17562000
      BLOCKNR _ BLOCKNR-1;                                              17564000
      IF < THEN                                                         17566000
         BEGIN                                                          17568000
         BLOCKNR _ 2047;                                                17570000
         SECTIONNR _ SECTIONNR-1;                                       17572000
         GETSLMAP(SECTIONNR)  <<LOAD NEXT MAP>>                         17574000
         END;                                                           17576000
      NRRECS _ NRRECS-1                                                 17578000
      END UNTIL =;                                                      17580000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    17582000
   GO GETOUT;                                                           17584000
                                                                        17586000
   NFG:                                                                 17588000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 17590000
                                                                        17592000
   GETOUT:                                                              17594000
   CONDCODE _ TOS                                                       17596000
   END;                                                                 17598000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - RETURNSLSPACE"        <<00207>>17602000
$ CONTROL SEGMENT = SEG30                                               17604000
PROCEDURE RETURNSLSPACE (RECD,NRRECS);                                  17606000
   VALUE RECD,NRRECS;                                                   17608000
   INTEGER RECD,NRRECS;                                                 17610000
   <<RETURNS NRRECS RECORDS OF SPACE IN THE SL FILE BEGINNING WITH      17612000
     RECD RECORD>>                                                      17614000
   BEGIN                                                                17616000
   TOS _ RECD.(0:5);  <<STARTING SECTION NR.>>                          17618000
   TOS _ RECD.(5:11);  <<STARTING BLOCK NR.>>                           17620000
   GETSLMAP(S1);  <<LOAD SECTION MAP>>                                  17622000
   DO BEGIN                                                             17624000
      SETBIT(SLMAP,S0);  <<MARK BLOCK "FREE">>                          17626000
      SLMAPMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      17628000
      TOS _ (TOS+1).(5:11);                                             17630000
      IF = THEN  <<NEW SECTION?>>                                       17632000
         BEGIN                                                          17634000
         S1 _ S1+1;                                                     17636000
         GETSLMAP(S1)  <<LOAD NEXT SECTION MAP>>                        17638000
         END;                                                           17640000
      NRRECS _ NRRECS-1                                                 17642000
      END UNTIL =                                                       17644000
   END;                                                                 17646000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SLTOTALFREESPACE"     <<00465>>17648000
$ CONTROL SEGMENT = SEG30                                      <<00465>>17650000
INTEGER PROCEDURE SLTOTALFREESPACE;                            <<00465>>17652000
BEGIN                                                          <<00465>>17654000
   INTEGER BLOCKS=SLTOTALFREESPACE;                            <<00465>>17656000
                                                               <<00465>>17658000
   TOS := SLNS-1;  <<SECTION COUNTER>>                         <<00465>>17660000
   DO BEGIN                                                    <<00465>>17662000
      GETSLMAP(S0); <<LOAD SECTION MAP>>                       <<00465>>17664000
      TOS := 2047;  <<BLOCK COUNTER>>                          <<00465>>17666000
      DO BEGIN                                                 <<00465>>17668000
         IF TESTBIT( SLMAP, S0) THEN BLOCKS:=BLOCKS+1;         <<00465>>17670000
         TOS := TOS-1;                                         <<00465>>17672000
         END UNTIL <;                                          <<00465>>17674000
      ASSEMBLE( DEL, DECA);                                    <<00465>>17676000
      END UNTIL <;                                             <<00465>>17678000
END;                                                           <<00465>>17680000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - GETSLMAP"             <<00465>>17682000
$ CONTROL SEGMENT = SEG30                                               17684000
PROCEDURE GETSLMAP (SECTIONNR);                                         17686000
   <<LOADS THE BIT MAP FOR THE SPECIFIED SECTION NUMBER>>               17688000
   VALUE SECTIONNR;                                                     17690000
   INTEGER SECTIONNR;                                                   17692000
   BEGIN                                                                17694000
   SECTIONNR _ SECTIONNR+1;                                             17696000
   SECTIONNR _ SECTIONNR+1;  <<CONVERT TO REC. NR.>>                    17698000
   IF SLMAPRECD <> SECTIONNR THEN  <<DIFFERENT MAP?>>                   17700000
      BEGIN                                                             17702000
      SAVESLMAP;  <<SAVE CURRENT MAP>>                                  17704000
      SLMAPRECD _ SECTIONNR;                                            17706000
      FREADDIR'(SPLFNUM,SLMAP,SLMAPRECD)  <<LOAD MAP>>                  17708000
      END                                                               17710000
   END;                                                                 17712000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SAVESLMAP"            <<00207>>17714000
$ CONTROL SEGMENT = SEG30                                               17716000
PROCEDURE SAVESLMAP;                                                    17718000
   <<SAVES THE CURRENT SECTION BIT MAP IF IT HAS BEEN MODIFIED>>        17720000
   BEGIN                                                                17722000
   IF SLMAPMODIFIED THEN  <<MAP MODIFIED?>>                             17724000
      BEGIN                                                             17726000
      FWRITEDIR'(SPLFNUM,SLMAP,SLMAPRECD);                              17728000
      SLMAPMODIFIED _ FALSE  <<CLEAR MODIFIED FLAG>>                    17730000
      END                                                               17732000
   END;                                                                 17734000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SEARCHSEGNAME"        <<00207>>17736000
$ CONTROL SEGMENT = SEG30                                               17738000
INTEGER PROCEDURE SEARCHSEGNAME (NAME);                                 17740000
   <<SEARCHES THE REFERENCE TABLE ENTRIES FOR THE GIVEN SEGMENT         17742000
     NAME.  IF FOUND, THE SEGMENT NUMBER IS RETURNED AND THE            17744000
     REFERENCE TABLE POINTER (RTP) IS SET TO THE ENTRY; OTHERWISE       17746000
     A -1 IS RETURNED.  NOTE THAT THE NAME IS A 16 BYTE ARRAY           17748000
     WITH NO CHARACTER COUNT AND WITH TRAILING BLANKS>>                 17750000
   BYTE ARRAY NAME;                                                     17752000
   BEGIN                                                                17754000
   INTEGER SEGNR = SEARCHSEGNAME;                                       17756000
   FOR SEGNR _ 0 UNTIL SPLNRT-1 DO                                      17758000
      BEGIN                                                             17760000
      GETREFTABENTRY(SEGNR);                                            17762000
      IF NOT DELETEDSEG THEN                                            17764000
         BEGIN                                                          17766000
         TOS _ @SLRSEGNAME&LSL(1);                                      17768000
         IF * = NAME,(16) AND NOT TESTBIT(DELETEDSEGS,SEGNR) THEN RETURN17770000
         END                                                            17772000
      END;                                                              17774000
   SEGNR _ -1                                                           17776000
   END;                                                                 17778000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SEARCHSPL"            <<00207>>17780000
$ CONTROL SEGMENT = SEG30                                               17782000
LOGICAL PROCEDURE SEARCHSPL (NAME);                                     17784000
   <<SEARCHES THE SL DIRECTORY FOR THE ENTRY HAVING THE SPECIFIED NAME. 17786000
     IF THE ENTRY IS FOUND THE VALUE TRUE IS RETURNED AND THE ENTRY     17788000
     PARAMETERS ARE SET; OTHERWISE RETURNS THE VALUE FALSE.  NOTE THAT  17790000
     THIS PROCEDURE SAVES THE PREVIOUS DIRECTORY RECORD NUMBER>>        17792000
   INTEGER ARRAY NAME;                                                  17794000
   BEGIN                                                                17796000
   CLEANUPLIBBUF;  <<SAVE MODIFIED ENTRY>>                              17798000
   BUCKETINDEX _ SPLFHI+HASH(NAME);  <<INDEX OF HASH LIST>>             17800000
   SPLRECD _ 0;                                                         17802000
   SLNEXTRECD _ SPLREC0(BUCKETINDEX);  <<FIRST REC. IN LIST>>           17804000
   WHILE GETNEXTLIBRECD DO                                              17806000
      BEGIN                                                             17808000
      @SPLP _ @SPLDIR(2);  <<INIT. ENTRY POINTER>>                      17810000
      WHILE @SPLP < @SPLDIR(SLRECDUSED) DO                              17812000
         BEGIN                                                          17814000
         SPLENTRYPARMS;  <<GET ENTRY PARM'S>>                           17816000
         IF NAME.(4:4) = SPLNC THEN                                     17818000
            BEGIN                                                       17820000
            TOS _ @NAME&LSL(1)+1; TOS _ @SPLP&LSL(1)+1;                 17822000
            IF * = *,(SPLNC) AND NOT TESTBIT(DELETEDSEGS,SLSEGNR) THEN  17824000
               BEGIN                                                    17826000
               SEARCHSPL _ TRUE;                                        17828000
               RETURN                                                   17830000
               END                                                      17832000
            END;                                                        17834000
         @SPLP _ @SPLP+SPLNW  <<NEXT ENTRY>>                            17836000
         END                                                            17838000
      END                                                               17840000
   END;                                                                 17842000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - GETNEXTLIBRECD"       <<00207>>17844000
$ CONTROL SEGMENT = SEG30                                               17846000
LOGICAL PROCEDURE GETNEXTLIBRECD;                                       17848000
   <<LOADS THE NEXT RECORD IN THE CURRENT HASH LIST AND SETS THE        17850000
     DIRECTORY RECORD PARAMETERS.  IF THERE ARE NO MORE RECORDS IN      17852000
     THE LIST, THE VALUE FALSE IS RETURNED>>                            17854000
   BEGIN                                                                17856000
   CLEANUPLIBBUF;  <<SAVE MODIFIED RECORD>>                             17858000
   IF SLRECDUSED <> 2 THEN                                     <<04124>>17860000
   SPLPREVRECD _ SPLRECD;  <<SAVE PREVIOUS REC. NR.>>                   17862000
   SPLRECD _ SLNEXTRECD;  <<NEXT RECORD>>                               17864000
   IF = THEN RETURN;  <<NO MORE RECORDS?>>                              17866000
   FREADDIR'(SPLFNUM,SPLDIR,SPLRECD);                                   17868000
   SLNEXTRECD _ SPLDIR;  <<SAVE NEXT REC. NR.>>                         17870000
   SLRECDUSED _ SPLDIR(1);  <<SAVE USED SPACE COUNT>>                   17872000
   GETNEXTLIBRECD _ TRUE                                                17874000
   END;                                                                 17876000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SPLENTRYPARMS"        <<00207>>17878000
$ CONTROL SEGMENT = SEG30                                               17880000
PROCEDURE SPLENTRYPARMS;                                                17882000
   <<CALCULATES THE PARAMETERS OF THE SL ENTRY POINTED TO BY SLP>>      17884000
   BEGIN                                                                17886000
   SPLNC _ SPLP.(4:4);  <<NR. CHAR'S IN ENTRY NAME>>                    17888000
   SPLNAMENW _ SPLNC&LSR(1)+1;  <<NR. WORDS FOR ENTRY NAME>>            17890000
   @SPLP1 _ @SPLP+SPLNAMENW;  <<SECONDARY POINTER>>                     17892000
   SPLNW _ SPLNAMENW+1+PARMLEN(SLPARMS)                                 17894000
   END;                                                                 17896000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SETLIBBUF"            <<00207>>17898000
$ CONTROL SEGMENT = SEG30                                               17900000
PROCEDURE SETUPLIBBUF;                                                  17902000
   <<INITIALIZES THE DIRECTORY AND ENTRY PARAMETERS FOR STEPPING        17904000
     THROUGH THE DIRECTORY>>                                            17906000
   BEGIN                                                                17908000
   CLEANUPLIBBUF;  <<SAVE MODIFIED RECORD>>                             17910000
   BUCKETINDEX _ SPLFHI-1;  <<INIT. HASH LIST INDEX>>                   17912000
   TOS _ 0D; SPLRECD _ TOS; SLNEXTRECD _ TOS;                           17914000
   SLRECDUSED _ 2;                                                      17916000
   SPLNW _ 2;                                                           17918000
   @SPLP _ @SPLDIR  <<INIT. ENTRY POINTER>>                             17920000
   END;                                                                 17922000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - GETNEXTLIBENTRY"      <<00207>>17924000
$ CONTROL SEGMENT = SEG30                                               17926000
LOGICAL PROCEDURE GETNEXTLIBENTRY;                                      17928000
   <<LOADS THE NEXT DIRECTORY ENTRY AND SETS THE ENTRY PARAMETERS.      17930000
     RETURNS THE VALUE FALSE WHEN THE DIRECTORY HAS BEEN EXHAUSTED>>    17932000
   BEGIN                                                                17934000
   @SPLP _ @SPLP+SPLNW;                                                 17936000
   IF @SPLP = @SPLDIR(SLRECDUSED) THEN  <<READ NEXT RECORD?>>           17938000
      BEGIN                                                             17940000
      IF NOT GETNEXTLIBRECD THEN  <<NEXT HASH LIST?>>                   17942000
         BEGIN                                                          17944000
         DO BUCKETINDEX _ BUCKETINDEX+1                                 17946000
            UNTIL SPLREC0(BUCKETINDEX) <> 0;                            17948000
         IF BUCKETINDEX > 127 THEN RETURN;  <<ALL DONE?>>               17950000
         SPLRECD _ 0;                                                   17952000
         SLNEXTRECD _ SPLREC0(XREG);                                    17954000
         GETNEXTLIBRECD                                                 17956000
         END;                                                           17958000
      @SPLP _ @SPLDIR(2)  <<RESET POINTER>>                             17960000
      END;                                                              17962000
   SPLENTRYPARMS;  <<GET ENTRY PARAMETERS>>                             17964000
   GETNEXTLIBENTRY _ TRUE                                               17966000
   END;                                                                 17968000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - DELETELIBENTRY"       <<00207>>17970000
$ CONTROL SEGMENT = SEG30                                               17972000
PROCEDURE DELETELIBENTRY;                                               17974000
   <<DELETES THE CURRENT ENTRY FROM THE DIRECTORY RECORD.  IF THE       17976000
     RECORD IS THEN EMPTY, IT IS REMOVED FROM THE DIRECTORY AND         17978000
     INSERTED IN THE FREE RECORD LIST>>                                 17980000
   BEGIN                                                                17982000
   MOVE SPLP _ SPLP(SPLNW),(SLRECDUSED-@SPLP+@SPLDIR-SPLNW);            17984000
   SLRECDUSED _ SLRECDUSED-SPLNW;  <<ADJ. USED SPACE COUNT>>            17986000
   SPLDIR(1) _ SLRECDUSED;                                              17988000
   IF SLRECDUSED = 2 THEN  <<EMPTY RECORD?>>                            17990000
      BEGIN                                                             17992000
      IF SPLREC0(BUCKETINDEX) = SPLRECD                                 17994000
         THEN SPLREC0(XREG) _ SPLDIR  <<NEW S.A. OF HASH LIST>>         17996000
         ELSE REPAIRRECORD'(SPLFNUM,SPLPREVRECD,0,SPLDIR);              17998000
      RETURNSLSPACE(SPLRECD,1)                                          18000000
      END;                                                              18002000
   SPLNW _ 0;  <<ZERO ENTRY LENGTH>>                                    18004000
   LIBENTRYMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      18006000
   END;                                                                 18008000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - CLEANUPLIBBUF"        <<00207>>18010000
$ CONTROL SEGMENT = SEG30                                               18012000
PROCEDURE CLEANUPLIBBUF;                                                18014000
   <<SAVES THE CURRENT DIRECTORY RECORD IF IT HAS BEEN MODIFIED>>       18016000
   BEGIN                                                                18018000
   IF LIBENTRYMODIFIED THEN                                             18020000
      BEGIN                                                             18022000
      FWRITEDIR'(SPLFNUM,SPLDIR,SPLRECD);  <<WRITE MODIFIED RECORD>>    18024000
      LIBENTRYMODIFIED _ FALSE                                          18026000
      END                                                               18028000
   END;                                                                 18030000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - FINDDIRSPACE"         <<00207>>18032000
$ CONTROL SEGMENT = SEG30                                               18034000
PROCEDURE FINDDIRSPACE (HASHCODE,LENGTH);                               18036000
   <<FINDS A DIRECTORY RECORD IN THE SPECIFIED HASH LIST THAT IS        18038000
     CAPABLE OF HOLDING A NEW ENTRY OF THE SPECIFIED LENGTH.  IF        18040000
     NO RECORD CAN BE FOUND, A NEW RECORD IS ALLOCATED AND LINKED INTO  18042000
     THE HASH LIST.  THE ENTRY POINTER IS SET TO THE FIRST WORD OF THE  18044000
     NEW ENTRY AND THE USED RECORD SPACE COUNT IS UPDATED.  NOTE THAT   18046000
     THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>      18048000
   VALUE HASHCODE,LENGTH;                                               18050000
   INTEGER HASHCODE,LENGTH;                                             18052000
   BEGIN                                                                18054000
   CLEANUPLIBBUF;  <<SAVE MODIFIED RECORD>>                             18056000
   BUCKETINDEX _ SPLFHI+HASHCODE;  <<INDEX OF HASH LIST>>               18058000
   SPLRECD _ 0;  <<INIT. RECORD NR.>>                                   18060000
   SLNEXTRECD _ SPLREC0(BUCKETINDEX);                                   18062000
   IF <> THEN  <<EMPTY HASH LIST?>>                                     18064000
      DO ASSEMBLE(NOP)  <<COMPILER KLUDGE>>                             18066000
         UNTIL NOT GETNEXTLIBRECD OR 128-SLRECDUSED >= LENGTH;          18068000
   IF SPLRECD = 0 THEN  <<GET NEW RECORD FOR HASH LIST?>>               18070000
      BEGIN                                                             18072000
      SPLRECD _ FINDSLSPACE(1);  <<GET A RECORD>>                       18074000
      IF < THEN GO NFG;  <<NO ROOM?>>                                   18076000
      TOS _ SPLREC0(BUCKETINDEX);  <<NEW HASH LINK>>                    18078000
      SPLREC0(XREG) _ SPLRECD;  <<NEW S.A. OF HASH LIST>>               18080000
      TOS _ 2;  <<USED RECORD COUNT>>                                   18082000
      ASSEMBLE(DDUP);                                                   18084000
      SPLDDIR _ TOS;  <<UPDATE BUFFER>>                                 18086000
      SLRECDUSED _ TOS;                                                 18088000
      SLNEXTRECD _ TOS;                                                 18090000
      SPLPREVRECD _ 0  <<SAVE. PREVIOUS REC. NR.>>                      18092000
      END;                                                              18094000
   @SPLP _ @SPLDIR(SLRECDUSED);  <<SET ENTRY POINTER>>                  18096000
   SLRECDUSED _ SLRECDUSED+LENGTH;  <<ADJ. USED SPACE COUNT>>           18098000
   SPLDIR(1) _ SLRECDUSED;                                              18100000
   LIBENTRYMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      18102000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    18104000
   GO GETOUT;                                                           18106000
                                                                        18108000
   NFG:                                                                 18110000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 18112000
                                                                        18114000
   GETOUT:                                                              18116000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             18118000
   END;                                                                 18120000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - INSERTSL"             <<00207>>18122000
$ CONTROL SEGMENT = SEG30                                               18124000
PROCEDURE INSERTSL;                                                     18126000
   <<INSERTS THE SEGMENT CORRESPONDING TO THE CURRENT SEGMENT ENTRY     18128000
     IN CORE INTO THE SL FILE>>                                         18130000
   BEGIN                                                                18132000
   INTEGER SAVEDLAREA1;                                                 18134000
   BYTE ARRAY SEGNAME (0:15);                                           18136000
   INTEGER NRENTPTS _ 0;  <<NR. ENTRY POINTS>>                          18138000
   INTEGER LISTLEN _ 0;  <<EXTERNAL LIST LENGTH>>                       18140000
   integer SaveSttNr;                                          <<04125>>18142000
   integer SegRec;                << Disk address of code seg ><<04102>>18144000
   double  SegPointer;            << PMAP scratch file segment <<04332>>18146000
                                  <<   record pointer.         <<04102>>18148000
   integer PmapNrSects;           << # sectors for PMAP info >><<04102>>18150000
   integer PmapRec;               << Disk address of PMAP area <<04102>>18152000
   integer SIRec;                 << Disk address of SI area >><<04102>>18154000
   integer Rec;                   << For MasterBuf >>          <<04102>>18156000
   integer Disp;                  << For MasterBuf >>          <<04102>>18158000
   integer array BufX(0:127);     << For MasterBuf >>          <<04102>>18160000
   integer Zero := 0;             << For call by reference >>  <<04102>>18162000
   integer Status;                << Status code returned >>   <<04102>>18164000
                                                                        18166000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  18168000
                                                                        18170000
   SAVEDLAREA1 _ @DLAREA1;  <<SAVE DL AREA 1 LIMIT>>                    18172000
   MAKEROOMINDL(SLDLBUFS2);                                             18174000
   IF < THEN GO GETOUT;  <<ERROR?>>                                     18176000
   @SYMBOL _ @DLAREA1-95;                                               18178000
   @PATCH _ @SYMBOL-128;                                                18180000
   @STT _ @PATCH-1;                                                     18182000
   @STABLE _ @STT-255;                                                  18184000
   @DLAREA1 _ @STABLE;                                                  18186000
   TOS _ @SYMBOL; PS0 _ 0;                                              18188000
   ASSEMBLE(DUP,INCB); TOS _ 94; ASSEMBLE(MOVE 3);                      18190000
   TOS _ @PATCH; PS0 _ -1;                                              18192000
   ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);                     18194000
   ASSEMBLE(DZRO,ZERO);                                                 18196000
   USEDSYMBOL := TOS; USEDPATCH := TOS; PROGRAMFILE := TOS;             18198000
                                                                        18200000
   <<* * * CHECK FOR DUPLICATE SEGMENT NAME * * *>>                     18202000
                                                                        18204000
   IF SPLNS = 255 THEN  <<TOO MANY SEGMENTS?>>                          18206000
      BEGIN                                                             18208000
      ERROR(39);                                                        18210000
      GO GETOUT                                                         18212000
      END;                                                              18214000
   TOS _ @SEGNAME; TOS _ @ENAME&LSL(1)+1;                               18216000
   MOVE * := *,(ENTNC),2;  <<SEGMENT NAME>>                             18218000
   MOVE * := BLINE,(16-ENTNC);  <<TRAILING BLANKS>>                     18220000
   IF SEARCHSEGNAME(SEGNAME) <> -1 THEN                                 18222000
      BEGIN                                                             18224000
      ERRORS(15,ENAME);                                                 18226000
      GO GETOUT                                                         18228000
      END;                                                              18230000
                                                                        18232000
   <<* * * GET SEGMENT NUMBER AND REFERENCE TABLE ENTRY * * *>>         18234000
                                                                        18236000
   SLREC0MOD _ TRUE;  <<SET MODIFIED FLAG>>                             18238000
   IF SPLFRTL = -1 THEN  <<USE NEW SEG. NR.>>                           18240000
      BEGIN                                                             18242000
      CSTNR := SPLNRT;  <<SEGMENT NR.>>                                 18244000
      IF SPLNRT.(14:2) = 0 THEN  <<NEW REF. TAB. RECORD NEEDED?>>       18246000
         BEGIN                                                          18248000
         TOS _ FINDSLSPACE(1);  <<FIND A RECORD>>                       18250000
         IF < THEN GO GETOUT;  <<NO ROOM?>>                             18252000
         SPLREC1(SPLNRT.(0:14)) := TOS  <<REC. NR.>>                    18254000
         END;                                                           18256000
         GETREFTABENTRY(CSTNR);  <<GET REF. TABLE ENTRY>>               18258000
      SPLNRT _ SPLNRT+1  <<BUMP NR. OF REF. TAB. ENTRIES>>              18260000
      END                                                               18262000
   ELSE  <<REUSE DELETED SEG. NR.>>                                     18264000
      BEGIN                                                             18266000
      CSTNR := SPLFRTL;  <<SEGMENT NR.>>                                18268000
      GETREFTABENTRY(CSTNR);  <<GET REF. TABLE ENTRY>>                  18270000
      SPLFRTL _ RTP  <<NEW S.A. OF FREE REF. TAB. ENTRIES>>             18272000
      END;                                                              18274000
   TOS _ @RTP; PS0 _ 0;  <<INIT. REF. TAB. ENTRY>>                      18276000
   ASSEMBLE(DUP,INCB); TOS := 31; ASSEMBLE(MOVE 3);                     18278000
   TOS _ @SLRSEGNAME&LSL(1);                                            18280000
   MOVE * := SEGNAME,(16);  <<INSERT SEGMENT NAME>>                     18282000
                                                                        18284000
   <<* * * PUT ENTRY POINTS IN DIRECTORY * * *>>                        18286000
                                                                        18288000
   SISeen := false;                                            <<04102>>18290000
   ToolboxId := SPLLastToolboxId;                              <<04102>>18292000
   PMAPNW:=DOUBLE(ENTNAMENW+SEGPMAPLEN+1);                     <<04102>>18294000
   SCANSEGMENT(ENTFILEADR);  <<FILL SYMBOL TABLE>>                      18296000
   IF < THEN GO ABORT1;  <<ERROR?>>                                     18298000
   if not SISeen then                                          <<04102>>18300000
      SymDBug := false;                                        <<04102>>18302000
   IF SYMDBUG THEN FPMAP:=1;                                   <<04102>>18304000
   @SYMP _ @STABLE;                                                     18306000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 18308000
      BEGIN                                                             18310000
      SYMENTPARMS;  <<SET SYM. TAB. ENTRY PARMS>>                       18312000
      IF NOT SHIDDEN THEN  <<SKIP ENTRY POINT?>>                        18314000
         BEGIN                                                          18316000
         IF SEARCHSPL(SNAME) THEN  <<DUPLICATE NAME?>>                  18318000
            BEGIN                                                       18320000
            ERRORS(12,SLNAME);                                          18322000
            GO ABORT                                                    18324000
            END;                                                        18326000
         TOS := SYMNW;  <<SYM. TAB. ENTRY LENGTH>>                      18328000
         IF SYMTYPE = 3 THEN TOS := TOS-5 ELSE TOS := TOS-3;            18330000
         FINDDIRSPACE(HASH(SNAME),S0);  <<GET DIR. RECORD>>             18332000
         IF < THEN GO ABORT;  <<NO ROOM?>>                              18334000
         TOS _ SYMNAMENW+1;  <<LENGTH OF NAME AND P-LABEL>>             18336000
         MOVE SLNAME _ SNAME,(S0),2;  <<NAME AND P-LABEL>>              18338000
         TOS := @SPARMS;  <<PARM. INFO POINTER>>                        18340000
         ASSEMBLE(DXCH,SUB);  <<PARM. INFO LENGTH>>                     18342000
         ASSEMBLE(MOVE 3);  <<PARM. INFO>>                              18344000
         SPLP.(3:1):=IF FLAGS.(0:3)<>0 THEN 1 ELSE 0;          <<PALOC>>18346000
         NRENTPTS := NRENTPTS+1                                         18348000
         END;                                                           18350000
      @SYMP _ @SYMP+SYMNW  <<NEXT SYM. TAB. ENTRY>>                     18352000
      END;                                                              18354000
   IF NRENTPTS = 0 THEN  <<NO ENTRY POINTS?>>                           18356000
      BEGIN                                                             18358000
      ERROR(42);                                                        18360000
      GO ABORT1                                                         18362000
      END;                                                              18364000
                                                               <<04102>>18366000
   <<* * * Open the PMAP scratch file. * * *>>                 <<04102>>18368000
                                                               <<04102>>18370000
   IF FPMAP THEN  BEGIN                                        <<04102>>18372000
   CreatePmapScratch(1, Status);                               <<04102>>18374000
   if Status <> STATUS'OK then                                 <<04102>>18376000
      go ABORT;                                                <<04102>>18378000
   END;                                                        <<04102>>18380000
                                                               <<04102>>18382000
   <<* * * Open the SI scratch file. * * *>>                   <<04102>>18384000
                                                               <<04102>>18386000
   if SymDBug then                                             <<04102>>18388000
      begin                                                    <<04102>>18390000
      CreateSIScratch(Status);                                 <<04102>>18392000
      if Status <> STATUS'OK then                              <<04102>>18394000
         go ABORT;                                             <<04102>>18396000
      end;                                                     <<04102>>18398000
                                                                        18400000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  18402000
                                                                        18404000
   @PTABLE _ @DLAREA2;                                                  18406000
   @DLAVAIL _ @DLAREA2;                                                 18408000
                                                                        18410000
   <<* * * PREPARE SEGMENT INTO SCRATCH FILE * * *>>                    18412000
                                                                        18414000
   SaveSttNr := SttNr;                                         <<04125>>18416000
   SttNr     := SttNr + SttPpNr;                               <<04125>>18418000
   SttPpNr   := SaveSttNr;                                     <<04125>>18420000
   PREPARESEGMENT(ENTFILEADR,SCRATCHFNUM,0);                            18422000
   IF < THEN GO ABORT;  <<ERROR?>>                                      18424000
                                                               <<04102>>18426000
   <<* * * Repair PMAP segment record. * * *>>                 <<04102>>18428000
                                                               <<04102>>18430000
   IF FPMAP THEN  BEGIN                                        <<04102>>18432000
   CoreBufPmap(Zero, 1);                                       <<04102>>18434000
   if PmapRecNr <> 1 then                                      <<04102>>18436000
      begin                                                    <<04102>>18438000
      FWriteDir'(PmapFileNr, PmapBuf, PmapRecNr);              <<04102>>18440000
      PmapRecNr := 1;                                          <<04102>>18442000
      FReadDir'(PmapFileNr, PmapBuf, PmapRecNr);               <<04102>>18444000
      end;                                                     <<04102>>18446000
   PMAPBUFDISP:=TYPETABLE+3+PMAPBUF(TYPETABLE+2).(4:4)&LSR(1); <<04102>>18448000
   PmapBuf(PmapBufDisp) := CstNr cat SttNr (0:8:8);            <<04102>>18450000
   PmapBuf(PmapBufDisp + 1) := SegLen;                         <<04102>>18452000
   END;                                                        <<04102>>18454000
   EJECTPAGE;                                                           18456000
                                                                        18458000
   <<* * * ATTACH STT MAP ARRAY * * *>>                                 18460000
                                                                        18462000
   TOS := @BUF; PS0 := -1;                                              18464000
   ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3);                    18466000
   COREBUF1(BUF,128);                                                   18468000
                                                                        18470000
   <<* * * COMPOSE AND ATTACH SYMBOLIC EXTERNAL LIST * * *>>            18472000
                                                                        18474000
   @SYMP _ @STABLE;                                                     18476000
   WHILE @SYMP < @STABLE(USEDSYMBOL) DO                                 18478000
      BEGIN                                                             18480000
      SYMENTPARMS;                                                      18482000
      IF SYMTYPE = 7 THEN  <<EXTERNAL ENTRY?>>                          18484000
         BEGIN                                                          18486000
         SNAME.(0:4) _ 0;  <<CLEAR FLAG BITS>>                          18488000
         COREBUF1(SNAME,SYMNAMENW);  <<EXTERNAL NAME>>                  18490000
         COREBUF1(SXLPLABEL,SYMNW-SYMNAMENW-3);  <<P-LABEL AND PARM'S>> 18492000
         LISTLEN _ LISTLEN+SYMNW-3  <<ADJ. LIST LENGTH>>                18494000
         END;                                                           18496000
      @SYMP _ @SYMP+SYMNW                                               18498000
      END;                                                              18500000
   TBUF1(TDISP1) _ 0;  <<LIST TERMINATOR>>                              18502000
   FWRITEDIR'(SCRATCHFNUM,TBUF1,TRECD1);                                18504000
                                                                        18506000
   <<* * * TRANSFER SEGMENT TO SL FILE * * *>>                          18508000
                                                                        18510000
   LISTLEN _ (SEGLEN+LISTLEN+P256)&LSR(7);  <<NR. RECORDS>>             18512000
   SegRec := FindSLSpace(ListLen);  << Find space for segment ><<04102>>18514000
   IF < THEN GO ABORT;  <<NO ROOM?>>                                    18516000
   XREG _ LISTLEN-1;                                                    18518000
   DO BEGIN                                                             18520000
      FREADDIR'(SCRATCHFNUM,BUF,XREG);                                  18522000
      FWriteDir'(SPLFNum, Buf, SegRec + XReg);                 <<04102>>18524000
      XREG _ XREG-1                                                     18526000
      END UNTIL <;                                                      18528000
                                                               <<04102>>18530000
   <<* * * Pass scratch files to TOOLBOX son process. * * *>>  <<04102>>18532000
                                                               <<04102>>18534000
   IF FPMAP THEN                                               <<04332>>18536000
   BEGIN                                                       <<04332>>18538000
   << SCRATCH PMAP FILE IS IN THE FORM OF PROGRAM PMAP >>      <<04332>>18540000
   << SO IT IS NECESSARY TO UPDATE SEG POINTER FIELD.  >>      <<04332>>18542000
   << THIS POINTER WILL BE USED WHEN SEGSYM PROGRAM    >>      <<04332>>18544000
   << MASSAGE THE SCRATCH FILE USING PMAP INTRINSIC.   >>      <<04332>>18546000
   << IN THIS CASE THERE IS ONLY ONE SEG POINTER.      >>      <<04332>>18548000
   SEGPOINTER := DOUBLE(128 + TYPETABLELEN + 2);               <<04332>>18550000
   ActivateToolbox(SegPointer, 1, Status);                     <<04102>>18552000
   if Status <> STATUS'OK then                                 <<04102>>18554000
      go ABORT;                                                <<04102>>18556000
                                                               <<04102>>18558000
   <<* * * Copy PMAP scratch file to SL file. * * *>>          <<04102>>18560000
                                                               <<04102>>18562000
   PMAPNRSECTS:=INTEGER((PMAPNW+DOUBLE(TYPETABLELEN)+127D)     <<04102>>18564000
                         &DLSR(7));                            <<04102>>18566000
   PmapRec := FindSLSpace(PmapNrSects); << Find space for PMAP><<04102>>18568000
   if < then                                                   <<04102>>18570000
      go ABORT;                                                <<04102>>18572000
   Rec := PmapRec;                                             <<04102>>18574000
   Disp := 0;                                                  <<04102>>18576000
   MasterBufd(SPLFNum, PmapFileNr, BufX, Rec, Disp,            <<04102>>18578000
             TRUE,128D,BUF,DOUBLE(TYPETABLELEN));              <<04102>>18580000
   MASTERBUFD(SPLFNUM,PMAPFILENR,BUFX,REC,DISP,TRUE,           <<04102>>18582000
              DOUBLE(128+2+TYPETABLELEN),BUF,PMAPNW);          <<04102>>18584000
   if Disp <> 0 then                                           <<04102>>18586000
      FWriteDir'(SPLFNum, BufX, Rec);                          <<04102>>18588000
   FClose(PmapFileNr, 4, 0);                                   <<04102>>18590000
      if <> then                                               <<04102>>18592000
         begin                                                 <<04102>>18594000
         Error(MSG'CANTCLOSESCRATCH);                          <<04102>>18596000
         go ABORT;                                             <<04102>>18598000
         end;                                                  <<04102>>18600000
   END   ELSE                                                  <<04102>>18602000
      PMAPREC:=0;                                              <<04102>>18604000
                                                               <<04102>>18606000
   <<* * * Copy SI scratch file to SL file. * * *>>            <<04102>>18608000
                                                               <<04102>>18610000
   if SymDBug then                                             <<04102>>18612000
      begin                                                    <<04102>>18614000
      SIRec := FindSLSpace(FEOF(SIFileNr));                    <<04102>>18616000
      if < then                                                <<04102>>18618000
         go ABORT;                                             <<04102>>18620000
      Rec := SIRec;                                            <<04102>>18622000
      Disp := 0;                                               <<04102>>18624000
      MasterBufd(SPLFNum, SIFileNr, BufX, Rec, Disp,           <<04102>>18626000
                true, 0D, Buf, double(FEOF(SIFileNr))*128d);   <<04102>>18628000
      if Disp <> 0 then                                        <<04102>>18630000
         FWriteDir'(SPLFNum, BufX, Rec);                       <<04102>>18632000
      FClose(SIFileNr, 4, 0);                                  <<04102>>18634000
         if <> then                                            <<04102>>18636000
            begin                                              <<04102>>18638000
            Error(MSG'CANTCLOSESCRATCH);                       <<04102>>18640000
            go ABORT;                                          <<04102>>18642000
            end;                                               <<04102>>18644000
      end                                                      <<04102>>18646000
   else                                                        <<04102>>18648000
      SIRec := 0;                                              <<04102>>18650000
                                                                        18652000
   <<* * * INITIALIZE REFERENCE TABLE ENTRY * * *>>                     18654000
                                                                        18656000
   TOS _ SEGLEN;  <<SEGMENT LENGTH>>                                    18658000
   TOS.(0:1) _ SEGPRIVILEGED;  <<LOAD IN PRIV. MODE?>>                  18660000
   RTP _ TOS;                                                           18662000
   SLRSA := SegRec;                                            <<04102>>18664000
   SLRNR _ LISTLEN;  <<NR. REC'S FOR SEGMENT>>                          18666000
   TOS _ NRENTPTS;  <<NR. ENTRY POINTS>>                                18668000
   TOS.(4:3) _ FLAGS.(0:3);  <<SEGMENT FLAGS>>                          18670000
   SLRFLAGS _ TOS;  <<INSERT SEGMENT FLAGS>>                            18672000
   SLRPmapRec := PmapRec;                                      <<04102>>18674000
   SLRSIRec   := SIRec;                                        <<04102>>18676000
   IF CHECKSUMSPECIFIED THEN                                   <<04257>>18678000
      SLRCKSUM:=1;                                             <<04257>>18680000
   IF INITPATCH >= 0 THEN                                      <<04257>>18682000
      SLRPATCH:=1;                                             <<04257>>18684000
   SETBIT(SLRREFEDSEGS,CSTNR);  <<SET OWN SEGMENT BIT>>                 18686000
   RTMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                            18688000
                                                                        18690000
   SEGSADDED _ TRUE;  <<SET SEG. ADDED FLAG>>                           18692000
   SETBIT(ADDEDSEGS,CSTNR);  <<SET ADDED SEG. BIT>>                     18694000
   SPLNS _ SPLNS+1;  <<BUMP NR. SEGMENTS>>                              18696000
   GO GETOUT;                                                           18698000
                                                                        18700000
   ABORT:                                                               18702000
   SETUPLIBBUF;                                                         18704000
   WHILE GETNEXTLIBENTRY DO                                             18706000
      IF SLSEGNR = CSTNR THEN DELETELIBENTRY;                           18708000
                                                                        18710000
   ABORT1:                                                              18712000
   RTP _ SPLFRTL;  <<FREE REF. TAB. ENTRY LINK>>                        18714000
   SPLFRTL _ CSTNR;  <<NEW S.A. OF FREE REF. TAB. LIST>>                18716000
   RTP(3) _ -1;  <<SET DELETED SEGMENT BIT>>                            18718000
   RTMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                            18720000
                                                                        18722000
   GETOUT:                                                              18724000
   USEDPATCH _ 0;  <<MARK PATCH TABLE EMPTY>>                           18726000
   @DLAREA1 _ SAVEDLAREA1;  <<RESET DL AREA 1 LIMIT>>                   18728000
   @DLAVAIL _ @DLAREA2  <<RESET DL AVAILABLE AREA LIMIT>>               18730000
   END;                                                                 18732000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - FIXUPSL"              <<00207>>18734000
$ CONTROL SEGMENT = SEG30                                               18736000
PROCEDURE FIXUPSL (REFIX);                                              18738000
   <<RESTORES SEGMENT LINKAGE AFTER SEGMENTS HAVE BEEN ADDED,           18740000
     DELETED OR MODIFIED:                                               18742000
     1. STEPS THRU THE DIRECTORY AND REMOVES ANY ENTRIES THAT ARE       18744000
        FROM DELETED SEGMENTS                                           18746000
     2. FREES THE SPACE TAKEN UP BY A SEGMENT THAT HAS BEEN DELETED     18748000
     3. FREES THE REFERENCE TABLE ENTRY OF THOSE SEGMENTS THAT HAVE     18750000
        DELETED                                                         18752000
     4. RESTORES SEGMENT LINKAGE BY BINDING AND RE-BINDING              18754000
     5. TAKES THE TRANSITIVE CLOSURE OF THE REFERENCED SEGMENT          18756000
        MATRIX                                                          18758000
     THE REFIX FLAG INDICATES THAT THE TRANSITIVE CLOSURE OPERATION     18760000
     IS NOT TO BE PERFORMED>>                                           18762000
   VALUE REFIX;                                                         18764000
   LOGICAL REFIX;                                                       18766000
   BEGIN                                                                18768000
   INTEGER I;                                                           18770000
                                                                        18772000
   SUBROUTINE CLEAR (FLAG,BITMAP);                                      18774000
      LOGICAL FLAG;                                                     18776000
      ARRAY BITMAP;                                                     18778000
      BEGIN                                                             18780000
      FLAG _ FALSE;                                                     18782000
      TOS _ @BITMAP; PS0 _ 0;                                           18784000
      ASSEMBLE(DUP,INCB); TOS _ 15; ASSEMBLE(MOVE 3)                    18786000
      END;                                                              18788000
   IF SEGSADDED OR SEGSDELETED OR SEGSMODIFIED THEN                     18790000
      BEGIN                                                             18792000
      IF SEGSDELETED THEN                                               18794000
         BEGIN                                                          18796000
                                                                        18798000
         <<* * * REMOVE DIRECTORY ENTRIES * * *>>                       18800000
                                                                        18802000
         SETUPLIBBUF;                                                   18804000
         WHILE GETNEXTLIBENTRY DO                                       18806000
            IF TESTBIT(DELETEDSEGS,SLSEGNR) THEN DELETELIBENTRY;        18808000
                                                                        18810000
         <<* * * REMOVE SEGMENTS * * *>>                                18812000
                                                                        18814000
         FOR I _ 0 UNTIL SPLNRT-1 DO                                    18816000
            IF TESTBIT(DELETEDSEGS,I) THEN                              18818000
               BEGIN                                                    18820000
               GETREFTABENTRY(I);                                       18822000
               RETURNSLSPACE(SLRSA,SLRNR);  <<DELETE SEGMENT>>          18824000
               RTP _ SPLFRTL;  <<FREE REF. TAB. ENTRY LINK>>            18826000
               SPLFRTL _ I;  <<NEW S.A. OF FREE LIST>>                  18828000
               SLRDELETEDBIT _ TRUE;  <<SET SEGMENT DELETED BIT>>       18830000
               RTMODIFIED _ TRUE  <<SET MODIFIED FLAG>>                 18832000
               END;                                                     18834000
         SLREC0MOD _ TRUE                                               18836000
         END;                                                           18838000
      BINDSEGS;                                                         18840000
      IF NOT REFIX THEN                                                 18842000
         BEGIN                                                          18844000
         TRANSCLOSURE;                                                  18846000
         CLEAR(SEGSADDED,ADDEDSEGS);                                    18848000
         CLEAR(SEGSDELETED,DELETEDSEGS);                                18850000
         CLEAR(SEGSMODIFIED,MODIFIEDSEGS)                               18852000
         END                                                            18854000
      END;                                                     <<00230>>18856000
   IF SLREC0MOD THEN <<RECORDS 0,1 MODIFIED?>>                 <<00230>>18858000
      BEGIN                                                    <<00230>>18860000
      FWRITEMR'(SPLFNUM,SPLREC0,P256,0);<<SAVE RECS 0,1>>      <<00230>>18862000
      SLREC0MOD := FALSE;   <<CLEAR FLAG>>                     <<00230>>18864000
      END;                                                     <<00230>>18866000
   CLEANUPLIBBUF; <<SAVE DIRECTORY BUFFER>>                    <<00230>>18868000
   CLEANUPRTBUF;  <<SAVE REF. TAB. BUFFER>>                    <<00230>>18870000
   SAVESLMAP;     <<SAVE MAP BUFFER>>                          <<00230>>18872000
   END;                                                                 18874000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - BINDSEGS"             <<00207>>18876000
$ CONTROL SEGMENT = SEG30                                               18878000
PROCEDURE BINDSEGS;                                                     18880000
   <<STEPS THRU THE SEGMENT EXTERNAL LISTS AND BINDS THE EXTERNALS.     18882000
     IF A BIND OPERATION IS INDICATED (SEGSADDED = TRUE) THEN           18884000
     TRIES TO SATISFY THOSE EXTERNALS THAT ARE UNSATISFIED.  IF         18886000
     A RE-BIND OPERATION IS INDICATED (SEGSDELETED = TRUE) THEN         18888000
     TRIES TO RE-SATISFY ALL EXTERNALS OF A SEGMENT THAT REFERENCED     18890000
     ONE OF THE DELETED SEGMENTS>>                                      18892000
   BEGIN                                                                18894000
   INTEGER I;  <<SEG. NR.>>                                             18896000
   LOGICAL ALLSATISFIED;  <<ALL EXTERNALS SATISFIED?>>                  18898000
   LOGICAL BADSEG := FALSE;  <<BINDING ERROR?>>                         18900000
   INTEGER L;           <<COUNTS EXTERNAL PER SEG>>                     18902000
   LOGICAL ARRAY BADSEGS(0:15);  <<SEGMENTS IN ERROR>>                  18904000
   ARRAY PARMS(0:4)=Q;                                         <<00595>>18906000
                                                                        18908000
   LOGICAL SUBROUTINE REFCHANGEDSEG;                                    18910000
      <<CHECKS TO SEE IF THE CURRENT SEGMENT REFERENCES (DIRECTLY       18912000
        OR INDIRECTLY) A SEGMENT THAT HAS BEEN MODIFIED OR DELETED>>    18914000
      BEGIN                                                             18916000
      TOS := @SLRREFEDSEGS;  <<SEGMENTS REFERENCED>>                    18918000
      TOS := 0;  <<FLAG>>                                               18920000
      XREG := 15;  <<SEG. MAP INDEX>>                                   18922000
      DO BEGIN                                                          18924000
         IF SEGSMODIFIED THEN                                           18926000
            TOS := TOS LOR (MODIFIEDSEGS(XREG) LAND LPS1(XREG));        18928000
         IF SEGSDELETED THEN                                            18930000
            TOS := TOS LOR (DELETEDSEGS(XREG) LAND LPS1(XREG));         18932000
         XREG := XREG-1                                                 18934000
         END UNTIL <;                                                   18936000
      IF TOS <> 0 THEN  <<SEGMENTS REFERENCED?>>                        18938000
         BEGIN                                                          18940000
         ASSEMBLE(DUP,ZERO); PS1 := TOS;                                18942000
         ASSEMBLE(DUP,INCB); TOS := 15; ASSEMBLE(MOVE 3);               18944000
         SETBIT(PS0,I);                                                 18946000
         S2 := TRUE  <<SET RESULT>>                                     18948000
         END;                                                           18950000
      DEL                                                               18952000
      END;                                                              18954000
                                                                        18956000
   TOS _ @BADSEGS; PS0 _ 0;                                             18958000
   ASSEMBLE(DUP,INCB); TOS _ 15; ASSEMBLE(MOVE 3);                      18960000
   CLEANUPLIBBUF;                                                       18962000
   FOR I _ 0 UNTIL SPLNRT-1 DO                                          18964000
      BEGIN                                                             18966000
      GETREFTABENTRY(I);                                                18968000
      IF NOT DELETEDSEG THEN  <<DELETED SEGMENT?>>                      18970000
         IF REFCHANGEDSEG OR SEGSADDED AND NOT SATISFIEDSEG THEN        18972000
            BEGIN                                                       18974000
            L := INTEGER (ALLSATISFIED := TRUE);                        18976000
            LOADSLSTT;  <<LOAD STT, ETC.>>                              18978000
            WHILE GETNEXTSLEXTN DO                                      18980000
               BEGIN                                                    18982000
               IF (L:=L+1)=0 THEN       <<FIRST EXTERNAL>>              18984000
                ALLSATISFIED := SLRSATISBIT;<<THE WAY IT WAS>>          18986000
               IF SEGSADDED AND NOT SLSATISEXTN OR                      18988000
                  (SEGSMODIFIED OR SEGSDELETED) AND SLSATISEXTN THEN    18990000
                  IF SEARCHSPL(SLXNAME) THEN  <<SATISFIABLE>>           18992000
                     BEGIN                                              18994000
                     IF NOT SLSATISEXTN OR SLSEGNR <> SLXSEGNR THEN     18996000
                        BEGIN                                           18998000
                        PARMCHECK(SLPARMS,SLXPARMS,PARMS);     <<00595>>19002000
                        IF PARMS <> 0 THEN <<ERROR?>>          <<00595>>19004000
                           BEGIN                               <<00595>>19006000
                           SETBIT(BADSEGS,IF TESTBIT(ADDEDSEGS,I)       19008000
                              THEN I ELSE SLSEGNR);            <<00595>>19010000
                           BADSEG := TRUE;                     <<00595>>19012000
                           CASE PARMS OF                       <<00595>>19014000
                              BEGIN                            <<00595>>19016000
                              ;                                <<00595>>19018000
                              ERRORS(49,SLXNAME);              <<00595>>19020000
                              ERRORS(50,SLXNAME);              <<00595>>19022000
                              BEGIN                            <<00595>>19024000
                                 ERRORS(45,SLXNAME);           <<00595>>19026000
                                 PRINTBITMAP(PARMS(1));        <<00595>>19028000
                              END;                             <<00595>>19030000
                              END;                             <<00595>>19032000
                           END;                                <<00595>>19034000
                        TOS _ SLPLABEL;  <<ENTRY POINT P-LABEL>>        19036000
                        IF < THEN  <<ILLEGAL P-LABEL?>>                 19038000
                           BEGIN                                        19040000
                           ERRORS(43,SLXNAME);                          19042000
                           SETBIT(BADSEGS,IF TESTBIT(ADDEDSEGS,I)       19044000
                              THEN I ELSE SLSEGNR);            <<ST.TC>>19046000
                           BADSEG _ TRUE; <<SET BAD SEG. FLAG>><<ST.TC>>19048000
                           END;                                         19050000
                        TOS.(0:1) := 1;  <<SET "EXTERNAL" BIT>>         19052000
                        STTP(-SLXSTTNR) := S0;  <<INSERT P-LABEL>>      19054000
                        XREG := -XREG;  <<STT NR.>>                     19056000
                        SLSTTMAP(XREG) := TOS;  <<SEG. NR.>>            19058000
                        SLXSATISBIT _ TRUE;  <<SET SATISFIED BIT>>      19060000
                        ALLSATISFIED := ALLSATISFIED LAND 1             19062000
                                                     LOR (L=0);         19064000
                        SLXSEGNR _ SLSEGNR;  <<SEG. NR.>>               19066000
                        SLSTTMODIFIED := TRUE  <<SET MODIFIED FLAG>>    19068000
                        END;                                            19070000
                     SETBIT(SLRREFEDSEGS,SLSEGNR)  <<SET SEG. BIT>>     19072000
                     END                                                19074000
                  ELSE  <<UNSATISFIABLE>>                               19076000
                     BEGIN                                              19078000
                     IF SLSATISEXTN THEN  <<CURRENTLY SATISFIED?>>      19080000
                        BEGIN                                           19082000
                        SLSTTMAP(SLXSTTNR) := -1;  <<CLEAR SEG. NR.>>   19084000
                        SLXSEGNR := I; <<MAKE INTERNAL>>       <<00198>>19086000
                        SLXSATISBIT _ FALSE;  <<CLEAR SATISFIED BIT>>   19088000
                        SLSTTMODIFIED := TRUE  <<SET MODIFIED FLAG>>    19090000
                        END;                                            19092000
                     ALLSATISFIED _ FALSE  <<ONE OR MORE UNSATIS.>>     19094000
                     END;                                               19096000
               END;                                                     19098000
            STORESLSTT;  <<SAVE STT, ETC.>>                             19100000
            SLRSATISBIT _ ALLSATISFIED;  <<ALL EXTN'S SATISFIED?>>      19102000
            RTMODIFIED _ TRUE  <<SET MODIFIED FLAG>>                    19104000
            END                                                         19106000
      END;                                                              19108000
   IF BADSEG THEN  <<BINDING ERROR?>>                                   19110000
      BEGIN                                                             19112000
      SEGSADDED _ FALSE;                                                19114000
      SEGSMODIFIED _ FALSE;                                             19116000
      SEGSDELETED _ TRUE;                                               19118000
      MOVE DELETEDSEGS _ BADSEGS,(16);                                  19120000
      FIXUPSL(TRUE);  <<DELETE AND RE-BIND>>                            19122000
      SPLNS _ SPLNS-SUMBITS(BADSEGS)  <<ADJ. NR. SEG'S>>                19124000
      END                                                               19126000
   END;                                                                 19128000
$PAGE "SL FILE MAINTENANCE PROCEDURE - COUNTSISPACE"                    19130000
PROCEDURE COUNTSISPACE(LEN);                                   <<04782>>19132000
                                                               <<04782>>19134000
INTEGER LEN;                                                   <<04782>>19136000
                                                               <<04782>>19138000
<< THIS PROCEDURE COUNT THE NUMBER OF RECORDS OCCUPIED >>      <<04782>>19140000
<< BY THE SI INFO OF A SL SEGMENT. REFERENCE TABLE     >>      <<04782>>19142000
<< POINTER NEED TO SET TO THE SEGMENT PRIOR TO CALL    >>      <<04782>>19144000
<< THIS PROCEDURE. LEN = 0 RETURNED IF THERE IS NO SI  >>      <<04782>>19146000
<< INFO INCLUDED FOR THIS SEGMENT.                     >>      <<04782>>19148000
                                                               <<04782>>19150000
BEGIN                                                          <<04782>>19152000
   INTEGER ARRAY SIINFO(0:127);                                <<04782>>19154000
   LOGICAL TERMINATED;                                         <<04782>>19156000
   LOGICAL NEXTRECORD;                                         <<04782>>19158000
   INTEGER OFFSET;     << WORD OFFSET >>                       <<04782>>19160000
   INTEGER ENTRYSIZE;                                          <<04782>>19162000
                                                               <<04782>>19164000
   LEN:=0;                                                     <<04782>>19166000
   IF SLRSIREC <> 0 THEN                                       <<04782>>19168000
      BEGIN                                                    <<04782>>19170000
         TERMINATED:=FALSE;                                    <<04782>>19172000
         OFFSET:=0;                                            <<04782>>19174000
         WHILE NOT TERMINATED DO                               <<04782>>19176000
            BEGIN                                              <<04782>>19178000
               FREADDIR'(OSPLFNUM,SIINFO,SLRSIREC+LEN);        <<04782>>19180000
               NEXTRECORD:=FALSE;                              <<04782>>19182000
               TERMINATED:=(SIINFO(OFFSET) = 0);               <<04782>>19184000
               WHILE NOT TERMINATED AND NOT NEXTRECORD DO      <<04782>>19186000
                  BEGIN                                        <<04782>>19188000
                     ENTRYSIZE:=SIINFO(OFFSET).(1:10);         <<04782>>19190000
                     OFFSET:=OFFSET+ENTRYSIZE;                 <<04782>>19192000
                     IF OFFSET > 127 THEN                      <<04782>>19194000
                        BEGIN                                  <<04782>>19196000
                           NEXTRECORD:=TRUE;                   <<04782>>19198000
                           OFFSET:=OFFSET-128;                 <<04782>>19200000
                        END                                    <<04782>>19202000
                     ELSE                                      <<04782>>19204000
                        TERMINATED:=(SIINFO(OFFSET) = 0);      <<04782>>19206000
                  END;                                         <<04782>>19208000
               LEN:=LEN+1;                                     <<04782>>19210000
            END;                                               <<04782>>19212000
      END;                                                     <<04782>>19214000
END;                                                           <<04782>>19216000
$PAGE "SL FILE MAINTENANCE PROCEDURE - COUNTPMAPSPACE"                  19218000
PROCEDURE COUNTPMAPSPACE(LEN);                                 <<04782>>19220000
                                                               <<04782>>19222000
INTEGER LEN;                                                   <<04782>>19224000
                                                               <<04782>>19226000
<< THIS PROCEDURE COUNT THE NUMBER OF RECORDS OCCUPIED >>      <<04782>>19228000
<< BY THE PAMP INFO OF A SL SEGMENT. REFERENCE TABLE   >>      <<04782>>19230000
<< POINTER NEED TO SET TO THE SEGMENT PRIOR TO CALL    >>      <<04782>>19232000
<< THIS PROCEDURE. LEN = 0 RETURNED IF THERE IS NO     >>      <<04782>>19234000
<< PMAP INFO INCLUDED FOR THIS SEGMENT.                >>      <<04782>>19236000
                                                               <<04782>>19238000
BEGIN                                                          <<04782>>19240000
                                                               <<04782>>19242000
EQUATE MAXPMAPTYPE=5;<<CHANGE THIS CONSTANT IF ADD NEW TYPE>>  <<04782>>19244000
INTEGER ARRAY PMAPINFO(0:127);                                 <<04782>>19246000
INTEGER ARRAY TYPETABLE'(0:MAXPMAPTYPE);                       <<04782>>19248000
LOGICAL TERMINATED;                                            <<04782>>19250000
LOGICAL NEXTRECORD;    <<ENTRY EXTEND TO NEXT RECORD>>         <<04782>>19252000
INTEGER OFFSET;   <<WORD OFFSET>>                              <<04782>>19254000
INTEGER ENTRYSIZE;                                             <<04782>>19256000
                                                               <<04782>>19258000
LEN:=0;                                                        <<04782>>19260000
IF SLRPMAPREC <> 0 THEN                                        <<04782>>19262000
   BEGIN                                                       <<04782>>19264000
      TERMINATED:=FALSE;                                       <<04782>>19266000
      FREADDIR'(OSPLFNUM,PMAPINFO,SLRPMAPREC);                 <<04782>>19268000
      MOVE TYPETABLE' := PMAPINFO,(PMAPINFO);                  <<04782>>19270000
      OFFSET:=TYPETABLE';                                      <<04782>>19272000
      WHILE NOT TERMINATED DO      << COUNT PMAP RECORD NUMBER <<04782>>19274000
         BEGIN                                                 <<04782>>19276000
            FREADDIR'(OSPLFNUM,PMAPINFO,SLRPMAPREC+LEN);       <<04782>>19278000
            NEXTRECORD:=FALSE;                                 <<04782>>19280000
            TERMINATED:=(PMAPINFO(OFFSET) = 0);                <<04782>>19282000
            WHILE NOT TERMINATED AND NOT NEXTRECORD DO         <<04782>>19284000
               BEGIN                                           <<04782>>19286000
                  ENTRYSIZE := PMAPINFO(OFFSET).(4:4)/2+1+     <<04782>>19288000
                        TYPETABLE'(PMAPINFO(OFFSET).(0:4)+1);  <<04782>>19290000
                  OFFSET:=OFFSET+ENTRYSIZE;                    <<04782>>19292000
                  IF OFFSET > 127 THEN                         <<04782>>19294000
                     BEGIN                                     <<04782>>19296000
                        NEXTRECORD:=TRUE;                      <<04782>>19298000
                        OFFSET:=OFFSET-128;                    <<04782>>19300000
                     END                                       <<04782>>19302000
                  ELSE TERMINATED:=(PMAPINFO(OFFSET) = 0);     <<04782>>19304000
               END;                                            <<04782>>19306000
            LEN:=LEN+1;                                        <<04782>>19308000
         END;                                                  <<04782>>19310000
   END;                                                        <<04782>>19312000
END;                                                           <<04782>>19314000
$PAGE "SL FILE MAINTENANCE PROCEDURE - TRANSCLOSURE"                    19316000
$ CONTROL SEGMENT = SEG30                                               19318000
PROCEDURE TRANSCLOSURE;                                                 19320000
   <<GETS THE TRANSITIVE CLOSURE OF THE REFERENCE TABLE AND             19322000
     INSERTS IT BACK IN THE FILE>>                                      19324000
   BEGIN                                                                19326000
   INTEGER N = Q+1;  <<SAME AS SPLNRT - AVOIDS INDEXING>>               19328000
   INTEGER RANGE = Q+2;  <<NR. WORDS BETWEEN FIRST AND LAST ROWS>>      19330000
   INTEGER POINTER M = Q+3;  <<INCIDENCE MATRIX>>                       19332000
   LOGICAL POINTER MJ = Q+4;  <<POINTS TO FIRST WORD OF ROW J>>         19334000
   LOGICAL POINTER COL = Q+5;  <<POINTS TO FIRST WORD OF COLUMN J>>     19336000
   LOGICAL MASK = Q+6;  <<COLUMN BIT FOR COLUMN J>>                     19338000
                                                                        19340000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  19342000
                                                                        19344000
   TOS := SPLNRT;  <<NR. ENTRIES>>                                      19346000
   IF = THEN RETURN;  <<NO ENTRIES?>>                                   19348000
   MAKEROOMINDL(N&LSL(4));                                              19350000
   IF < THEN QUIT(3);  <<NO ROOM?>>                                     19352000
                                                                        19354000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           19356000
                                                                        19358000
   TOS := (S0-1)&LSL(4);                                                19360000
   TOS := @DLAVAIL;                                                     19362000
   ASSEMBLE(DDUP,ADD);                                                  19364000
   TOS := @M+RANGE&LSR(8);                                              19366000
   TOS := 1&CSR(N);                                                     19368000
                                                                        19370000
   <<* * * FILL MATRIX FROM REFERENCE TABLE * * *>>                     19372000
                                                                        19374000
   TOS := N;                                                            19376000
   TOS := @M+RANGE;                                                     19378000
   DO BEGIN                                                             19380000
      GETREFTABENTRY(S1-1);                                             19382000
      MOVE PS0 := SLRREFEDSEGS,(16);                                    19384000
      TOS := TOS-16;                                                    19386000
      S1 := S1-1                                                        19388000
      END UNTIL =;                                                      19390000
                                                                        19392000
   <<* * * TAKE TRANSITIVE CLOSURE OF MATRIX * * *>>                    19394000
                                                                        19396000
   DO BEGIN  <<PROCESS A COLUMN>>                                       19398000
      XREG := RANGE;                                                    19400000
      DO BEGIN                                                          19402000
         TOS := COL(XREG) LAND MASK;                                    19404000
         DEL;                                                           19406000
         IF <> THEN  <<OR ROW J WITH ROW I?>>                           19408000
            BEGIN                                                       19410000
            TOS := XREG;  <<SAVE X REGISTER>>                           19412000
            TOS := @M(XREG);                                            19414000
            XREG := 15;                                                 19416000
            DO BEGIN                                                    19418000
               LPS0(XREG) := LPS0(XREG) LOR MJ(XREG);                   19420000
               XREG := XREG-1                                           19422000
               END UNTIL <;                                             19424000
            DEL;                                                        19426000
            XREG := TOS  <<RESTORE X REGISTER>>                         19428000
            END;                                                        19430000
         XREG := XREG-16                                                19432000
         END UNTIL <;                                                   19434000
      @MJ := @MJ-16;  <<NEXT ROW>>                                      19436000
      MASK := MASK&CSL(1);  <<NEXT COLUMN BIT>>                         19438000
      IF MASK THEN @COL := @COL-1  <<NEXT WORD COLUMN>>                 19440000
      END UNTIL @COL < @M;                                              19442000
                                                                        19444000
   <<* * * EMPTY MATRIX INTO REFERENCE TABLE * * *>>                    19446000
                                                                        19448000
   TOS := N;                                                            19450000
   TOS := @M+RANGE;                                                     19452000
   DO BEGIN                                                             19454000
      GETREFTABENTRY(S1-1);                                             19456000
      MOVE SLRREFEDSEGS := PS0,(16);                                    19458000
      RTMODIFIED := TRUE;  <<SET MODIFIED FLAG>>                        19460000
      TOS := TOS-16;                                                    19462000
      S1 := S1-1                                                        19464000
      END UNTIL =                                                       19466000
   END;                                                                 19468000
$PAGE "SL FILE MAINTENANCE PROCEDURE - RETURNSLPMAPSPACE"               19470000
$CONTROL SEGMENT = SEG30                                                19472000
PROCEDURE RETURNSLPMAPSPACE;                                   <<04102>>19474000
                                                               <<04102>>19476000
<< THIS PROCEDURE RETURNS THE PMAP SPACES WHEN     >>          <<04102>>19478000
<< PURGESL SEGMENT,SEGNAME ENTERED.                >>          <<04102>>19480000
                                                               <<04102>>19484000
BEGIN                                                          <<04102>>19486000
                                                                        19488000
INTEGER NRRECS;                                                <<04782>>19492000
                                                               <<04782>>19494000
COUNTPMAPSPACE(NRRECS);                                        <<04782>>19496000
IF NRRECS <> 0 THEN                                            <<04782>>19498000
   BEGIN                                                       <<04782>>19500000
      RETURNSLSPACE(SLRPMAPREC,NRRECS);                        <<04782>>19502000
      SLRPMAPREC:=0;                                           <<04782>>19504000
   END;                                                        <<04782>>19506000
END;                                                           <<04102>>19508000
$PAGE "SL FILE MAINTENNANCE PROCEDURE - RETURNSLSISPACE"                19510000
$CONTROL SEGMENT = SEG30                                                19512000
PROCEDURE RETURNSLSISPACE;                                     <<04525>>19514000
                                                                        19516000
<< THIS PROCEDURE RETURNS THE SI SPACE WHEN  >>                         19518000
<< PURGESL SEGMENT,SEGNAME ENTERED.          >>                         19520000
                                                                        19524000
BEGIN                                                                   19526000
INTEGER NRRECS;                                                <<04782>>19530000
                                                               <<04782>>19532000
   COUNTSISPACE(NRRECS);                                       <<04782>>19534000
   IF NRRECS <> 0 THEN                                         <<04782>>19536000
      BEGIN                                                    <<04782>>19538000
         RETURNSLSPACE(SLRSIREC,NRRECS);                       <<04782>>19540000
         SLRSIREC := 0;                                        <<04782>>19542000
      END;                                                     <<04782>>19544000
   END;                                                                 19546000
$PAGE "SL FILE MAINTENANCE PROCEDURE - REMOVESL"                        19548000
$ CONTROL SEGMENT = SEG30                                               19550000
PROCEDURE REMOVESL;                                                     19552000
   <<REMOVES THE SPECIFIED ENTRY POINT(S) FROM THE DIRECTORY AND,       19554000
     IF NECESSARY, REMOVES THE SEGMENT FROM THE SL FILE>>               19556000
   BEGIN                                                                19558000
   DEFINE EXITPROC = ASSEMBLE(EXIT 0)#;                                 19560000
   INTEGER SEGNR;                                                       19562000
   BYTE ARRAY SEGNAME (0:15);                                           19564000
   INTEGER SPLFNUMSAVE;                                        <<04782>>19566000
                                                                        19568000
   SUBROUTINE VALIDDELETE;                                              19570000
      <<CHECKS TO SEE IF THE SPECIFIED FILE IS A REAL SL FILE AND IF    19572000
        THE SEGMENT IS CURRENTLY LOADED>>                               19574000
      BEGIN                                                             19576000
      IF REALSL THEN  <<REAL SL FILE?>>                                 19578000
         BEGIN                                                          19580000
         GETPRIVMODE;  <<GET INTO PRIV. MODE>>                          19582000
         IF LOADEDSLSEG(SLKEY,SEGNR) THEN  <<SEGMENT LOADED?>>          19584000
            BEGIN                                                       19586000
            ERROR(110);                                                 19588000
            EXITPROC                                                    19590000
            END;                                                        19592000
         GETUSERMODE  <<RETURN TO USER MODE>>                           19594000
         END                                                            19596000
      END;                                                              19598000
                                                                        19600000
   IF CLASS = ENTRYCLASS THEN  <<SINGLE ENTRY POINT>>                   19602000
      BEGIN                                                             19604000
      IF NOT SEARCHSPL(NAME) THEN                                       19606000
         BEGIN                                                          19608000
         L1: ERROR(93);                                                 19610000
         RETURN                                                         19612000
         END;                                                           19614000
      SEGNR _ SLSEGNR;  <<SAVE SEG. NR.>>                               19616000
      VALIDDELETE;  <<SEGMENT LOADED?>>                                 19618000
      DELETELIBENTRY;  <<DELETE ENTRY POINT>>                           19620000
      GETREFTABENTRY(SEGNR);                                            19622000
      RTMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                         19624000
      TOS _ SLRNRENTPTS-1;  <<DEC. NR. ENTRY POINTS>>                   19626000
      IF = THEN GO DELETESEG;  <<LAST ENTRY POINT?>>                    19628000
      SLRNRENTPTS _ TOS;                                                19630000
      SEGSMODIFIED _ TRUE;  <<SET MODIFIED SEGMENT FLAG>>               19632000
      SETBIT(MODIFIEDSEGS,SEGNR)  <<SET SEGMENT BIT>>                   19634000
      END                                                               19636000
   ELSE  <<ENTIRE SEGMENT>>                                             19638000
      BEGIN                                                             19640000
      TOS _ @SEGNAME; BPS0 _ " ";                                       19642000
      ASSEMBLE(DUP,INCB); MOVE * _ *,(15);                              19644000
      MOVE SEGNAME _ BNAME(1),(INTEGER(BNAME));                         19646000
      SEGNR _ SEARCHSEGNAME(SEGNAME);                                   19648000
      IF SEGNR = -1 THEN GO L1;                                         19650000
      IF LDSEG THEN <<CURRENTLY LOADED SEGMENT>>               <<00.EB>>19652000
      << REQUEST FROM SYSPASS PROGRAM, FREEZE SYS SEG,>>       <<00.EB>>19654000
      << THEN DELETE IT IN SL>>                                <<00.EB>>19656000
      BEGIN                                                    <<00.EB>>19658000
         GETPRIVMODE;                                          <<00.EB>>19660000
         TOS := PHYSICALCST(0,INTEGER(LOGICAL(SEGNR) LOR       <<00.EB>>19662000
            %20000 )<<SYS SL>>);                               <<00.EB>>19664000
         IF <> THEN QUIT(101);                                 <<00.EB>>19666000
         LOCKSEG(*,0,ABSOLUTE(CPCB)-ABSOLUTE(PCBB));           <<00.EB>>19668000
         IF < THEN                                             <<00.EB>>19670000
         BEGIN                                                 <<00.EB>>19672000
            ERROR(114); <<UNABLE'TO FREEZE SEGMENT>>           <<00.EB>>19674000
            GETUSERMODE;                                       <<00.EB>>19676000
            RETURN;                                            <<00.EB>>19678000
         END;                                                  <<00.EB>>19680000
         GETUSERMODE;                                          <<00.EB>>19682000
      END                                                      <<00.EB>>19684000
      ELSE VALIDDELETE; <<SEGMENT LOADED?>>                    <<00.EB>>19686000
      DELETESEG:                                                        19688000
      SEGSDELETED _ TRUE;  <<SET DELETED SEGMENT FLAG>>                 19690000
      SETBIT(DELETEDSEGS,SEGNR);  <<SET SEGMENT BIT>>                   19692000
      SPLFNUMSAVE := OSPLFNUM;                                 <<04782>>19694000
      OSPLFNUM := SPLFNUM;                                     <<04782>>19696000
      RETURNSLPMAPSPACE;                                       <<04102>>19698000
      RETURNSLSISPACE;                                                  19700000
      OSPLFNUM := SPLFNUMSAVE;                                 <<04782>>19702000
      SPLNS _ SPLNS-1  <<DEC. NR. SEGMENTS>>                            19704000
      END;                                                              19706000
   SLREC0MOD _ TRUE  <<SET MODIFIED FLAG>>                              19708000
   END;                                                                 19710000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - LOADSLSTT"            <<00207>>19712000
$ CONTROL SEGMENT = SEG30                                               19714000
PROCEDURE LOADSLSTT;                                                    19716000
   <<LOADS THE STT, STT MAP ARRAY AND EXTERNAL LIST FOR THE SEGMENT     19718000
     DEFINED BY THE CURRENT REFERENCE TABLE ENTRY>>                     19720000
   BEGIN                                                                19722000
   SLSTTNW := (SLRNR-RTP.(2:7))&LSL(7)+P256;  <<NR. WORDS STT, ETC.>>   19724000
   SLSTTRECD := SLRSA+RTP.(2:7)-2;  <<REC. NR. STT, ETC.>>              19726000
   MAKEROOMINDL(SLSTTNW);                                               19728000
   IF < THEN QUIT(3);  <<NO ROOM?>>                                     19730000
   FREADMR'(SPLFNUM,DLAVAIL,SLSTTNW,SLSTTRECD);                         19732000
   @STTP := RTP.(9:7)+255+@DLAVAIL;  <<PL ENTRY>>                       19734000
   SLSTTMODIFIED := FALSE;  <<CLEAR MODIFIED FLAG>>                     19736000
   @SLSTTMAP := (@STTP+1)&LSL(1);  <<STT MAP>>                          19738000
   @SLXP := @STTP+129;  <<FIRST EXTERNAL ENTRY>>                        19740000
   SLXNW := 0  <<PHONEY NR. WORDS>>                                     19742000
   END;                                                                 19744000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - STORESLSTT"           <<00207>>19746000
PROCEDURE STORESLSTT;                                                   19748000
   <<STORES THE STT, STT MAP ARRAY AND EXTERNAL LIST FOR THE SEGMENT    19750000
     DEFINED BY THE CURRENT REFERENCE TABLE ENTRY>>                     19752000
   BEGIN                                                                19754000
   IF SLSTTMODIFIED THEN  <<STT, ETC. MODIFIED?>>                       19756000
      FWRITEMR'(SPLFNUM,DLAVAIL,SLSTTNW,SLSTTRECD)                      19758000
   END;                                                                 19760000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - GETNEXTSLEXTN"        <<00207>>19762000
$ CONTROL SEGMENT = SEG30                                               19764000
LOGICAL PROCEDURE GETNEXTSLEXTN;                                        19766000
   <<GETS THE NEXT EXTERNAL ENTRY AND SETS THE EXTERNAL ENTRY           19768000
     PARAMETERS.  RETURNS THE VALUE FALSE WHEN THE EXTERNAL LIST HAS    19770000
     BEEN EXHAUSTED, OTHERWISE RETURNS THE VALUE TRUE>>                 19772000
   BEGIN                                                                19774000
   INTEGER RESULT = GETNEXTSLEXTN;                                      19776000
   @SLXP := @SLXP+SLXNW;  <<NEXT ENTRY>>                                19778000
   SLXNC := SLXP.(4:4);  <<NR. CHAR'S IN NAME>>                         19780000
   IF <> THEN  <<NOT END OF LIST?>>                                     19782000
      BEGIN                                                             19784000
      @SLXP1 := @SLXP+SLXP.(4:3)+1;  <<SECONDARY ENTRY POINTER>>        19786000
      SLXNW := @SLXP1-@SLXP+1+PARMLEN(SLXPARMS);  <<NR. WORDS>>         19788000
      RESULT := RESULT+1  <<SET RESULT TO TRUE>>                        19790000
      END                                                               19792000
   END;                                                                 19794000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - GETREFTABENTRY"       <<00207>>19796000
$ CONTROL SEGMENT = SEG30                                               19798000
PROCEDURE GETREFTABENTRY (ENTRYNR);                                     19800000
   <<SETS THE REFERENCE TABLE ENTRY POINTER (RTP) TO THE SPECIFIED      19802000
     REFERENCE TABLE ENTRY.  IF A NEW RECORD HAS TO BE READ INTO        19804000
     THE BUFFER, THE REFERENCE TABLE MODIFIED FLAG IS CHECKED TO        19806000
     SEE IF THE OLD RECORD NEEDS TO BE PRESERVED>>                      19808000
   VALUE ENTRYNR;                                                       19810000
   INTEGER ENTRYNR;                                                     19812000
   BEGIN                                                                19814000
   TOS := ENTRYNR; TOS := 4;                                            19816000
   ASSEMBLE(DIV,STBX);                                                  19818000
   @RTP := (TOS&LSL(5))+@RTBUF;  <<INIT. ENTRY POINTER>>                19820000
   TOS := SPLREC1(XREG);  <<REC. NR.>>                                  19822000
   IF S0 <> RTRECD THEN  <<DIFFERENT RECORD?>>                          19824000
      BEGIN                                                             19826000
      CLEANUPRTBUF;  <<SAVE MODIFIED BUFFER>>                           19828000
      IF S0 < FEOF(SPLFNUM) THEN FREADDIR'(SPLFNUM,RTBUF,S0);           19830000
      RTRECD := TOS  <<SAVE REC. NR.>>                                  19832000
      END                                                               19834000
   END;                                                                 19836000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - CLEANUPRTBUF"         <<00207>>19838000
$ CONTROL SEGMENT = SEG30                                               19840000
PROCEDURE CLEANUPRTBUF;                                                 19842000
   <<CHECKS THE REFERENCE TABLE MODIFIED FLAG AND IF IT IS SET,         19844000
     WRITES THE REFERENCE TABLE RECORD CONTAINING THE MODIFIED          19846000
     ENTRY>>                                                            19848000
   BEGIN                                                                19850000
   IF RTMODIFIED THEN  <<RECORD MODIFIED?>>                             19852000
      BEGIN                                                             19854000
      FWRITEDIR'(SPLFNUM,RTBUF,RTRECD);                                 19856000
      RTMODIFIED _ FALSE  <<CLEAR MODIFIED FLAG>>                       19858000
      END                                                               19860000
   END;                                                                 19862000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - SLCLEAN"              <<00465>>19864000
$CONTROL SEGMENT=SEG30                                         <<04782>>19868000
PROCEDURE SLCLEAN(FACTOR);                                     <<04782>>19870000
   VALUE FACTOR; DOUBLE FACTOR;                                <<04782>>19872000
                                                               <<04782>>19874000
   COMMENT: THIS PROCEDURE, WITH FACTOR=0, IMPLEMENTS THE      <<04782>>19876000
            CLEANSL COMMAND.  FACTOR=0 IMPLIES THAT THE NEW    <<04782>>19878000
            SL FILESIZE EQUALS THE OLD SL FILESIZE (THOUGH EOF <<04782>>19880000
            MAY BE LESS).  IF FACTOR>0, THEN THE NEW FILESIZE  <<04782>>19882000
            IS FACTOR % GREATER THAN OLD EOF.  THIS FEATURE IS <<04782>>19884000
            USED BY COPYSL.  SLCLEAN EXPECTS TO FIND THE NEW SL<<04782>>19886000
            FILE NAME IN BFNAME1.  IT RETURNS CCE IF CLEANING  <<04782>>19888000
            WAS SUCCESSFUL, CCL OTHERWISE;                     <<04782>>19890000
                                                               <<04782>>19892000
BEGIN                                                          <<04782>>19894000
   EQUATE                                                      <<04782>>19896000
      TEMPBUFSIZE = 2048,                                      <<04782>>19898000
      NRTEMPSECTS = TEMPBUFSIZE/128,                           <<04782>>19900000
      SLCLNDLBUFS1 = TEMPBUFSIZE+256;                          <<04782>>19902000
   DEFINE                                                      <<04782>>19904000
      OSPLLID = OSPLREC0 #,      <<ID CODE>>                   <<04782>>19906000
      OSPLFL = OSPLREC0(1) #,    <<FILE LENGTH>>               <<04782>>19908000
      OSPLEL = OSPLREC0(2) #,    <<EXTENT LENGTH>>             <<04782>>19910000
      OSPLNS = OSPLREC0(4) #,    <<# OF SEGMENTS>>             <<04782>>19912000
      OSPLFRTL = OSPLREC0(7) #,  <<FREE REF. ENTRY #>>         <<04782>>19914000
      OSPLNRT = OSPLREC0(9) #,   <<# REF TABLE ENTRIES>>       <<04782>>19916000
      OSLNS = OSPLREC0(11) #;    <<# OF SECTIONS>>             <<04782>>19918000
                                                               <<04782>>19920000
   INTEGER POINTER                                             <<04782>>19922000
      OSPLREC0,                                                <<04782>>19924000
      OSPLREC1,                                                <<04782>>19926000
      TEMPBUF;                                                 <<04782>>19928000
   INTEGER                                                     <<04782>>19930000
      ORECD,                                                   <<04782>>19932000
      ORTRECD := 0,                                            <<04782>>19934000
      PREV,                                                    <<04782>>19936000
      NSLRSA,                                                  <<04782>>19938000
      NSLSISA,                                                 <<04782>>19940000
      NSLPMAPSA,                                               <<04782>>19942000
      LENGTH,                                                  <<04782>>19944000
      FROMREC,                                                 <<04782>>19946000
      TOREC,                                                   <<04782>>19948000
      I;                                                       <<04782>>19950000
   LOGICAL                                                     <<04782>>19952000
      REPLACEOLDSL := FALSE,                                   <<04782>>19954000
      SWITCHED'SL := FALSE,                                    <<04782>>19956000
      XFER,                                                    <<04782>>19958000
      NWTOCOPY;                                                <<04782>>19960000
   BYTE ARRAY OLDSLNAME(0:31);                                 <<04782>>19962000
                                                               <<04782>>19964000
                                                               <<04782>>19966000
   SUBROUTINE CANTCLOSE(FN);                                   <<04782>>19968000
      VALUE FN; INTEGER FN;                                    <<04782>>19970000
      BEGIN                                                    <<04782>>19972000
      FCHECK( FN, I);                                          <<04782>>19974000
      ERRORN( 10, DOUBLE(I));                                  <<04782>>19976000
      END;                                                     <<04782>>19978000
                                                               <<04782>>19980000
SUBROUTINE TRANSFERRECS;                                       <<04782>>19982000
                                                               <<04782>>19984000
<< THIS SUBROUTINE TRANSFERS "NWTOCOPY" WORDS FROM RECORD >>   <<04782>>19986000
<< "FROMREC" IN OLD SL FILE TO RECORD "TOREC" IN NEW SL   >>   <<04782>>19988000
<< FILE.                                                  >>   <<04782>>19990000
                                                               <<04782>>19992000
BEGIN                                                          <<04782>>19994000
   WHILE NWTOCOPY > 0 DO                                       <<04782>>19996000
      BEGIN                                                    <<04782>>19998000
         XFER := IF NWTOCOPY > TEMPBUFSIZE THEN TEMPBUFSIZE    <<04782>>20000000
                                           ELSE NWTOCOPY;      <<04782>>20002000
         FREADMR'(OSPLFNUM,TEMPBUF,XFER,FROMREC);              <<04782>>20004000
         FWRITEMR'(SPLFNUM,TEMPBUF,XFER,TOREC);                <<04782>>20006000
         FROMREC:=FROMREC+NRTEMPSECTS;                         <<04782>>20008000
         TOREC:=TOREC+NRTEMPSECTS;                             <<04782>>20010000
         NWTOCOPY:=NWTOCOPY-XFER;                              <<04782>>20012000
      END;                                                     <<04782>>20014000
END;                                                           <<04782>>20016000
                                                               <<04782>>20018000
SUBROUTINE COPYSIINFO;                                         <<04782>>20020000
                                                               <<04782>>20022000
BEGIN                                                          <<04782>>20024000
   COUNTSISPACE(LENGTH);                                       <<04782>>20026000
   IF LENGTH <> 0 THEN                                         <<04782>>20028000
      BEGIN                                                    <<04782>>20030000
         TOS:=FINDSLSPACE(LENGTH);                             <<04782>>20032000
         IF <> THEN GO NOROOM;                                 <<04782>>20034000
         NSLSISA := TOS;                                       <<04782>>20036000
         NWTOCOPY := LENGTH&LSL(7);                            <<04782>>20038000
         FROMREC:=SLRSIREC;                                    <<04782>>20040000
         TOREC:=NSLSISA;                                       <<04782>>20042000
         TRANSFERRECS;                                         <<04782>>20044000
         SLRSIREC:=NSLSISA;                                    <<04782>>20046000
      END;                                                     <<04782>>20048000
END;                                                           <<04782>>20050000
                                                               <<04782>>20052000
SUBROUTINE COPYPMAPINFO;                                       <<04782>>20054000
                                                               <<04782>>20056000
BEGIN                                                          <<04782>>20058000
   COUNTPMAPSPACE(LENGTH);                                     <<04782>>20060000
   IF LENGTH <> 0 THEN                                         <<04782>>20062000
      BEGIN                                                    <<04782>>20064000
         TOS:=FINDSLSPACE(LENGTH);                             <<04782>>20066000
         IF <> THEN GO NOROOM;                                 <<04782>>20068000
         NSLPMAPSA := TOS;                                     <<04782>>20070000
         NWTOCOPY := LENGTH&LSL(7);                            <<04782>>20072000
         FROMREC:=SLRPMAPREC;                                  <<04782>>20074000
         TOREC:=NSLPMAPSA;                                     <<04782>>20076000
         TRANSFERRECS;                                         <<04782>>20078000
         SLRPMAPREC:=NSLPMAPSA;                                <<04782>>20080000
      END;                                                     <<04782>>20082000
END;                                                           <<04782>>20084000
                                                               <<04782>>20086000
   IF SPLFNUM=0 THEN                                           <<04782>>20088000
      BEGIN                                                    <<04782>>20090000
      ERROR(16);                                               <<04782>>20092000
      GO NFG;                                                  <<04782>>20094000
      END;                                                     <<04782>>20096000
   FIXUPSL(FALSE);                                             <<04782>>20098000
   FGETINFO(SPLFNUM,OLDSLNAME,,,,,,,,,,,,,,,NREXTENTS);        <<04782>>20100000
   IF <> THEN GO NFG;                                          <<04782>>20102000
                                                               <<04782>>20104000
   << * * * ALLOCATE STORAGE * * * >>                          <<04782>>20106000
                                                               <<04782>>20108000
   MAKEROOMINDL( SLCLNDLBUFS1);                                <<04782>>20110000
   IF < THEN GO NFG;                                           <<04782>>20112000
   @TEMPBUF := @DLAREA1-TEMPBUFSIZE;                           <<04782>>20114000
   @OSPLREC1 := @TEMPBUF-128;                                  <<04782>>20116000
   @OSPLREC0 := @OSPLREC1-128;                                 <<04782>>20118000
   MOVE OSPLREC0 := SPLREC0,(256); <<SAVE OLD RECS 0,1>>       <<04782>>20120000
                                                               <<04782>>20122000
   << * * * OPEN NEW SL FILE * * * >>                          <<04782>>20124000
                                                               <<04782>>20126000
   IF BFNAME1 = " " THEN                                       <<04782>>20128000
      BEGIN                                                    <<04782>>20130000
      MOVE BFNAME1 := OLDSLNAME,(32);                          <<04782>>20132000
      REPLACEOLDSL := TRUE;                                    <<04782>>20134000
      END                                                      <<04782>>20136000
   ELSE                                                        <<04782>>20138000
      BEGIN                                                    <<04782>>20140000
      OLDFILE( BFNAME1, 202);                                  <<04782>>20142000
      IF < THEN GO NFG;                                        <<04782>>20144000
      END;                                                     <<04782>>20146000
   FILESIZE := OSPLFL;                                         <<04782>>20148000
   IF FACTOR <> 0D THEN                                        <<04782>>20150000
      BEGIN                                                    <<04782>>20152000
      FILESIZE := INTEGER(DELTA(DOUBLE(OSPLFL-SLTOTALFREESPACE),        20154000
           FACTOR));                                           <<04782>>20156000
      IF FILESIZE < OSPLFL THEN NREXTENTS := FILESIZE/OSPLEL;  <<04782>>20158000
      IF NREXTENTS <= 0 THEN NREXTENTS := 1;                   <<04782>>20160000
      END;                                                     <<04782>>20162000
   <<FROM THIS POINT IT WILL BE NECCESSARY TO REOPEN >>        <<04782>>20164000
   <<OLD SL FILE ON ERROR                            >>        <<04782>>20166000
   SWITCHED'SL := TRUE;                                        <<04782>>20168000
   OSPLFNUM := SPLFNUM;                                        <<04782>>20170000
   SPLFNUM := 0;                                               <<04782>>20172000
   OPENSL(TRUE);                                               <<04782>>20174000
   IF SPLFNUM = 0 THEN GO OPENFAIL;                            <<04782>>20176000
                                                               <<04782>>20178000
   << * * * ALLOCATE SPACE FOR REFERENCE TABLE ENTRIES * * * >><<04782>>20180000
                                                               <<04782>>20182000
   SPLNRT := OSPLNRT;                                          <<04782>>20184000
   I := -1;                                                    <<04782>>20186000
   TOS := (OSPLNRT+3)&LSR(2);                                  <<04782>>20188000
   WHILE <> DO                                                 <<04782>>20190000
      BEGIN                                                    <<04782>>20192000
      TOS := FINDSLSPACE(1);                                   <<04782>>20194000
      IF < THEN GO NOROOM;                                     <<04782>>20196000
      SPLREC1(I:=I+1) := TOS;                                  <<04782>>20198000
      TOS:=TOS-1;                                              <<04782>>20200000
      END;                                                     <<04782>>20202000
   DEL;                                                        <<04782>>20204000
                                                               <<04782>>20206000
   << * * * COPY DIRECTORY * * * >>                            <<04782>>20208000
                                                               <<04782>>20210000
   FOR *I := SPLFHI UNTIL 127 DO                               <<04782>>20212000
      BEGIN                                                    <<04782>>20214000
      IF OSPLREC0(I) <> 0 THEN                                 <<04782>>20216000
         BEGIN                                                 <<04782>>20218000
         ORECD := OSPLREC0(XREG);                              <<04782>>20220000
         TOS := FINDSLSPACE(1);                                <<04782>>20222000
         IF <> THEN GO NOROOM;                                 <<04782>>20224000
         SPLREC0(XREG) := PREV := TOS;                         <<04782>>20226000
L1:                                                            <<04782>>20228000
         FREADDIR'( OSPLFNUM, SPLDIR, ORECD);                  <<04782>>20230000
         IF SPLDIR <> 0 THEN                                   <<04782>>20232000
            BEGIN                                              <<04782>>20234000
            ORECD := SPLDIR;                                   <<04782>>20236000
            SPLDIR := FINDSLSPACE(1);                          <<04782>>20238000
            IF <> THEN GO NOROOM;                              <<04782>>20240000
            FWRITEDIR'( SPLFNUM, SPLDIR, PREV);                <<04782>>20242000
            PREV := SPLDIR;                                    <<04782>>20244000
            GO L1;                                             <<04782>>20246000
            END;                                               <<04782>>20248000
         FWRITEDIR'( SPLFNUM, SPLDIR, PREV);                   <<04782>>20250000
         END;                                                  <<04782>>20252000
      END;                                                     <<04782>>20254000
                                                               <<04782>>20256000
   << * * * COPY SEGMENTS AND REFERENCE TABLE * * * >>         <<04782>>20258000
                                                               <<04782>>20260000
   SPLFRTL := -1;                                              <<04782>>20262000
   FOR I := 0 UNTIL OSPLNRT-1 DO                               <<04782>>20264000
      BEGIN                                                    <<04782>>20266000
      TOS := I; TOS := 4;                                      <<04782>>20268000
      ASSEMBLE( DIV, STBX);                                    <<04782>>20270000
      @RTP := (TOS&LSL(5))+@RTBUF;                             <<04782>>20272000
      TOS := OSPLREC1(XREG);                                   <<04782>>20274000
      IF S0 <> ORTRECD THEN                                    <<04782>>20276000
         BEGIN                                                 <<04782>>20278000
         CLEANUPRTBUF;                                         <<04782>>20280000
         RTRECD := SPLREC1(XREG);                              <<04782>>20282000
         FREADDIR'( OSPLFNUM, RTBUF, S0);                      <<04782>>20284000
         ORTRECD := S0;                                        <<04782>>20286000
         RTMODIFIED := TRUE;                                   <<04782>>20288000
         END;                                                  <<04782>>20290000
      DDEL;                                                    <<04782>>20292000
      IF NOT DELETEDSEG THEN                                   <<04782>>20294000
         BEGIN                                                 <<04782>>20296000
         SPLNS := SPLNS+1;                                     <<04782>>20298000
         TOS := FINDSLSPACE(SLRNR);                            <<04782>>20300000
         IF <> THEN GO NOROOM;                                 <<04782>>20302000
         NSLRSA := TOS;                                        <<04782>>20304000
         NWTOCOPY := SLRNR&LSL(7);                             <<04782>>20306000
         FROMREC := SLRSA;                                     <<04782>>20308000
         TOREC := NSLRSA;                                      <<04782>>20310000
         TRANSFERRECS;                                         <<04782>>20312000
         SLRSA := NSLRSA;                                      <<04782>>20314000
         COPYSIINFO;                                           <<04782>>20316000
         COPYPMAPINFO;                                         <<04782>>20318000
         END                                                   <<04782>>20320000
      ELSE                                                     <<04782>>20322000
         BEGIN                                                 <<04782>>20324000
         RTP := SPLFRTL;                                       <<04782>>20326000
         SPLFRTL := I;                                         <<04782>>20328000
         END;                                                  <<04782>>20330000
      END;                                                     <<04782>>20332000
                                                               <<04782>>20334000
   IF REPLACEOLDSL THEN                                        <<04782>>20336000
      BEGIN                                                    <<04782>>20338000
      FCLOSE( OSPLFNUM, 4, 0);                                 <<04782>>20340000
      IF <> THEN                                               <<04782>>20342000
         BEGIN                                                 <<04782>>20344000
         CANTCLOSE(OSPLFNUM);                                  <<04782>>20346000
         GO NFG;                                               <<04782>>20348000
         END;                                                  <<04782>>20350000
      OPENSL( FALSE); <<SAVE PRESENT SL FILE>>                 <<04782>>20352000
      END                                                      <<04782>>20354000
   ELSE                                                        <<04782>>20356000
      FCLOSE( OSPLFNUM, 1, 0);                                 <<04782>>20358000
   CONDCODE := CCE;                                            <<04782>>20360000
   RETURN;                                                     <<04782>>20362000
                                                               <<04782>>20364000
NOROOM:                                                        <<04782>>20366000
NFG:                                                           <<04782>>20368000
   CONDCODE := CCL;                                            <<04782>>20370000
   IF NOT SWITCHED'SL THEN RETURN;                             <<04782>>20372000
   FCLOSE( SPLFNUM, 4, 0);                                     <<04782>>20374000
   IF <> THEN CANTCLOSE(SPLFNUM);                              <<04782>>20376000
   FCLOSE( OSPLFNUM, 1, 0);                                    <<04782>>20378000
   IF <> THEN CANTCLOSE(OSPLFNUM);                             <<04782>>20380000
OPENFAIL:                                                      <<04782>>20382000
   SPLFNUM := 0;                                               <<04782>>20384000
   MOVE BFNAME1 := OLDSLNAME,(32);                             <<04782>>20386000
   OPENSL(FALSE);                                              <<04782>>20388000
END;                                                           <<04782>>20390000
$PAGE "SL FILE MAINTAINENCE PROCEDURES - LISTSL'"              <<00465>>20392000
$ CONTROL SEGMENT = SEG30                                               20394000
PROCEDURE LISTSL';                                                      20396000
   <<LISTS THE CONTENTS OF THE CURRENT SPL FILE>>                       20398000
   BEGIN                                                                20400000
   BYTE ARRAY B0(0:10)=PB _ "PRIVILEGED ";                              20402000
   BYTE ARRAY B1(0:9)=PB _ "ALLOCATED ";                                20404000
   BYTE ARRAY B2(0:8)=PB _ "RESIDENT ";                                 20406000
   BYTE ARRAY B3(0:7)=PB _ "SL FILE ";                                  20408000
   BYTE ARRAY B4(0:6)=PB _ "SEGMENT";                                   20410000
   BYTE ARRAY B5(0:5)=PB _ "LENGTH";                                    20412000
   BYTE ARRAY B6 (0:33)=PB := "ENTRY POINTS    CHECK CAL STT  ADR";     20414000
   BYTE ARRAY B7 (0:28)=PB := "EXTERNALS       CHECK STT SEG";          20416000
   BYTE ARRAY B8(0:6)=PB _ "SYSTEM ";                                   20418000
   BYTE ARRAY B9 (0:3)=PB _ "USED";                                     20420000
   BYTE ARRAY B10 (0:8)=PB _ "AVAILABLE";                               20422000
   INTEGER I;  <<SEGMENT NR.>>                                          20424000
   DOUBLE WORDUSED;                                            <<00207>>20426000
   INTEGER WORDUSED2=WORDUSED+1;                               <<00207>>20428000
   DOUBLE WORDFREE;                                            <<00207>>20430000
   INTEGER WORDFREE2=WORDFREE+1;                               <<00207>>20432000
                                                                        20434000
   <<* * * COMPLETE SEGMENT BINDING * * *>>                             20436000
                                                                        20438000
   FIXUPSL(FALSE);                                                      20440000
                                                                        20442000
   <<* * * PRINT FILE NAME * * *>>                                      20444000
                                                                        20446000
   FCONTROL(INFNUM,ENABLE'CTLY,I);                             <<00.DM>>20448000
   CTLY := FALSE;                                              <<00.DM>>20450000
   BLANKLINE;                                                           20452000
   TOS _ SPLFNUM;                                                       20454000
   MOVE BLINE _ B3,(8),2;  <<"SL FILE">>                                20456000
   FGETINFO(*,*);  <<INSERT SL FILE NAME>>                              20458000
   PRINTLINE;                                                           20460000
   FOR I _ 0 UNTIL SPLNRT-1 DO                                          20462000
      BEGIN                                                             20464000
      GETREFTABENTRY(I);  <<LOAD REF. TAB. ENTRY>>                      20466000
      MOVE LINE:=SLRSEGNAME,(8);                               <<00207>>20468000
      IF NOT DELETEDSEG AND((BFNAME1=" ") OR                   <<00207>>20470000
         (BFNAME1=BLINE,(16)) )  THEN                          <<00207>>20472000
         BEGIN                                                          20474000
         LOADSLSTT;  <<LOAD STT, ETC.>>                                 20476000
                                                                        20478000
         <<* * * PRINT SEGMENT NAME * * *>>                             20480000
                                                                        20482000
         BLANKLINE;                                                     20484000
         MOVE BLINE _ B4,(7); NTOA(I,8,BLINE(10));  <<SEG. NR.>>        20486000
         MOVE LINE(6) := SLRSEGNAME,(8);  <<SEG. NAME>>                 20488000
         MOVE BLINE(28) := B5,(6);                                      20490000
         NTOA(SLRSL,8,BLINE(39));  <<SEG. LENGTH>>                      20492000
         PRINTLINE;                                                     20494000
         TOS _ @BLINE;                                                  20496000
         IF SLPRIVILEGED THEN MOVE * _ B0,(11),2;                       20498000
         IF SLALLOCATED THEN MOVE * _ B1,(10),2;                        20500000
         IF SLRESIDENT THEN MOVE * _ B2,(9),2;                          20502000
         IF SLSYSTEM THEN MOVE * _ B8,(7),2;                            20504000
         IF TOS <> @BLINE THEN PRINTLINE;                               20506000
                                                                        20508000
         <<* * * PRINT ENTRY POINT NAMES * * *>>                        20510000
                                                                        20512000
         BLANKLINE;                                                     20514000
         MOVE BLINE(3) := B6,(34);                                      20516000
         PRINTLINE;                                                     20518000
         SETUPLIBBUF;                                                   20520000
         WHILE GETNEXTLIBENTRY DO  <<STEP THRU DIRECTORY>>              20522000
            IF SLSEGNR = I THEN                                         20524000
               BEGIN                                                    20526000
               IF CTLY THEN RETURN;    <<CHECK FOR CONTROL Y>> <<00.DM>>20528000
               TOS _ @BLINE(3); TOS _ @SLNAME&LSL(1)+1;                 20530000
               MOVE * _ *,(SPLNC);                                      20532000
               NTOA(SLPCHECK,8,BLINE(21));  <<PARM. CHECK LEVEL>>       20534000
               BLINE(26) := IF SLUNCALLABLE THEN "U" ELSE "C";          20536000
               NTOA(SLSTTNR,8,BLINE(31));  <<STT NR.>>                  20538000
               NTOA(STTP(-SLSTTNR).(2:14),8,BLINE(37));  <<PB ADR.>>    20540000
               PRINTLINE                                                20542000
               END;                                                     20544000
                                                                        20546000
         <<* * * PRINT EXTERNAL NAMES * * *>>                           20548000
                                                                        20550000
         BLANKLINE;                                                     20552000
         MOVE BLINE(3) := B7,(29);                                      20554000
         PRINTLINE;                                                     20556000
         WHILE GETNEXTSLEXTN DO                                         20558000
            BEGIN                                                       20560000
            IF CTLY THEN RETURN;       <<CHECK FOR CONTROL Y>> <<00.DM>>20562000
            TOS _ @BLINE(3); TOS _ @SLXNAME&LSL(1)+1;                   20564000
            MOVE * := *,(SLXNC);                                        20566000
            NTOA(SLXPCHECK,8,BLINE(21));  <<PARM. CHECK LEVEL>>         20568000
            NTOA(SLXSTTNR,8,BLINE(27));  <<STT NR.>>                    20570000
            IF SLSATISEXTN  <<SATISFIED?>>                              20572000
               THEN NTOA(SLXSEGNR,8,BLINE(31))  <<SEG. NR.>>            20574000
               ELSE BLINE(31) := "?";                                   20576000
            PRINTLINE                                                   20578000
            END;                                                        20580000
                                                                        20582000
         <<* * * PRINT REFERENCED SEGMENT LIST * * *>>                  20584000
                                                                        20586000
         BLANKLINE;                                                     20588000
         TOS _ @BLINE;  <<COLUMN POINTER>>                              20590000
         TOS _ @SLRREFEDSEGS;  <<SEGMENT BIT MAP>>                      20592000
         TOS _ 0;  <<SEGMENT NR.>>                                      20594000
         XREG _ SPLNRT;  <<LOOP COUNTER>>                               20596000
         DO BEGIN                                                       20598000
            ASSEMBLE(DDUP,ZERO; CAB,CAB);                               20600000
            BPS5 := INTEGER(TESTBIT(*,*).(15:1))+%60;                   20602000
            @BPS2 _ @BPS2+1;  <<NEXT COLUMN>>                           20604000
            IF S0.(13:3) = %7 THEN @BPS2 _ @BPS2+1;  <<SPACE POINTER>>  20606000
            IF S0.(10:6) = %77 THEN  <<LINE FULL?>>                     20608000
               BEGIN                                                    20610000
               PRINTLINE;                                               20612000
               @BPS2 _ @BLINE  <<RE-SET COLUMN POINTER>>                20614000
               END;                                                     20616000
            ASSEMBLE(INCA,DECX)                                         20618000
            END UNTIL =;                                                20620000
         DDEL;                                                          20622000
         IF TOS <> @BLINE THEN PRINTLINE; <<PRINT LAST LINE?>> <<00207>>20624000
         IF BFNAME1 <> " " THEN GO GETOUT;                     <<04122>>20626000
         END                                                            20628000
      END;                                                              20630000
   IF BFNAME1 <> " " THEN BEGIN ERROR(93); GO GETOUT; END;     <<04122>>20632000
                                                                        20634000
   <<* * * PRINT FILE PARAMETERS * * *>>                                20636000
                                                                        20638000
   BLANKLINE;                                                           20640000
   WORDFREE := DOUBLE(SLTOTALFREESPACE)&DLSL(7);               <<00465>>20644000
   MOVE BLINE _ B9,(4);                                        <<00207>>20646000
   WORDUSED:=DOUBLE(LOGICAL(SPLFL))&DLSL(7)-WORDFREE;          <<00465>>20648000
   DNTOA(WORDUSED,8,BLINE(19));                                <<00207>>20650000
   BLINE(20):="(";                                             <<00207>>20652000
   DNTOA((WORDUSED&DASR(7)),8,BLINE(25));                      <<00207>>20654000
   BLINE(26):=".";                                             <<00207>>20656000
   NTOA(WORDUSED2.(9:7),8,BLINE(29));                          <<00207>>20658000
   BLINE(30):=")";                                             <<00207>>20660000
   MOVE BLINE(35) _ B10,(9);                                   <<00207>>20662000
   DNTOA(WORDFREE,8,BLINE(54));                                <<00207>>20664000
   BLINE(55):="(";                                             <<00207>>20666000
   DNTOA((WORDFREE&DASR(7)),8,BLINE(60));                      <<00207>>20668000
   BLINE(61):=".";                                             <<00207>>20670000
   NTOA(WORDFREE2.(9:7),8,BLINE(64));                          <<00207>>20672000
   BLINE(65):=")";                                             <<00207>>20674000
   PRINTLINE;                                                           20676000
   EJECTPAGE;                                                  <<00.DM>>20678000
GETOUT: FCONTROL(INFNUM, DISABLE'CTLY,I);                      <<04122>>20680000
   END;                                                                 20682000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - OPENRL"               <<00207>>20684000
<<----------------------------------------------------------------------20686000
*                                                                      *20688000
*  RL FILE MAINTAINENCE PROCEDURES                                     *20690000
*                                                                      *20692000
---------------------------------------------------------------------->>20694000
                                                                        20696000
$ CONTROL SEGMENT = SEG40                                               20698000
PROCEDURE OPENRL (NEWFILE);                                             20700000
  <<PRESERVES ANY INFORMATION IN CORE THAT MAY BE DESTROYED BY          20702000
     LOADING THE RL, THEN LOADS THE RL AND INITIALIZES THE NECESSARY    20704000
     GLOBAL PARAMETERS.  IF NEWFILE IS SET, RECORD 0 IS INITIALIZED     20706000
     ACCORDING TO THE PARAMETERS IN THE COMMAND BUFFER; OTHERWISE       20708000
     RECORD 0 IS LOADED>>                                               20710000
   VALUE NEWFILE; LOGICAL NEWFILE;                                      20712000
   BEGIN                                                                20714000
   INTEGER SAVEDLAREA1;                                        <<00563>>20716000
   INTEGER FLAG := 0;   <<DL BUFFERS JUST ALLOCATED?>>         <<00563>>20718000
   INTEGER AOPTIONS := 0;                                      <<00563>>20720000
                                                                        20722000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           20724000
                                                                        20726000
   SAVEDLAREA1 := @DLAREA1;                                    <<00563>>20728000
                                                                        20732000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  20734000
                                                                        20736000
   IF NOT RLBUFALLOC THEN  <<ALLOCATE BUFFERS?>>                        20738000
      BEGIN                                                             20740000
      MAKEROOMINDL(RLDLBUFS1);                                          20742000
      IF < THEN GO NFG;  <<NO ROOM?>>                                   20744000
      @RLMAP _ @DLAREA1-128;                                            20746000
      @RLREC0 _ @RLMAP-128;                                             20748000
      @RLDIR _ @RLREC0-128;                                             20750000
      @RLPROCTAB := @RLDIR-RLPROCTABLEN;                                20752000
      @DLAREA1 := @RLPROCTAB;  <<NEW DL AREA 1 LIMIT>>                  20754000
      RLBUFALLOC := TRUE;  <<SET FLAG>>                                 20756000
      FLAG := FLAG+1  <<SET FLAG>>                                      20758000
      END;                                                              20760000
                                                                        20762000
   <<* * * PRESERVE OVERLAYABLE INFORMATION * * *>>                     20764000
                                                                        20766000
   CLOSERL;                                                             20768000
   IF < THEN GO NFG;  <<ERROR?>>                                        20770000
                                                                        20772000
   <<* * * LOAD NEW RL FILE INFORMATION * * *>>                         20774000
                                                                        20776000
   IF NEWFILE THEN  <<INIT. RECORD 0?>>                                 20778000
      BEGIN                                                             20780000
      IF NOT (MINRL <= FILESIZE <= MAXRL) THEN                          20782000
         BEGIN                                                          20784000
         ERROR(20);                                                     20786000
         GO NFG                                                         20788000
         END;                                                           20790000
      RLFNUM _ FOPEN(BFILENAME,%(2)10000000000,%(2)111010100,,,,,,,     20792000
         DOUBLE(LOGICAL(FILESIZE)),NREXTENTS,,RLFILECODE);              20794000
      IF < THEN  <<ERROR?>>                                             20796000
         BEGIN                                                          20798000
         FOPENERROR:                                                    20800000
         TOS _ 30;                                                      20802000
         TOS _ 0D; FCHECK(0,S0);  <<FILE SYS. ERROR NR.>>               20804000
         ERRORN(*,*);                                                   20806000
         GO NFG                                                         20808000
         END;                                                           20810000
                                                                        20812000
      <<* * * INITIALIZE RECORD 0 * * *>>                               20814000
                                                                        20816000
      TOS _ @RLREC0; PS0 _ 0;                                           20818000
      ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);                  20820000
      RLLID := RLFILEID;  <<VERSION NR.>>                               20822000
      RLFL _ FILESIZE;  <<FILE LENGTH (IN RECORDS)>>                    20824000
      RLNS _ (LOGICAL(FILESIZE)+511)&LSR(9);  <<NR. SECTIONS>>          20826000
      RLSAXL _ BIGD;  <<S.A. OF EXTERNAL LISTS>>                        20828000
                                                                        20830000
      <<* * * INITIALIZE FREE STORAGE MAPS * * *>>                      20832000
                                                                        20834000
      TOS _ RLNS;  <<SECTION COUNTER>>                                  20836000
      DO BEGIN                                                          20838000
         TOS _ @RLMAP; PS0 _ -1;                                        20840000
         ASSEMBLE(DUP,INCB); TOS _ 127; ASSEMBLE(MOVE 3);               20842000
         IF S0 = 1 THEN  <<FIRST SECTION?>>                             20844000
            BEGIN                                                       20846000
            XREG _ (RLNS+1)&LSL(2);                                     20848000
            DO BEGIN                                                    20850000
               CLEARBIT(RLMAP,XREG-1);                                  20852000
               XREG _ XREG-1                                            20854000
               END UNTIL =                                              20856000
            END;                                                        20858000
         IF S0 = RLNS THEN  <<LAST SECTION?>>                           20860000
            BEGIN                                                       20862000
            TOS _ RLFL.(7:9)&LSL(2);                                    20864000
            WHILE <> DO                                                 20866000
               BEGIN                                                    20868000
               CLEARBIT(RLMAP,S0);                                      20870000
               TOS _ (TOS+1).(5:11)                                     20872000
               END;                                                     20874000
            DEL                                                         20876000
            END;                                                        20878000
         FWRITEDIR'(RLFNUM,RLMAP,S0);                                   20880000
         TOS _ TOS-1                                                    20882000
         END UNTIL =;                                                   20884000
      RLSTATE.(1:2) := %(2)11  <<INIT. STATE WORD>>                     20886000
      END                                                               20888000
   ELSE  <<READ RECORD 0 AND FIRST MAP>>                                20890000
      BEGIN                                                             20892000
      RLFNUM _ FOPEN(BFILENAME,%(2)10000000011,%(2)111110100);          20894000
      IF < THEN GO FOPENERROR;  <<ERROR?>>                              20896000
      TOS _ 0;                                                          20900000
      FGETINFO(RLFNUM,,,AOPTIONS,,,,,S0);  <<GET FILE CODE>>   <<00563>>20902000
      IF AOPTIONS.(7:9) <> %764 THEN                           <<00563>>20904000
         BEGIN                                                 <<00563>>20906000
         ERROR(96);                                            <<00563>>20908000
         CLOSERL;                                              <<00563>>20910000
         GO NFG;                                               <<00563>>20912000
         END;                                                  <<00563>>20914000
      FLOCK(RLFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>            <<00563>>20916000
      FREADMR'(RLFNUM,RLREC0,P256,0);  <<RECORD 0 AND MAP>>             20918000
      IF TOS <> RLFILECODE OR RLLID <> 3 THEN  <<TYPE RL?>>             20920000
         BEGIN                                                          20922000
         ERROR(22);                                                     20924000
         GO NFG                                                         20926000
         END;                                                           20928000
      RLSTATE.(1:2) := %(2)00  <<INIT. STATE WORD>>                     20930000
      END;                                                              20932000
                                                                        20934000
   <<* * * INIT. GLOBAL PARAMETERS * * *>>                              20936000
                                                                        20938000
   ASSEMBLE(DZRO,DZRO; ZERO);                                           20940000
   RLMAPRECD _ 1; RLMAPMODIFIED _ TOS;                                  20942000
   RLENTRYMODIFIED _ TOS;                                               20944000
   NRPROCSADDED _ TOS; NRPROCSDELETED _ TOS; CLEANUPRLDIR _ TOS;        20946000
   GO GETOUT;                                                           20948000
                                                                        20950000
   NFG:                                                                 20952000
   IF LOGICAL(FLAG) THEN  <<DEALLOCATE BUFFERS?>>                       20954000
      BEGIN                                                             20956000
      @DLAREA1 := SAVEDLAREA1;  <<RESTORE DL AREA 1 LIMIT>>             20958000
      RLBUFALLOC := FALSE  <<CLEAR FLAG>>                               20960000
      END;                                                              20962000
                                                                        20964000
   GETOUT:                                                              20966000
   END;                                                                 20968000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - CLOSERL"              <<00207>>20970000
$ CONTROL SEGMENT = SEG40                                               20972000
PROCEDURE CLOSERL;                                                      20974000
   <<IF A RL FILE IS OPENED, SAVES THE INFORMATION IN CORE THAT         20976000
     HAS BEEN MODIFIED: SAVES RECORD 0.  NOTE THAT THIS PROCEDURE USES  20978000
     THE CONDITION CODE TO INDICATE AN ERROR>>                          20980000
   BEGIN                                                                20982000
   TOS := RLFNUM;  <<RL FILE NR.>>                                      20984000
   IF <> THEN  <<RL OPENED?>>                                           20986000
      BEGIN                                                             20988000
      FIXUPRL;  <<COMPLETE ANY BINDING>>                                20990000
      FCLOSE(RLFNUM,RLNEW,0);                                           20992000
      IF < THEN  <<ERROR?>>                                             20994000
         BEGIN                                                          20996000
         TOS _ 23;                                                      20998000
         TOS _ 0D; FCHECK(RLFNUM,S0);                                   21000000
         ERRORN(*,*);                                                   21002000
         TOS _ CCL;  <<ERROR CONDITION CODE>>                           21004000
         GO GETOUT                                                      21006000
         END;                                                           21008000
      RLSTATE.(1:2) := %(2)00;  <<RE-SET STATE WORD>>                   21010000
      RLFNUM := 0  <<CLEAR RL FILE NR.>>                                21012000
      END;                                                              21014000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    21016000
                                                                        21018000
   GETOUT:                                                              21020000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             21022000
   END;                                                                 21024000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - FINDRLSPACE"          <<00207>>21026000
$ CONTROL SEGMENT = SEG40                                               21028000
DOUBLE PROCEDURE FINDRLSPACE (NRWORDS,RECFLAG);                         21030000
   <<FINDS SPACE IN THE RL FILE FOR NRWORDS AND RETURNS THE FILE        21032000
     ADDRESS AS THE RESULT.  THE NUMBER OF WORDS REQUESTED IS ROUNDED   21034000
     UP TO AN INTEGRAL NUMBER OF 32 WORD BLOCKS.  IF THE RECFLAG IS SET,21036000
     THE SPACE WILL BEGIN ON A RECORD BOUNDARY.  NOTE THAT THIS         21038000
     PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>           21040000
   VALUE NRWORDS,RECFLAG;                                               21042000
   INTEGER NRWORDS;                                                     21044000
   LOGICAL RECFLAG;                                                     21046000
   BEGIN                                                                21048000
   INTEGER SECTIONNR = Q+1;                                             21050000
   INTEGER BLOCKNR = Q+2;                                               21052000
   INTEGER NRBLOCKS = Q+3;                                              21054000
   INTEGER BLOCKS = Q+4;                                                21056000
                                                                        21058000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           21060000
                                                                        21062000
   TOS _ 0;  <<SECTION NR.>>                                            21064000
   TOS _ 0;  <<BLOCK NR.>>                                              21066000
   TOS _ NRWORDS;  <<NR. WORDS REQUESTED>>                              21068000
   IF < OR DOUBLE(LOGICAL(NRWORDS)) >                                   21070000
      DOUBLE(LOGICAL(RLFL-RLNS-1))&DLSL(7) THEN                         21072000
      BEGIN                                                             21074000
      ERROR(11);  <<REQUEST TOO BIG>>                                   21076000
      GO NFG                                                            21078000
      END;                                                              21080000
   TOS _ (LOGICAL(TOS)+31)&LSR(5);  <<NR. BLOCKS REQUESTED>>            21082000
   TOS _ S0;  <<NR. BLOCKS NEEDED>>                                     21084000
                                                                        21086000
   <<* * * SEARCH FREE MAPS * * *>>                                     21088000
                                                                        21090000
   TOS _ RLNS;  <<SECTION COUNTER>>                                     21092000
   DO BEGIN                                                             21094000
      GETRLMAP(SECTIONNR);  <<LOAD SECTION MAP>>                        21096000
      BLOCKNR _ 0;                                                      21098000
      TOS _ 2048;  <<BLOCK COUNTER>>                                    21100000
      DO BEGIN                                                          21102000
         IF TESTBIT(RLMAP,BLOCKNR) AND (NOT RECFLAG OR                  21104000
            BLOCKS <> NRBLOCKS OR BLOCKNR.(14:2) = 0) THEN              21106000
            BEGIN                                                       21108000
            BLOCKS _ BLOCKS-1;  <<ADJ. BLOCKS NEEDED>>                  21110000
            IF = THEN GO FOUNDSPACE                                     21112000
            END                                                         21114000
         ELSE                                                           21116000
            BEGIN                                                       21118000
            BLOCKS _ NRBLOCKS;  <<RESET BLOCKS NEEDED>>                 21120000
            TOS := DOUBLE(LOGICAL(SECTIONNR))&DLSL(11);                 21122000
            TOS := DOUBLE(LOGICAL(BLOCKNR));                            21124000
            ASSEMBLE(INCA,DADD);                                        21126000
            FINDRLSPACE := TOS&DLSL(5)  <<NEW S.A. OF SPACE>>           21128000
            END;                                                        21130000
         BLOCKNR _ BLOCKNR+1;                                           21132000
         TOS _ TOS-1                                                    21134000
         END UNTIL =;                                                   21136000
      SECTIONNR _ SECTIONNR+1;                                          21138000
      ASSEMBLE(DEL,DECA)                                                21140000
      END UNTIL =;                                                      21142000
   ERROR(11);  <<NO ROOM>>                                              21144000
   GO NFG;                                                              21146000
                                                                        21148000
   <<* * * ALLOCATE SPACE * * *>>                                       21150000
                                                                        21152000
   FOUNDSPACE:                                                          21154000
   DO BEGIN                                                             21156000
      CLEARBIT(RLMAP,BLOCKNR);  <<MARK BLOCK "USED">>                   21158000
      RLMAPMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      21160000
      BLOCKNR _ BLOCKNR-1;                                              21162000
      IF < THEN                                                         21164000
         BEGIN                                                          21166000
         BLOCKNR _ 2047;                                                21168000
         SECTIONNR _ SECTIONNR-1;                                       21170000
         GETRLMAP(SECTIONNR)  <<LOAD NEXT MAP>>                         21172000
         END;                                                           21174000
      NRBLOCKS _ NRBLOCKS-1                                             21176000
      END UNTIL =;                                                      21178000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    21180000
   GO GETOUT;                                                           21182000
                                                                        21184000
   NFG:                                                                 21186000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 21188000
                                                                        21190000
   GETOUT:                                                              21192000
   CONDCODE _ TOS                                                       21194000
   END;                                                                 21196000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - RETURNRLSPACE"        <<00207>>21198000
$ CONTROL SEGMENT = SEG40                                               21200000
PROCEDURE RETURNRLSPACE (ADR,NRWORDS);                                  21202000
   <<RETURNS NRWORDS OF SPACE IN THE RL FILE BEGINNING AT FILE ADDRESS  21204000
     ADR.  THE NUMBER OF WORDS RETURNED IS ROUNDED UP TO AN INTEGRAL    21206000
     NUMBER OF BLOCKS>>                                                 21208000
   VALUE ADR,NRWORDS;                                                   21210000
   DOUBLE ADR;                                                          21212000
   INTEGER NRWORDS;                                                     21214000
   BEGIN                                                                21216000
   TOS _ (LOGICAL(NRWORDS)+31)&LSR(5);  <<NR. BLOCKS RETURNED>>         21218000
   TOS _ ADR;  <<STARTING SECTION NR.>>                                 21220000
   TOS _ TOS&LSR(5);  <<STARTING BLOCK NR.>>                            21222000
   GETRLMAP(S1);  <<LOAD SECTION MAP>>                                  21224000
   DO BEGIN                                                             21226000
      SETBIT(RLMAP,S0);  <<MARK BLOCK "FREE">>                          21228000
      RLMAPMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                      21230000
      TOS _ (TOS+1).(5:11);                                             21232000
      IF = THEN  <<NEW SECTION?>>                                       21234000
         BEGIN                                                          21236000
         S1 _ S1+1;  <<NEXT SECTION>>                                   21238000
         GETRLMAP(S1)  <<GET NEXT SECTION MAP>>                         21240000
         END;                                                           21242000
      S2 _ S2-1                                                         21244000
      END UNTIL =                                                       21246000
   END;                                                                 21248000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - GETRLMAP"             <<00207>>21250000
$ CONTROL SEGMENT = SEG40                                               21252000
PROCEDURE GETRLMAP (SECTIONNR);                                         21254000
   <<LOADS THE BIT MAP FOR THE SPECIFIED SECTION NUMBER>>               21256000
   VALUE SECTIONNR;                                                     21258000
   INTEGER SECTIONNR;                                                   21260000
   BEGIN                                                                21262000
   SECTIONNR _ SECTIONNR+1;  <<CONVERT TO REC. NR.>>                    21264000
   IF RLMAPRECD <> SECTIONNR THEN  <<DIFFERENT MAP?>>                   21266000
      BEGIN                                                             21268000
      SAVERLMAP;  <<SAVE CURRENT MAP>>                                  21270000
      RLMAPRECD _ SECTIONNR;                                            21272000
      FREADDIR'(RLFNUM,RLMAP,RLMAPRECD)  <<READ MAP>>                   21274000
      END                                                               21276000
   END;                                                                 21278000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - SAVERLMAP"            <<00207>>21280000
$ CONTROL SEGMENT = SEG40                                               21282000
PROCEDURE SAVERLMAP;                                                    21284000
   <<SAVES THE CURRENT SECTION BIT MAP IF IT HAS BEEN MODIFIED>>        21286000
   BEGIN                                                                21288000
   IF RLMAPMODIFIED THEN  <<MAP MODIFIED?>>                             21290000
      BEGIN                                                             21292000
      FWRITEDIR'(RLFNUM,RLMAP,RLMAPRECD);                               21294000
      RLMAPMODIFIED _ FALSE  <<CLEAR MODIFIED FLAG>>                    21296000
      END                                                               21298000
   END;                                                                 21300000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - SEARCHRL"             <<00207>>21302000
$ CONTROL SEGMENT = SEG40                                               21304000
LOGICAL PROCEDURE SEARCHRL (NAME);                                      21306000
   <<SEARCHES THE RL FILE DIRECTORY FOR THE ENTRY POINT HAVING THE      21308000
     SPECIFIED NAME.  IF FOUND, THE RESULT TRUE IS RETURNED AND THE     21310000
     ENTRY PARAMETERS ARE SET; OTHERWISE THE RESULT FALSE IS RETURNED>> 21312000
   INTEGER ARRAY NAME;                                                  21314000
   BEGIN                                                                21316000
   CLEANUPRLBUF;  <<SAVE MODIFIED ENTRY>>                               21318000
   RLBUCKET _ RLFHI+HASH(NAME);  <<INDEX OF HASH LIST>>                 21320000
   RLRECD _ 0;                                                          21322000
   RLNEXTRECD _ RLREC0(RLBUCKET);  <<FIRST REC. IN LIST>>               21324000
   WHILE GETNEXTRLRECD DO                                               21326000
      BEGIN                                                             21328000
      @RLP _ @RLDIR(2);  <<INIT. ENTRY POINTER>>                        21330000
      WHILE @RLP < @RLDIR(RLDIRUSED) DO                                 21332000
         BEGIN                                                          21334000
         RLENTRYPARMS;  <<GET ENTRY PARM'S>>                            21336000
         IF NAME.(4:4) = RLNC THEN                                      21338000
            BEGIN                                                       21340000
            TOS _ @NAME&LSL(1)+1; TOS _ @RLNAME&LSL(1)+1;               21342000
            IF * = *,(RLNC) THEN  <<NAMES MATCH?>>                      21344000
               BEGIN                                                    21346000
               TOS _ DELETEDPROC(RLINFO);                               21348000
               IF S0 = 0 OR PS0(2) = 0 THEN                             21350000
                  BEGIN                                                 21352000
                  SEARCHRL _ TRUE;                                      21354000
                  RETURN                                                21356000
                  END;                                                  21358000
               DEL                                                      21360000
               END                                                      21362000
            END;                                                        21364000
         @RLP _ @RLP+RLNW  <<NEXT ENTRY>>                               21366000
         END                                                            21368000
      END                                                               21370000
   END;                                                                 21372000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - GETNEXTRLRECD"        <<00207>>21374000
$ CONTROL SEGMENT = SEG40                                               21376000
LOGICAL PROCEDURE GETNEXTRLRECD;                                        21378000
   <<LOADS THE NEXT RECORD IN THE CURRENT HASH LIST.  IF THERE ARE NO   21380000
     MORE RECORDS, THE VALUE FALSE IS RETURNED>>                        21382000
   BEGIN                                                                21384000
   CLEANUPRLBUF;  <<SAVE MODIFIED ENTRY>>                               21386000
   RLPREVRECD _ RLRECD;  <<SAVE PREVIOUS REC. NR.>>                     21388000
   RLRECD _ RLNEXTRECD;  <<NEXT REC. NR.>>                              21390000
   IF = THEN RETURN;  <<NO MORE RECORDS?>>                              21392000
   FREADDIR'(RLFNUM,RLDIR,RLRECD);                                      21394000
   RLNEXTRECD _ RLDIRLINK;  <<SAVE NEXT REC. NR.>>                      21396000
   GETNEXTRLRECD _ TRUE                                                 21398000
   END;                                                                 21400000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - RLENTRYPARMS"         <<00207>>21402000
$ CONTROL SEGMENT = SEG40                                               21404000
PROCEDURE RLENTRYPARMS;                                                 21406000
   <<CALCULATES THE PARAMETERS OF THE CURRENT ENTRY>>                   21408000
   BEGIN                                                                21410000
   RLNC _ RLP.(4:4);  <<NR. CHAR'S IN NAME>>                            21412000
   RLNAMENW _ RLNC&LSR(1)+1;  <<NR. WORDS FOR ENTRY NAME>>              21414000
   @RLP1 _ @RLP+RLNAMENW;  <<INIT. SECONDARY POINTER>>                  21416000
   RLNW _ RLNAMENW+4+PARMLEN(RLPARMS)  <<NR. WORDS FOR ENTRY>>          21418000
   END;                                                                 21420000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - SETUPRLBUF"           <<00207>>21422000
$ CONTROL SEGMENT = SEG40                                               21424000
PROCEDURE SETUPRLBUF;                                                   21426000
   <<INITIALIZES THE DIRECTORY BUFFERS AND PARAMETERS FOR STEPPING THRU 21428000
     THE ENTIRE DIRECTORY>>                                             21430000
   BEGIN                                                                21432000
   CLEANUPRLBUF;  <<SAVE MODIFIED ENTRY>>                               21434000
   RLBUCKET _ RLFHI-1;  <<INIT. HASH LIST INDEX>>                       21436000
   RLRECD _ 0;                                                          21438000
   RLNEXTRECD _ 0;                                                      21440000
   RLDIRUSED _ 2;                                                       21442000
   RLNW _ 2;                                                            21444000
   @RLP _ @RLDIR  <<INIT. ENTRY POINTER>>                               21446000
   END;                                                                 21448000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - GETNEXTRLENTRY"       <<00207>>21450000
$ CONTROL SEGMENT = SEG40                                               21452000
LOGICAL PROCEDURE GETNEXTRLENTRY;                                       21454000
   <<GETS THE NEXT DIRECTORY ENTRY>>                                    21456000
   BEGIN                                                                21458000
   @RLP _ @RLP+RLNW;  <<NEXT ENTRY>>                                    21460000
   IF @RLP = @RLDIR(RLDIRUSED) THEN  <<READ NEXT RECORD?>>              21462000
      BEGIN                                                             21464000
      IF NOT GETNEXTRLRECD THEN  <<NEXT HASH LIST?>>                    21466000
         BEGIN                                                          21468000
         DO RLBUCKET _ RLBUCKET+1 UNTIL RLREC0(RLBUCKET) <> 0;          21470000
         IF RLBUCKET > 127 THEN RETURN;  <<ALL DONE?>>                  21472000
         RLRECD _ 0;                                                    21474000
         RLNEXTRECD _ RLREC0(XREG);                                     21476000
         GETNEXTRLRECD                                                  21478000
         END;                                                           21480000
      @RLP _ @RLDIR(2)  <<RESET ENTRY POINTER>>                         21482000
      END;                                                              21484000
   RLENTRYPARMS;  <<GET ENTRY PARM'S>>                                  21486000
   GETNEXTRLENTRY _ TRUE                                                21488000
   END;                                                                 21490000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - FINDRLDIRSPACE"       <<00207>>21492000
$ CONTROL SEGMENT = SEG40                                               21494000
PROCEDURE FINDRLDIRSPACE (HASHCODE,NRWORDS);                            21496000
   <<STEPS THRU THE DIRECTORY RECORD LIST FOR THE SPECIFIED HASH CODE   21498000
     LOOKING FOR ROOM FOR AN ENTRY OF NRWORDS.  IF NO RECORD CAN BE     21500000
     FOUND, A NEW RECORD IS ALLOCATED AND LINKED INTO THE HASH LIST.    21502000
     IF SPACE IS FOUND, THE PRIMARY ENTRY POINTER IS SET TO THE SPACE   21504000
     ALLOCATED FOR THE NEW ENTRY.  NOTE THAT THIS PROCEDURE USES THE    21506000
     CONDITION CODE TO INDICATE AN ERROR>>                              21508000
   VALUE HASHCODE,NRWORDS;                                              21510000
   INTEGER HASHCODE,NRWORDS;                                            21512000
   BEGIN                                                                21514000
   CLEANUPRLBUF;  <<SAVE MODIFIED ENTRY>>                               21516000
   RLBUCKET _ RLFHI+HASHCODE;  <<INDEX OF HASH LIST>>                   21518000
   RLRECD _ 0;                                                          21520000
   RLNEXTRECD _ RLREC0(RLBUCKET);                                       21522000
   IF <> THEN  <<EMPTY HASH LIST?>>                                     21524000
      DO ASSEMBLE(NOP)  <<COMPILET KLUDGE>>                             21526000
         UNTIL NOT GETNEXTRLRECD OR 128-RLDIRUSED >= NRWORDS;           21528000
   IF RLRECD = 0 THEN  <<GET NEW RECORD FOR HASH LIST?>>                21530000
      BEGIN                                                             21532000
      TOS _ FINDRLSPACE(128,TRUE);  <<FIND A RECORD>>                   21534000
      IF < THEN GO NFG;  <<NO ROOM?>>                                   21536000
      TOS _ TOS&DLSR(7);  <<REC. NR.>>                                  21538000
      RLRECD _ TOS;  <<SAVE REC. NR.>>                                  21540000
      TOS _ RLREC0(RLBUCKET);  <<OLD S.A. OF HASH LIST>>                21542000
      RLNEXTRECD _ S0;                                                  21544000
      RLREC0(XREG) _ RLRECD;  <<NEW S.A. OF HASH LIST>>                 21546000
      TOS _ 2;  <<USED SPACE COUNT>>                                    21548000
      RLDDIR _ TOS;  <<UPDATE DIR. BUFFER>>                             21550000
      RLPREVRECD _ 0  <<PREV. REC. NR.>>                                21552000
      END;                                                              21554000
   @RLP _ @RLDIR(RLDIRUSED);  <<INIT. ENTRY POINTER>>                   21556000
   RLDIRUSED _ RLDIRUSED+NRWORDS;  <<ADJ. USED SPACE COUNT>>            21558000
   RLENTRYMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                       21560000
   TOS _ CCE;  <<OK CONDITION CODE>>                                    21562000
   GO GETOUT;                                                           21564000
                                                                        21566000
   NFG:                                                                 21568000
   TOS _ CCL;  <<ERROR CONDITION CODE>>                                 21570000
                                                                        21572000
   GETOUT:                                                              21574000
   CONDCODE _ TOS  <<STORE CONDITION CODE>>                             21576000
   END;                                                                 21578000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - DELETERLENTRY"        <<00207>>21580000
$ CONTROL SEGMENT = SEG40                                               21582000
PROCEDURE DELETERLENTRY;                                                21584000
   <<DELETES THE CURRENT ENTRY FROM THE CURRENT DIRECTORY RECORD.  IF   21586000
     THE RECORD IS VOID OF ENTRIES, THE SPACE IS RETURNED>>             21588000
   BEGIN                                                                21590000
   MOVE RLP _ RLP(RLNW),(RLDIRUSED-@RLP+@RLDIR-RLNW);                   21592000
   RLDIRUSED _ RLDIRUSED-RLNW;  <<ADJ. USED SPACE COUNT>>               21594000
   IF RLDIRUSED = 2 THEN  <<EMPTY RECORD?>>                             21596000
      BEGIN                                                             21598000
      IF RLREC0(RLBUCKET) = RLRECD                                      21600000
         THEN RLREC0(XREG) _ RLDIR  <<NEW. S.A. OF HASH LIST>>          21602000
         ELSE REPAIRRECORD'(RLFNUM,RLPREVRECD,0,RLDIR);                 21604000
      RETURNRLSPACE(DOUBLE(LOGICAL(RLRECD))&DLSL(7),128)                21606000
      END;                                                              21608000
   RLNW _ 0;  <<ZERO ENTRY LENGTH>>                                     21610000
   RLENTRYMODIFIED _ TRUE  <<SET MODIFIED FLAG>>                        21612000
   END;                                                                 21614000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - CLEANUPRLBUF"         <<00207>>21616000
$ CONTROL SEGMENT = SEG40                                               21618000
PROCEDURE CLEANUPRLBUF;                                                 21620000
   <<SAVES THE CURRENT DIRECTORY RECORD IF IT HAS BEEN MODIFIED>>       21622000
   BEGIN                                                                21624000
   IF RLENTRYMODIFIED THEN                                              21626000
      BEGIN                                                             21628000
      FWRITEDIR'(RLFNUM,RLDIR,RLRECD);  <<SAVE MODIFIED RECORD>>        21630000
      RLENTRYMODIFIED _ FALSE  <<CLEAR MODIFIED FLAG>>                  21632000
      END                                                               21634000
   END;                                                                 21636000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - INSERTRL"             <<00207>>21638000
$ CONTROL SEGMENT = SEG40                                               21640000
PROCEDURE INSERTRL;                                                     21642000
   <<INSERTS THE CURRENT USL PROCEDURE INTO THE CURRENT RL FILE>>       21644000
   BEGIN                                                                21646000
   INTEGER NWINFO = Q+1;  <<NR. WORDS IN INFO BLOCK>>                   21648000
   DOUBLE SAINFO = Q+2;  <<FILE ADR. OF INFO BLOCK>>                    21650000
   INTEGER NRENTPTS = Q+4;  <<NR. ENTRY POINTS>>                        21652000
   LOGICAL BITMAP0 = Q+5;  <<ILLEGAL HEADER NR'S>>                      21654000
   INTEGER NWPARMS = Q+6;  <<PARM. INFO LENGTH>>                        21656000
                                                                        21658000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           21660000
                                                                        21662000
   TOS _ 10+ENTNWCODE;                                                  21664000
   TOS _ 0D;                                                            21666000
   TOS _ 0;                                                             21668000
   TOS:=%(2)0000000101100000;                                  <<04126>>21670000
   TOS := ENTPARMLEN;                                                   21672000
                                                                        21674000
   IF NOT PRIMARYPROC THEN  <<PRIMARY ENTRY POINT?>>                    21676000
      BEGIN                                                             21678000
      ERROR(87);                                                        21680000
      RETURN                                                            21682000
      END;                                                              21684000
   IF FATALERROR THEN  <<FATAL ERROR?>>                                 21686000
      BEGIN                                                             21688000
      ERROR(46);                                                        21690000
      RETURN                                                            21692000
      END;                                                              21694000
   IF WARNING THEN WARN(47);  <<NON-FATAL ERROR?>>                      21696000
                                                                        21698000
   <<* * * DETERMINE INFO BLOCK SIZE * * *>>                            21700000
                                                                        21702000
   WHILE GETNEXTDESCRIP DO                                              21704000
      BEGIN                                                             21706000
      IF BITMAP0&CSR(EHEADTYPE) THEN  <<ILLEGAL HEADER?>>               21708000
         BEGIN                                                          21710000
            ERROR(1);                                                   21712000
         RETURN                                                         21714000
         END;                                                           21716000
      TOS _ EHEADNW;  <<NR. WORDS IN HEADER>>                           21718000
      IF EHEADTYPE = 1 THEN TOS _ TOS+4;                                21720000
      NWINFO _ TOS+NWINFO                                               21722000
      END;                                                              21724000
   USLENTRYPARMS;  <<RESTORE ENTRY PARM'S>>                             21726000
                                                                        21728000
   <<* * * ALLOCATE INFO BLOCK SPACE * * *>>                            21730000
                                                                        21732000
   SAINFO _ FINDRLSPACE(NWINFO,FALSE);                                  21734000
   IF < THEN RETURN;  <<NO ROOM?>>                                      21736000
                                                                        21738000
   <<* * * INSERT ENTRY POINTS IN DIRECTORY * * *>>                     21740000
                                                                        21742000
   DBUF _ SAINFO;  <<S.A. OF INFO BLOCK>>                               21744000
   BUF(3) _ ECODE;  <<CODE MODULE DESCRIPTOR>>                          21746000
   MOVE BUF(4) := EPARMS,(NWPARMS);  <<PARM. INFO>>                     21748000
   TOS _ ENTFILEADR;  <<SAVE ADR. OF ENTRY>>                            21750000
   DO IF ACTIVE THEN                                                    21752000
      BEGIN                                                             21754000
      IF SEARCHRL(ENAME) THEN  <<DUPLICATELY DEFINED?>>                 21756000
         BEGIN                                                          21758000
         ERRORS(12,ENAME);                                              21760000
         GO ABORT1                                                      21762000
         END;                                                           21764000
      FINDRLDIRSPACE(ENTHASH,ENTNAMENW+4+                      <<00.DM>>21766000
                (IF SECPARMPROC THEN ENTPARMLEN ELSE NWPARMS));<<00.DM>>21768000
      IF < THEN GO ABORT1;  <<NO ROOM?>>                                21770000
      MOVE RLNAME _ ENAME,(ENTNAMENW),2;  <<ENTRY POINT NAME>>          21772000
      RLNAME.(0:1) := NOT PRIMARYPROC;  <<PRI./SEC. ENTRY BIT>>         21774000
      BUF(2) := ENTP1(IF PRIMARYPROC THEN 2 ELSE 1);  <<S.A. ENTRY>>    21776000
      IF SECPARMPROC THEN                                      <<00.DM>>21778000
         BEGIN                                                 <<00.DM>>21780000
         MOVE * := BUF,(4),2;                                  <<00.DM>>21782000
         MOVE * := EPARMS,(ENTPARMLEN);                        <<00.DM>>21784000
         END                                                   <<00.DM>>21786000
       ELSE                                                    <<00.DM>>21788000
         MOVE * := BUF,(4+NWPARMS);                            <<00.DM>>21790000
      RLENTRYMODIFIED _ TRUE;  <<SET MODIFIED FLAG>>                    21792000
      NRENTPTS _ NRENTPTS+1  <<BUMP NR. ENTRY POINTS>>                  21794000
      END UNTIL NOT GETFAMILY(S0);                                      21796000
                                                                        21798000
   <<* * * INSERT INFO BLOCK PREAMBLE * * *>>                           21800000
                                                                        21802000
   TFNUM1 _ RLFNUM;                                                     21804000
   TOS _ SAINFO&DLSL(9);                                                21806000
   TDISP1 _ TOS&LSR(9);                                                 21808000
   TRECD1 _ TOS;                                                        21810000
   IF TRECD1 < FEOF(RLFNUM) THEN  <<PRIME BUFFER?>>                     21812000
      FREADDIR'(RLFNUM,TBUF1,TRECD1);                                   21814000
   TOS _ NWINFO;                                                        21816000
   TOS _ ENTNWCODE;                                                     21818000
   TOS _ NRENTPTS;                                                      21820000
   IF = THEN  <<NO ENTRY POINTS?>>                                      21822000
      BEGIN                                                             21824000
      ERROR(28);                                                        21826000
      GO ABORT2                                                         21828000
      END;                                                              21830000
   COREBUF1(S2,3);                                                      21832000
                                                                        21834000
   <<* * * INSERT CODE MODULE * * *>>                                   21836000
                                                                        21838000
   MASTERBUF(RLFNUM,USLFNUM,TBUF1,TRECD1,TDISP1,TRUE,USLSAI+ENTCODEADR, 21840000
      BUF,ENTNWCODE);                                                   21842000
                                                                        21844000
   <<* * * INSERT HEADERS * * *>>                                       21846000
                                                                        21848000
   MOVE BUF(2) _ ETPDB,(4);  <<GLOBAL REQUIREMENTS>>                    21850000
   COREBUF1(BUF,6);  <<INSERT DUMMY EXTN LINK AND DB INFO>>             21852000
   WHILE GETNEXTHEADER(FALSE,-1) DO                                     21854000
      BEGIN                                                             21856000
      IF HEADTYPE = 1 THEN  <<PCAL?>>                                   21858000
         BEGIN                                                          21860000
         BUF _ HEADP+%(2)10000000;  <<ADJ. HEADER LENGTH>>              21862000
         COREBUF1(BUF,5);                                               21864000
         HEADP(2).(0:1) _ 0;  <<CLEAR SATISFIED BIT>>                   21866000
         COREBUF1(HEADP(1),HEADNW-1)                                    21868000
         END                                                            21870000
      ELSE COREBUF1(HEADP,HEADNW);                                      21872000
      END;                                                              21874000
   TBUF1(TDISP1) _ -1;  <<LIST TERMINATOR>>                             21876000
   FWRITEDIR'(RLFNUM,TBUF1,TRECD1);  <<EMPTY BUFFER>>                   21878000
                                                                        21880000
   <<* * * UPDATE PROCEDURE TABLE * * *>>                               21882000
                                                                        21884000
   IF RLPROCTABLEN-NRPROCSADDED&LSL(2)-NRPROCSDELETED&LSL(2) < 4 THEN   21886000
      FIXUPRL;  <<BIND PROCEDURES>>                                     21888000
   NRPROCSADDED _ NRPROCSADDED+1;                                       21890000
   TOS _ @RLPROCTAB+RLPROCTABLEN-NRPROCSADDED&LSL(2);                   21892000
   DPS0 _ SAINFO;                                                       21894000
   TOS _ TOS+2;                                                         21896000
   TOS _ NWINFO;                                                        21898000
   TOS _ ENTNWCODE;                                                     21900000
   DPS2 _ TOS;                                                          21902000
   GO GETOUT;                                                           21904000
                                                                        21906000
   ABORT1:                                                              21908000
   SETUPRLBUF;                                                          21910000
   WHILE GETNEXTRLENTRY DO IF RLINFO = SAINFO THEN DELETERLENTRY;       21912000
                                                                        21914000
   ABORT2:                                                              21916000
   RETURNRLSPACE(SAINFO,NWINFO);                                        21918000
                                                                        21920000
   GETOUT:                                                              21922000
   RLREC0MOD _ TRUE  <<SET MODIFIED FLAG>>                              21924000
   END;                                                                 21926000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - REMOVERL"             <<00207>>21928000
$ CONTROL SEGMENT = SEG40                                               21930000
PROCEDURE REMOVERL;                                                     21932000
   <<DELETES THE CURRENT ENTRY POINT OR PROCEDURE FROM THE CURRENT RL>> 21934000
   BEGIN                                                                21936000
   INTEGER RECD;                                                        21938000
   INTEGER DISP;                                                        21940000
   DOUBLE KLUDGE = RECD;                                                21942000
   TOS _ DELETEDPROC(RLINFO);                                           21944000
   ASSEMBLE(TEST);                                                      21946000
   IF = THEN  <<CREATE NEW ENTRY?>>                                     21948000
      BEGIN                                                             21950000
      IF RLPROCTABLEN-NRPROCSADDED&LSL(2)-NRPROCSDELETED&LSL(2) < 4 THEN21952000
         BEGIN                                                 <<00.DM>>21954000
         FIXUPRL;  <<BIND PROCEDURES>>                                  21956000
         <<POINT TO CORRECT ENTRY AGAIN AFTER FIXUP!>>         <<00.DM>>21958000
         IF NOT SEARCHRL(NAME) THEN RETURN;                    <<00.DM>>21960000
         END;                                                  <<00.DM>>21962000
      TOS _ @RLPROCTAB+NRPROCSDELETED&LSL(2);  <<ENTRY POINTER>>        21964000
      NRPROCSDELETED _ NRPROCSDELETED+1;                                21966000
      DPS0 _ RLINFO  <<INSERT S.A. INFO BLOCK>>                         21968000
      END;                                                              21970000
   TOS _ TOS+2;  <<BUMP TABLE POINTER>>                                 21972000
   TOS _ RLINFO&DLSL(9);                                                21974000
   TOS _ TOS&LSR(9);                                                    21976000
   KLUDGE _ TOS;                                                        21978000
   FREADMR''(RLFNUM,BUF,P256,RECD);                                     21980000
   TOS _ @BUF(DISP);  <<POINTER TO INFO BLOCK PREAMBLE>>                21982000
   DPS1 _ DPS0;  <<NR. WORDS INFO AND NR. WORDS CODE>>                  21984000
   TOS _ TOS+2;  <<BUMP INFO POINTER>>                                  21986000
   PS0 _ PS0-1;  <<DEC. NR. ENTRY POINTS>>                              21988000
   IF <> THEN  <<LAST ENTRY POINT?>>                                    21990000
      IF CLASS = ENTRYCLASS THEN                                        21992000
         BEGIN                                                          21994000
         PS1 _ 0;  <<CLEAR NR. WORDS INFO>>                             21996000
         FWRITEMR''(RLFNUM,BUF,P256,RECD)  <<SAVE NEW INFO PREAMBLE>>   21998000
         END                                                            22000000
      ELSE CLEANUPRLDIR _ TRUE;  <<SET DIRECTORY FLAG>>                 22002000
   DELETERLENTRY;  <<DELETE ENTRY POINT>>                               22004000
   RLREC0MOD _ TRUE  <<SET MODIFIED FLAG>>                              22006000
   END;                                                                 22008000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - FIXUPRL"              <<00207>>22010000
$ CONTROL SEGMENT = SEG40                                               22012000
PROCEDURE FIXUPRL;                                                      22014000
   <<COMPLETES ANY REMAINING LINKAGE OR PROCEDURE BINDING IN THE        22016000
     CURRENT RL FILE>>                                                  22018000
   BEGIN                                                                22020000
   ARRAY PARMS(0:4)=Q;                                         <<00595>>22022000
   INTEGER POINTER BADPROCS;        <<BAD PROCEDURE TABLE>>    <<00595>>22024000
   DOUBLE  POINTER DBADPROCS = BADPROCS;                       <<00595>>22026000
   INTEGER NRBADPROCS := 0;   <<NR. BAD PROCEDURES>>           <<00595>>22028000
   DOUBLE PREVEXTNADR := 0D;  <<PREV. EXTN. SET ADR.>>         <<00595>>22030000
   DOUBLE EXTNADR := 0D;  <<CURRENT EXTN. SET ADR.>>           <<00595>>22032000
   DOUBLE NEXTEXTNADR := 0D;  <<NEXT EXTN. SET ADR.>>          <<00595>>22034000
   DOUBLE SAVEADR := 0D;                                       <<00595>>22036000
                                                                        22038000
   LOGICAL SUBROUTINE BADLOGGED;                               <<00.DM>>22040000
      << CHECKS TO SEE IF BAD PROCEDURE HAS BEEN >>            <<00.DM>>22042000
      << LOGGED ALREADY                          >>            <<00.DM>>22044000
      BEGIN                                                    <<00.DM>>22046000
      XREG := NRBADPROCS&LSL(1);                               <<00.DM>>22048000
      WHILE XREG > 0 DO                                        <<00.DM>>22050000
         BEGIN                                                 <<00.DM>>22052000
         XREG := XREG-2;                                       <<00.DM>>22054000
         IF DBADPROCS(XREG) = RLINFO THEN                      <<00.DM>>22056000
            BEGIN                                              <<00.DM>>22058000
            BADLOGGED := TRUE;                                 <<00.DM>>22060000
            RETURN;                                            <<00.DM>>22062000
            END;                                               <<00.DM>>22064000
         END;                                                  <<00.DM>>22066000
      END;                                                     <<00.DM>>22068000
                                                                        22070000
   DOUBLE SUBROUTINE NEWINFO;                                           22072000
      <<SEARCHES THE ADDED PROCEDURE TABLE TO DETERMINE IF A NEW        22074000
        EXTERNAL SET SHOULD BE THE SUCCESSOR OF THE CURRENT ONE.  IF SO 22076000
        RETURNS THE ADDRESS OF THE EXTERNAL SET; OTHERWISE RETURNS 0D>> 22078000
      BEGIN                                                             22080000
      NEWINFO _ BIGD;  <<INIT. RESULT>>                                 22082000
      TOS _ NRPROCSADDED;  <<ENTRY COUNTER>>                            22084000
      IF = THEN GO DEL1;  <<NO PROC'S ADDED?>>                          22086000
      TOS _ @RLPROCTAB+RLPROCTABLEN-NRPROCSADDED&LSL(2);                22088000
      DO BEGIN                                                          22090000
         TOS _ DPS0+DOUBLE(LOGICAL(PS0(3)+3));  <<S.A. EXTN. SET>>      22092000
         IF EXTNADR < DS1 AND DS1 < NEXTEXTNADR AND DS1 < DS6 THEN      22094000
           DS6 _ DS1;                                                   22096000
         DDEL;                                                          22098000
         TOS _ TOS+4;  <<BUMP ENTRY POINTER>>                           22100000
         ASSEMBLE(DECB)                                                 22102000
         END UNTIL =;                                                   22104000
      DEL2: DEL;                                                        22106000
      DEL1: DEL;                                                        22108000
      IF DS2 = BIGD THEN NEWINFO _ 0D  <<CHECK RESULT>>                 22110000
      END;                                                              22112000
                                                                        22114000
   SUBROUTINE SUCCESSOR;                                                22116000
      <<INITIALIZES THE SUCCESSOR LINK IN THE CURRENT EXTERNAL SET IF   22118000
        IT IS A NEW EXTERNAL SET AND DETERMINES THE TRUE SUCCESSOR OF   22120000
        THE CURRENT EXTERNAL SET>>                                      22122000
      BEGIN                                                             22124000
      TOS _ SAVEADR;                                                    22126000
      IF <> THEN  <<INIT. SUCCESSOR LINK>>                              22128000
         BEGIN                                                          22130000
         RLXLINK _ DS1;  <<INSERT LINK>>                                22132000
         RLEXTNMOD _ TRUE;  <<SET MODIFIED FLAG>>                       22134000
         NEXTEXTNADR _ TOS;  <<CORRECT NEXT ADR.>>                      22136000
         TOS _ 0D                                                       22138000
         END;                                                           22140000
      SAVEADR _ TOS;  <<CLEAR FLAG ADR.>>                               22142000
      TOS _ NEWINFO;                                                    22144000
      ASSEMBLE(DDUP,DTST);                                              22146000
      IF <> THEN  <<NEW SUCCESSOR?>>                                    22148000
         BEGIN                                                          22150000
         SAVEADR _ NEXTEXTNADR;  <<SAVE SUCCESSOR ADR.>>                22152000
         IF EXTNADR = 0D THEN                                           22154000
            RLSAXL _ TOS  <<UPDATE S.A. OF EXTERNAL LIST>>              22156000
         ELSE                                                           22158000
            BEGIN                                                       22160000
            RLXLINK _ TOS;  <<UPDATE SUCCESSOR LINK>>                   22162000
            RLEXTNMOD _ TRUE  <<SET MODIFIED FLAG>>                     22164000
            END;                                                        22166000
         NEXTEXTNADR _ TOS  <<CORRECT NEXT ADR.>>                       22168000
         END                                                            22170000
      ELSE ASSEMBLE(DDEL,DDEL)                                          22172000
      END;                                                              22174000
                                                                        22176000
   LOGICAL SUBROUTINE OLDINFO;                                          22178000
      <<SEARCHES THE DELETED PROCEDURE TABLE TO DETERMINE IF THE CURRENT22180000
        EXTERNAL SET SHOULD BE DELETED.  IF SO, RETURNS THE VALUE TRUE; 22182000
        OTHERWISE RETURNS THE VALUE FALSE>>                             22184000
      BEGIN                                                             22186000
      TOS _ NRPROCSDELETED;  <<ENTRY COUNTER>>                          22188000
      IF = THEN  <<NO PROC'S DELETED?>>                                 22190000
         BEGIN                                                          22192000
         DEL;                                                           22194000
         RETURN                                                         22196000
         END;                                                           22198000
      TOS _ @RLPROCTAB;  <<ENTRY POINTER>>                              22200000
      DO BEGIN                                                          22202000
         IF EXTNADR = DPS0+DOUBLE(LOGICAL(PS0(3)+3)) AND                22204000
            PS0(2) <> 0 THEN                                            22206000
            BEGIN                                                       22208000
            ASSEMBLE(DDEL,INCB);                                        22210000
            RETURN                                                      22212000
            END;                                                        22214000
         TOS _ TOS+4;  <<BUMP ENTRY POINTER>>                           22216000
         ASSEMBLE(DECB)                                                 22218000
         END UNTIL =;                                                   22220000
      DDEL                                                              22222000
      END;                                                              22224000
                                                                        22226000
   SUBROUTINE UNLINK;                                                   22228000
      <<UNLINKS THE CURRENT EXTERNAL SET FROM THE EXTERNAL SET LIST>>   22230000
      BEGIN                                                             22232000
      IF PREVEXTNADR = 0D THEN                                          22234000
         RLSAXL _ NEXTEXTNADR  <<NEW S.A. OF EXTERNAL LIST>>            22236000
      ELSE                                                              22238000
         BEGIN                                                          22240000
         TOS _ PREVEXTNADR&DLSL(9);  <<REC. NR.>>                       22242000
         TOS _ TOS&LSR(9);  <<REC. DISP.>>                              22244000
         IF S1 >= RLEXTNRECD THEN  <<IN BUFFER?>>                       22246000
            BEGIN                                                       22248000
            TOS _ @RLEXTNBUF+(S1-RLEXTNRECD)&LSL(7)+S0;                 22250000
            DPS0 _ NEXTEXTNADR;  <<INSERT NEW LINK>>                    22252000
            RLEXTNMOD _ TRUE  <<SET MODIFIED FLAG>>                     22254000
            END                                                         22256000
         ELSE  <<ON DISC>>                                              22258000
            BEGIN                                                       22260000
            FREADMR''(RLFNUM,BUF,P256,S1);                              22262000
            TOS _ @BUF+S0;                                              22264000
            DPS0 _ NEXTEXTNADR;  <<INSERT NEW LINK>>                    22266000
            FWRITEMR''(RLFNUM,BUF,P256,S2)                              22268000
            END;                                                        22270000
         ASSEMBLE(DEL,DDEL)                                             22272000
         END;                                                           22274000
      EXTNADR _ PREVEXTNADR  <<PREVENT CHANGE OF PREV. ADR.>>           22276000
      END;                                                              22278000
                                                                        22280000
   SUBROUTINE BINDPROCS;                                                22282000
      <<BINDS (IF NECESSARY) THE EXTERNALS IN THE CURRENT EXTERNAL SET>>22284000
      BEGIN                                                             22286000
      WHILE GETNEXTRLEXTN DO                                            22288000
         BEGIN                                                          22290000
                                                                        22292000
         <<* * * UNBIND EXTERNAL * * *>>                                22294000
                                                                        22296000
         IF NRPROCSDELETED <> 0 AND RLXSATISFIED AND                    22298000
            DELETEDPROC(RLXINFO) <> 0 THEN                              22300000
            BEGIN                                                       22302000
            RLXSATISFIEDBIT _ 0;  <<SET TO "UNSATISFIED">>              22304000
            RLEXTNMOD _ TRUE  <<SET MODIFIED FLAG>>                     22306000
            END;                                                        22308000
         IF NRPROCSADDED <> 0 AND NOT RLXSATISFIED AND                  22310000
            SEARCHRL(RLXNAME) THEN                                      22312000
            BEGIN                                              <<00595>>22314000
            PARMCHECK(RLPARMS,RLXPARMS,PARMS);                 <<00595>>22316000
            IF PARMS = 0 THEN  <<ERROR?>>                      <<00595>>22318000
               BEGIN                                                    22320000
               RLXNAME.(0:3) _ 4 CAT RLNAME (14:1:2);                   22322000
               RLXCODE _ RLCODE;                                        22324000
               RLXINFO _ RLINFO;                                        22326000
               RLXSA _ RLSA;                                            22328000
               RLEXTNMOD _ TRUE  <<SET MODIFIED FLAG>>                  22330000
               END                                                      22332000
            ELSE                                                        22334000
               BEGIN                                                    22336000
               TOS := @BADPROCS+NRBADPROCS&LSL(2);             <<00.DM>>22338000
               TOS := ADDEDPROC(RLINFO);                       <<00.DM>>22340000
               TOS := 4;                                       <<00.DM>>22342000
               IF S1 <> 0 THEN                                 <<00.DM>>22344000
                  BEGIN    << BAD ACTUAL PARAMETERS >>         <<00.DM>>22346000
                  IF NOT BADLOGGED THEN                        <<00.DM>>22348000
                     BEGIN                                     <<00.DM>>22350000
                     ASSEMBLE( MOVE 0 );                       <<00.DM>>22352000
                     NRBADPROCS := NRBADPROCS+1;               <<00.DM>>22354000
                     END;                                      <<00.DM>>22356000
                  CASE PARMS OF                                <<00595>>22358000
                     BEGIN                                     <<00595>>22360000
                     ;                                         <<00595>>22362000
                     ERRORS2( 49, RLXNAME, RLNAME);            <<00595>>22364000
                     ERRORS2( 50, RLXNAME, RLNAME);            <<00595>>22366000
                     BEGIN                                     <<00595>>22368000
                        ERRORS2( 45, RLXNAME, RLNAME);         <<00595>>22370000
                        PRINTBITMAP( PARMS(1));                <<00595>>22372000
                     END;                                      <<00595>>22374000
                     END;                                      <<00595>>22376000
                  END                                          <<00.DM>>22378000
               ELSE                                            <<00.DM>>22380000
                  BEGIN     << BAD FORMAL PARAMETERS >>        <<00.DM>>22382000
                  SETUPRLBUF;                                  <<00.DM>>22384000
                  WHILE GETNEXTRLENTRY DO                      <<00.DM>>22386000
                     IF EXTNADR = RLINFO+DOUBLE(RLNWC)+3D THEN <<04755>>22388000
                        BEGIN                                  <<00.DM>>22390000
                        IF NOT BADLOGGED THEN                  <<00.DM>>22392000
                           BEGIN                               <<00.DM>>22394000
                           S1 := ADDEDPROC(RLINFO);            <<00.DM>>22396000
                           IF S1 <> 0 THEN                     <<00.DM>>22398000
                              BEGIN                            <<00.DM>>22400000
                              ASSEMBLE( MOVE 0 );              <<00.DM>>22402000
                              NRBADPROCS := NRBADPROCS+1;      <<00.DM>>22404000
                              END;                             <<00.DM>>22406000
                           END;                                <<00.DM>>22408000
                        CASE PARMS OF                          <<00595>>22410000
                           BEGIN                               <<00595>>22412000
                           ;                                   <<00595>>22414000
                           ERRORS2(49,RLXNAME,RLNAME);         <<00595>>22416000
                           ERRORS2(50,RLXNAME,RLNAME);         <<00595>>22418000
                           BEGIN                               <<00595>>22420000
                              ERRORS2(45,RLXNAME,RLNAME);      <<00595>>22422000
                              PRINTBITMAP(PARMS(1));           <<00595>>22424000
                           END;                                <<00595>>22426000
                           END;                                <<00595>>22428000
                        END;                                   <<00.DM>>22430000
                  END;                                         <<00.DM>>22432000
                  DDEL; DEL;  << DEL MOVE PARMS >>             <<00.DM>>22434000
               END                                                      22436000
            END                                                         22438000
         END                                                            22440000
      END;                                                              22442000
                                                                        22444000
   TOS _ NRPROCSADDED; TOS _ NRPROCSDELETED;                            22446000
   ASSEMBLE(OR,DEL);                                                    22448000
   IF = THEN GO GETOUT;  <<NOTHING CHANGED?>>                  <<00289>>22450000
   CLEANUPRLBUF;  <<SAVE MODIFIED ENTRIES NOW!>>                        22452000
                                                                        22454000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           22456000
                                                                        22458000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  22464000
                                                                        22466000
   MAKEROOMINDL(NRPROCSADDED&LSL(2)+RLDLBUFS2);                <<00.DM>>22468000
   IF < THEN TERMINATE;  <<NO ROOM?>>                                   22470000
   @BADPROCS _ @DLAVAIL;                                                22472000
   @RLEXTNBUF _ @BADPROCS+NRPROCSADDED&LSL(2);                 <<00.DM>>22474000
   NRRLEXTNRECDS _ (@DLAREA1-@RLEXTNBUF)&LSR(7);                        22476000
   RLEXTNRECD _ -255; RLEXTNMOD _ FALSE;                                22478000
                                                                        22480000
   <<* * * RETURN DELETED STORAGE * * *>>                               22482000
                                                                        22484000
   IF NRPROCSDELETED <> 0 THEN  <<PROC'S DELETED?>>                     22486000
      BEGIN                                                             22488000
                                                                        22490000
      <<* * * DELETE REMAINING ENTRY POINTS * * *>>                     22492000
                                                                        22494000
      IF CLEANUPRLDIR THEN                                              22496000
         BEGIN                                                          22498000
         CLEANUPRLDIR := FALSE;                                <<00.DM>>22500000
         SETUPRLBUF;                                                    22502000
         WHILE GETNEXTRLENTRY DO                                        22504000
            BEGIN                                              <<00.DM>>22506000
            TOS := DELETEDPROC(RLINFO);                        <<00.DM>>22508000
            IF S0 <> 0 THEN                                    <<00.DM>>22510000
               IF PS0(2) <> 0 THEN DELETERLENTRY;              <<00.DM>>22512000
            DEL;                                               <<00.DM>>22514000
            END;                                               <<00.DM>>22516000
         END;                                                           22518000
                                                                        22520000
      <<* * * DELETE INFO BLOCKS * * *>>                                22522000
                                                                        22524000
      TOS _ NRPROCSDELETED;  <<ENTRY COUNTER>>                          22526000
      TOS _ @RLPROCTAB;  <<TABLE POINTER>>                              22528000
      DO BEGIN                                                          22530000
         TOS _ DPS0;  <<S.A. INFO BLOCK>>                               22532000
         TOS _ PS2(2);  <<NR. WORDS IN INFO BLOCK>>                     22534000
         IF <> THEN RETURNRLSPACE(*,*) ELSE ASSEMBLE(DEL,DDEL);         22536000
         TOS _ TOS+4;  <<BUMP ENTRY POINTER>>                           22538000
         ASSEMBLE(DECB)                                                 22540000
         END UNTIL =;                                                   22542000
      DDEL                                                              22544000
      END;                                                              22546000
                                                                        22548000
   <<* * * STEP THRU EXTERNAL LIST SETS * * *>>                         22550000
                                                                        22552000
   NEXTEXTNADR _ RLSAXL;  <<INIT. NEXT ADR.>>                           22554000
   SUCCESSOR;  <<DETERMINE SUCCESSOR>>                                  22556000
   WHILE NEXTEXTNADR <> BIGD DO                                         22558000
      BEGIN                                                             22560000
      SETUPRLEXTNBUF(NEXTEXTNADR);                                      22562000
      PREVEXTNADR _ EXTNADR;                                            22564000
      EXTNADR _ NEXTEXTNADR;                                            22566000
      NEXTEXTNADR _ RLXLINK;                                            22568000
      SUCCESSOR;  <<DETERMINE SUCCESSOR>>                               22570000
      IF OLDINFO THEN UNLINK ELSE BINDPROCS                             22572000
      END;                                                              22574000
                                                                        22576000
   ASSEMBLE(ZERO,ZERO);                                                 22578000
   NRPROCSADDED _ TOS;                                                  22580000
   NRPROCSDELETED _ TOS;                                                22582000
   CLEANUPRLEXTNBUF;                                                    22584000
   TOS _ NRBADPROCS;                                                    22586000
   IF <> THEN  <<BINDING ERROR?>>                                       22588000
      BEGIN                                                             22590000
      CLEANUPRLDIR := TRUE;                                    <<00.DM>>22592000
      NRPROCSDELETED _ TOS;                                             22594000
      MOVE RLPROCTAB _ BADPROCS,(NRBADPROCS&LSL(2));                    22596000
      FIXUPRL  <<DELETE AND RE-BIND>>                                   22598000
      END;                                                     <<00231>>22600000
GETOUT:                                                        <<00289>>22602000
   IF RLREC0MOD THEN <<RECORD 0 MODIFIED?>>                    <<00231>>22604000
      BEGIN                                                    <<00231>>22606000
      FWRITEDIR'(RLFNUM,RLREC0,0); <<SAVE RECORD 0>>           <<00231>>22608000
      RLREC0MOD := FALSE; <<CLEAR FLAG>>                       <<00231>>22610000
      END;                                                     <<00231>>22612000
   CLEANUPRLBUF; <<SAVE DIRECTORY RECORD>>                     <<00231>>22614000
   SAVERLMAP;    <<SAVE STORAGE MAP BUFFER>>                   <<00231>>22616000
   END;                                                                 22618000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - ADDPROC"              <<00207>>22620000
                                                                        22622000
$ CONTROL SEGMENT = SEG40                                               22624000
INTEGER PROCEDURE ADDEDPROC (INFOADR);                                  22626000
   <<SEARCHES THE MODIFIED PROCEDURE TABLE TO SEE IF THE PROCEDURE      22628000
     SPECIFIED BY THE GIVEN INFO BLOCK ADDRESS HAS BEEN MODIFIED.  IF   22630000
     SO, A POINTER TO THE ENTRY IS RETURNED; OTHERWISE A ZERO IS        22632000
     RETURNED>>                                                         22634000
   VALUE INFOADR;                                                       22636000
   DOUBLE INFOADR;                                                      22638000
   BEGIN                                                                22640000
   ENTRY DELETEDPROC;                                                   22642000
   TOS _ NRPROCSADDED;  <<ENTRY COUNTER>>                               22644000
   IF = THEN RETURN;  <<NO PROC'S ADDED?>>                              22646000
   TOS _ @RLPROCTAB+RLPROCTABLEN-NRPROCSADDED&LSL(2);  <<ENTRY POINTER>>22648000
   GO LOOP;                                                             22650000
                                                                        22652000
   DELETEDPROC:                                                         22654000
   TOS _ NRPROCSDELETED;  <<ENTRY COUNTER>>                             22656000
   IF = THEN RETURN;  <<NO PROC'S DELETED?>>                            22658000
   TOS _ @RLPROCTAB;  <<ENTRY POINTER>>                                 22660000
                                                                        22662000
   LOOP:                                                                22664000
   DO BEGIN                                                             22666000
      IF DPS0 = INFOADR THEN                                            22668000
         BEGIN                                                          22670000
         ADDEDPROC _ TOS;  <<RETURN ENTRY POINTER>>                     22672000
         RETURN                                                         22674000
         END;                                                           22676000
      TOS _ TOS+4;  <<BUMP ENTRY POINTER>>                              22678000
      ASSEMBLE(DECB)                                                    22680000
      END UNTIL =                                                       22682000
   END;                                                                 22684000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - SETUPRLEXTNBUF"       <<00207>>22686000
$ CONTROL SEGMENT = SEG40                                               22688000
PROCEDURE SETUPRLEXTNBUF (EXTNADR);                                     22690000
   <<SETS UP THE BUFFER AND PARAMETERS FOR STEPPING THRU THE EXTERNAL   22692000
     ENTRIES IN THE HEADER SET BEGINNING AT THE SPECIFIED FILE ADDRESS>>22694000
   VALUE EXTNADR;                                                       22696000
   DOUBLE EXTNADR;                                                      22698000
   BEGIN                                                                22700000
   INTEGER RECD = Q+1;                                                  22702000
   INTEGER DISP = Q+2;                                                  22704000
   TOS _ EXTNADR&DLSL(9);                                               22706000
   TOS _ TOS&LSR(9);                                                    22708000
   IF RECD < RLEXTNRECD+NRRLEXTNRECDS-1 THEN  <<SET IN BUFFER?>>        22710000
      TOS _ (RECD-RLEXTNRECD)&LSL(7)                                    22712000
   ELSE  <<SET ON DISC>>                                                22714000
      BEGIN                                                             22716000
      CLEANUPRLEXTNBUF;                                                 22718000
      RLEXTNRECD _ RECD;                                                22720000
      FREADMR''(RLFNUM,RLEXTNBUF,NRRLEXTNRECDS&LSL(7),RLEXTNRECD);      22722000
      TOS _ 0                                                           22724000
      END;                                                              22726000
   @RLXP _ TOS+@RLEXTNBUF+DISP;  <<SET POINTER TO EXTERNAL LINK>>       22728000
   RLHEADADR _ EXTNADR;  <<HEADER SET ADDRESS>>                         22730000
   RLHEADNW _ 6  <<PHONEY HEADER LENGTH>>                               22732000
   END;                                                                 22734000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - GETNEXTRLEXTN"        <<00207>>22736000
$ CONTROL SEGMENT = SEG40                                               22738000
LOGICAL PROCEDURE GETNEXTRLEXTN;                                        22740000
   <<GETS THE NEXT EXTERNAL ENTRY IN THE CURRENT HEADER SET LIST>>      22742000
   BEGIN                                                                22744000
   DO BEGIN                                                             22746000
      SETUPRLEXTNBUF(RLHEADADR+DOUBLE(LOGICAL(RLHEADNW)));              22748000
      IF RLXP = -1 THEN RETURN;  <<LAST HEADER?>>                       22750000
      RLHEADNW _ RLXP.(1:10);  <<NR. WORDS IN HEADER>>                  22752000
      END UNTIL RLXP.(11:5) = 1;                                        22754000
   @RLXP _ @RLXP+6;  <<SET POINTER TO NAME>>                            22756000
   @RLXP1 _ @RLXP+RLXP.(4:3)+1;  <<WORD FOLLOWING NAME>>                22758000
   GETNEXTRLEXTN _ TRUE                                                 22760000
   END;                                                                 22762000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - CLEANUPRLEXTNBUF"     <<00207>>22764000
$ CONTROL SEGMENT = SEG40                                               22766000
PROCEDURE CLEANUPRLEXTNBUF;                                             22768000
   <<SAVES THE EXTERNAL BUFFER IF THE CONTENTS HAVE BEEN MODIFIED>>     22770000
   BEGIN                                                                22772000
   IF RLEXTNMOD THEN  <<BUFFER MODIFIED?>>                              22774000
      BEGIN                                                             22776000
      FWRITEMR''(RLFNUM,RLEXTNBUF,NRRLEXTNRECDS&LSL(7),RLEXTNRECD);     22778000
      RLEXTNMOD _ FALSE  <<CLEAR MODIFIED FLAG>>                        22780000
      END                                                               22782000
   END;                                                                 22784000
$PAGE "RL FILE MAINTAINENCE PROCEDURES - LISTRL'"              <<00207>>22786000
$ CONTROL SEGMENT = SEG40                                               22788000
PROCEDURE LISTRL';                                                      22790000
   <<LISTS THE CONTENTS OF THE CURRENT RL FILE>>                        22792000
   BEGIN                                                                22794000
   BYTE ARRAY B0 (0:7)=PB _ "RL FILE ";                                 22796000
   BYTE ARRAY B1 (0:49)=PB _                                   <<00.DM>>22798000
      "ENTRY POINTS  CHECK ADR      LOC   NUM  CODE  INFO";    <<00.DM>>22800000
   BYTE ARRAY B2 (0:31)=PB _                                   <<00.DM>>22802000
      "EXTERNALS     CHECK ADR      LOC";                      <<00.DM>>22804000
   BYTE ARRAY B3 (0:3)=PB _ "USED";                                     22806000
   BYTE ARRAY B4 (0:8)=PB _ "AVAILABLE";                                22808000
   FIXUPRL;  <<COMPLETE ANY BINDING>>                                   22810000
                                                                        22812000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  22814000
                                                                        22816000
   MAKEROOMINDL(RLDLBUFS2);                                             22818000
   IF < THEN RETURN;  <<NO ROOM?>>                                      22820000
   @RLEXTNBUF _ @DLAVAIL;                                               22822000
   NRRLEXTNRECDS _ (@DLAREA1-@DLAVAIL)&LSR(7);                          22824000
   RLEXTNRECD _ -255; RLEXTNMOD _ FALSE;                                22826000
   FCONTROL(INFNUM,ENABLE'CTLY,I);                             <<00.DM>>22828000
   CTLY := FALSE;                                              <<00.DM>>22830000
                                                                        22832000
   BLANKLINE;                                                           22834000
   TOS _ RLFNUM;                                                        22836000
   MOVE BLINE _ B0,(8),2;  <<"RL FILE">>                                22838000
   FGETINFO(*,*);  <<INSERT RL FILE NAME>>                              22840000
   PRINTLINE;                                                           22842000
                                                                        22844000
   <<* * * LIST ENTRY POINTS * * *>>                                    22846000
                                                                        22848000
   BLANKLINE;                                                           22850000
   MOVE BLINE _ B1,(50);  <<"ENTRY POINTS">>                   <<00.DM>>22852000
   PRINTLINE;                                                           22854000
   BLANKLINE;                                                           22856000
   SETUPRLBUF;                                                          22858000
   WHILE GETNEXTRLENTRY DO                                              22860000
      BEGIN                                                             22862000
      IF CTLY THEN RETURN;     <<CHECK FOR CONTROL Y>>         <<00.DM>>22864000
      TOS _ @BLINE; TOS _ @RLNAME&LSL(1)+1;                             22866000
      MOVE * _ *,(RLNC);  <<ENTRY NAME>>                                22868000
      NTOA(RLPARMS.(0:2),8,BLINE(16));  <<PARM. CHECKING LEVEL>>        22870000
      NTOA(RLSA,8,BLINE(22));  <<S.A. OF ENTRY POINT>>                  22872000
      DNTOA(RLINFO,8,BLINE(31));  <<S.A. OF INFO BLOCK>>                22874000
      IF RLPRIMARY THEN  <<PRIMARY ENTRY POINT?>>                       22876000
         BEGIN                                                          22878000
         TOS _ RLINFO&DLSL(9);  <<REC. NR.>>                            22880000
         TOS _ TOS&LSR(9)+@BUF;  <<INFO DISP>>                          22882000
         FREADMR''(RLFNUM,BUF,P256,S1);  <<LOAD INFO PREAMBLE>>         22884000
         NTOA(PS0(2),8,BLINE(37));  <<NR. ENTRY POINTS>>                22886000
         NTOA(PS0(1),8,BLINE(43));  <<CODE MODULE LENGTH>>              22888000
         NTOA(PS0,8,BLINE(49));  <<INFO BLOCK LENGTH>>                  22890000
         DDEL                                                           22892000
         END;                                                           22894000
      PRINTLINE                                                         22896000
      END;                                                              22898000
                                                                        22900000
   <<* * * LIST EXTERNALS * * *>>                                       22902000
                                                                        22904000
   BLANKLINE;                                                           22906000
   MOVE BLINE _ B2,(32); <<"EXTERNALS     CHECK ADR      LOC">><<00.DM>>22908000
   PRINTLINE;                                                           22910000
   BLANKLINE;                                                           22912000
   TOS _ RLSAXL;  <<S.A. OF EXTERNAL LIST SET>>                         22914000
   WHILE DS1 <> BIGD DO                                                 22916000
      BEGIN                                                             22918000
      SETUPRLEXTNBUF(*);                                                22920000
      TOS _ RLXLINK;  <<NEXT EXTERNAL LINK>>                            22922000
      WHILE GETNEXTRLEXTN DO                                            22924000
         BEGIN                                                          22926000
         IF CTLY THEN RETURN;    <<CHECK FOR CONTROL Y>>       <<00.DM>>22928000
         TOS _ @BLINE; TOS _ @RLXNAME&LSL(1)+1;                         22930000
         MOVE * _ *,(RLXNC);  <<EXTERNAL NAME>>                         22932000
         NTOA(RLXPARMS.(0:2),8,BLINE(16));  <<PARM. CHECKING LEVEL>>    22934000
         IF RLXSATISFIED THEN  <<EXTERNAL SATISFIED?>>                  22936000
            BEGIN                                                       22938000
            NTOA(RLXSA,8,BLINE(22));  <<S.A. OF ENTRY POINT>>           22940000
            DNTOA(RLXINFO,8,BLINE(31))  <<S.A. OF INFO BLOCK>>          22942000
            END;                                                        22944000
         PRINTLINE                                                      22946000
         END                                                            22948000
      END;                                                              22950000
                                                                        22952000
   <<* * * LIST FILE PARAMETERS * * *>>                                 22954000
                                                                        22956000
   BLANKLINE;                                                           22958000
   TOS _ 0D;  <<BLOCKS FREE>>                                           22960000
   TOS _ RLNS-1;  <<SECTION COUNTER>>                                   22962000
   DO BEGIN                                                             22964000
      GETRLMAP(S0);  <<LOAD SECTION MAP>>                               22966000
      TOS _ 2047;  <<BLOCK COUNTER>>                                    22968000
      DO BEGIN                                                          22970000
         IF TESTBIT(RLMAP,S0) THEN DS3 _ DS3+1D;                        22972000
         TOS _ TOS-1                                                    22974000
         END UNTIL <;                                                   22976000
      ASSEMBLE(DEL,DECA)                                                22978000
      END UNTIL <;                                                      22980000
   DEL;                                                                 22982000
   TOS _ TOS&DLSL(5);  <<WORDS FREE>>                                   22984000
   MOVE BLINE _ B3,(4);                                                 22986000
   DNTOA(DOUBLE(LOGICAL(RLFL))&DLSL(7)-DS1,8,BLINE(24));                22988000
   MOVE BLINE(35) _ B4,(9); DNTOA(*,8,BLINE(59));                       22990000
   PRINTLINE;                                                           22992000
   EJECTPAGE;                                                  <<00.DM>>22994000
   FCONTROL(INFNUM,DISABLE'CTLY,I);                            <<00.DM>>22996000
   END;                                                                 22998000
$PAGE "MISC.PROCEDURE - GETSYSFPMAP"                                    23000000
$CONTROL SEGMENT=SEG1                                                   23002000
PROCEDURE GETSYSFPMAP(SYSFPMAP);                               <<04584>>23004000
INTEGER SYSFPMAP;                                              <<04584>>23006000
                                                               <<04584>>23008000
BEGIN                                                          <<04584>>23010000
   EQUATE SYSDB        = %1000,                                <<04584>>23012000
          SYSFPMAPOFFSET  = %102,                              <<04584>>23014000
          SYSGLOBEXTPTOFFSET = %377;                           <<04584>>23016000
   DEFINE SYSGLOBEXTPT=ABSOLUTE(SYSDB+SYSGLOBEXTPTOFFSET)#;    <<04584>>23018000
   ENTRY UPDATESYSFPMAP;                                       <<04584>>23020000
                                                               <<04584>>23022000
   GETPRIVMODE;                                                <<04584>>23024000
   SYSFPMAP := ABSOLUTE(SYSDB+SYSGLOBEXTPT+SYSFPMAPOFFSET);    <<04584>>23026000
   SYSFPMAP :=SYSFPMAP.(14:2);                                 <<04584>>23028000
   GETUSERMODE;                                                <<04584>>23030000
   RETURN;                                                     <<04584>>23032000
UPDATESYSFPMAP:                                                <<04584>>23034000
   GETPRIVMODE;                                                <<04584>>23036000
   ABSOLUTE(SYSDB+SYSGLOBEXTPT+SYSFPMAPOFFSET) := SYSFPMAP;    <<04584>>23038000
   GETUSERMODE;                                                <<04584>>23040000
END;                                                           <<04584>>23042000
$PAGE "MISC. PROCEDURE - GETJSFPMAP"                                    23044000
PROCEDURE GETJSFPMAP(JSFPMAP);                                 <<04584>>23046000
INTEGER JSFPMAP;                                               <<04584>>23048000
                                                               <<04584>>23050000
BEGIN                                                          <<04584>>23052000
                                                               <<04584>>23054000
   EQUATE JSFPMAPOFFSET = 6;                                   <<04584>>23056000
   INTEGER JITDST;                                             <<04584>>23058000
   INTEGER POINTER PXGLOB;                                     <<04584>>23060000
   LOGICAL UPDATEFLAG;                                         <<04584>>23062000
   ENTRY UPDATEJSFPMAP;                                        <<04584>>23064000
                                                               <<04584>>23066000
   UPDATEFLAG:=FALSE;                                          <<04584>>23068000
   GO TO START;                                                <<04584>>23070000
UPDATEJSFPMAP:                                                 <<04584>>23072000
   UPDATEFLAG:=TRUE;                                           <<04584>>23074000
START:                                                         <<04584>>23076000
   GETPRIVMODE;                                                <<04584>>23078000
   PUSH (DL);                                                  <<04584>>23080000
   @PXGLOB := TOS - PS0(-1);                                   <<04584>>23082000
   JITDST := PXGLOB(6).(6:10);                                 <<04584>>23084000
                                                               <<04584>>23086000
   IF UPDATEFLAG THEN GO TO UPDATE;                            <<04584>>23088000
                                                               <<04584>>23090000
   TOS:=@JSFPMAP;                                              <<04584>>23092000
   TOS:=JITDST;                                                <<04584>>23094000
   TOS:=JSFPMAPOFFSET;                                         <<04584>>23096000
   TOS:=1;                                                     <<04584>>23098000
   ASSEMBLE(MFDS 0);                                           <<04584>>23100000
                                                               <<04584>>23102000
   IF JSFPMAP.(14:1) = 0 THEN <<JSFPMAP ISN'T INIT'ED>>        <<04584>>23104000
      BEGIN                                                    <<04584>>23106000
         GETUSERMODE;                                          <<04584>>23108000
         GETSYSFPMAP(SYSFPMAP); GETPRIVMODE;                   <<04584>>23110000
         JSFPMAP.(15:1) := SYSFPMAP.(15:1);                    <<04584>>23112000
         JSFPMAP.(14:1) := 1;                                  <<04584>>23114000
UPDATE:                                                        <<04584>>23116000
         TOS:=JITDST;                                          <<04584>>23118000
         TOS:=JSFPMAPOFFSET;                                   <<04584>>23120000
         TOS:=@JSFPMAP;                                        <<04584>>23122000
         TOS:=1;                                               <<04584>>23124000
         ASSEMBLE(MTDS 0);                                     <<04584>>23126000
      END;                                                     <<04584>>23128000
   GETUSERMODE;                                                <<04584>>23130000
END;                                                           <<04584>>23132000
$PAGE "MISC. PROCEDURE - SHOWALL"                                       23134000
PROCEDURE SHOWALL;                                             <<04584>>23136000
                                                               <<04584>>23138000
BEGIN                                                          <<04584>>23140000
                                                               <<04584>>23142000
SUBROUTINE PRINTNAME(FNUM);                                    <<04584>>23144000
VALUE FNUM;                                                    <<04584>>23146000
INTEGER FNUM;                                                  <<04584>>23148000
                                                               <<04584>>23150000
BEGIN                                                          <<04584>>23152000
                                                               <<04584>>23154000
   IF FNUM <> 0 THEN                                           <<04584>>23156000
      BEGIN                                                    <<04584>>23158000
         TOS := FNUM;                                          <<04584>>23160000
         TOS := @BLINE(18);                                    <<04584>>23162000
         FGETINFO(*,*);                                        <<04584>>23164000
      END                                                      <<04584>>23166000
   ELSE                                                        <<04584>>23168000
      MOVE BLINE(18) := "NONE";                                <<04584>>23170000
   PRINTLINE;                                                  <<04584>>23172000
END;                                                           <<04584>>23174000
                                                               <<04584>>23176000
   BLANKLINE;                                                  <<04584>>23178000
   MOVE BLINE := "USL FILE       :";                           <<04584>>23180000
   PRINTNAME (USLFNUM);                                        <<04584>>23182000
   MOVE BLINE := "AUX USL FILE   :";                           <<04584>>23184000
   PRINTNAME (XUSLFNUM);                                       <<04584>>23186000
   MOVE BLINE := "SL FILE        :";                           <<04584>>23188000
   PRINTNAME (SPLFNUM);                                        <<04584>>23190000
   MOVE BLINE := "RL FILE        :";                           <<04584>>23192000
   PRINTNAME (RLFNUM);                                         <<04584>>23194000
                                                               <<04584>>23196000
   << GET FPMAP FLAGES >>                                      <<04584>>23198000
                                                               <<04584>>23200000
   GETSYSFPMAP(SYSFPMAP);                                      <<04584>>23202000
                                                               <<04584>>23204000
   GETJSFPMAP(JSFPMAP);                                        <<04584>>23206000
                                                               <<04584>>23208000
   MOVE BLINE:="SYSTEM FPMAP   :";                             <<04584>>23210000
   IF SYSFPMAP = 0 THEN                                        <<04584>>23212000
      MOVE BLINE(18) := "OFF"                                  <<04584>>23214000
   ELSE                                                        <<04584>>23216000
      IF SYSFPMAP = 1 THEN                                     <<04584>>23218000
         MOVE BLINE(18) := "ON  (CONDITION)"                   <<04584>>23220000
      ELSE                                                     <<04584>>23222000
         MOVE BLINE(18) := "ON  (UNCONDITION)";                <<04584>>23224000
   PRINTLINE;                                                  <<04584>>23226000
   MOVE BLINE:="SESSION FPMAP  :";                             <<04584>>23228000
   IF JSFPMAP.(15:1)=1 THEN                                    <<04584>>23230000
      MOVE BLINE(18) := "ON"                                   <<04584>>23232000
   ELSE MOVE BLINE(18) := "OFF";                               <<04584>>23234000
   PRINTLINE;                                                  <<04584>>23236000
   BLANKLINE;                                                  <<04584>>23238000
END;                                                           <<04584>>23240000
$PAGE "MISC. PROCEDURE - SETFPMAPFLAG"                                  23242000
PROCEDURE SETFPMAPFLAG;                                        <<04584>>23244000
                                                               <<04584>>23246000
BEGIN                                                          <<04584>>23248000
   IF SETSYSTEM THEN                                           <<04584>>23250000
      BEGIN                                                    <<04584>>23252000
      IF NOT USERCAP1.(0:1) THEN << NO SM CAP >>               <<04584>>23254000
         ERROR(MSG'REQSMCAP)                                   <<04584>>23256000
      ELSE                                                     <<04584>>23258000
         IF SETOFF THEN                                        <<04584>>23260000
            SYSFPMAP:=0                                        <<04584>>23262000
         ELSE                                                  <<04584>>23264000
            IF SETUNCOND THEN                                  <<04584>>23266000
               SYSFPMAP:=2                                     <<04584>>23268000
            ELSE                                               <<04584>>23270000
               SYSFPMAP:=1;                                    <<04584>>23272000
      UPDATESYSFPMAP(SYSFPMAP);                                <<04584>>23274000
      END                                                      <<04584>>23276000
   ELSE                                                        <<04584>>23278000
      BEGIN                                                    <<04584>>23280000
      IF SETOFF THEN                                           <<04584>>23282000
         JSFPMAP:=%(2)10  <<BIT 14:1 INDICATES >>              <<04584>>23284000
      ELSE                      <<JSFPMAP IS INIT'ED >>        <<04584>>23286000
         JSFPMAP:=%(2)11;                                      <<04584>>23288000
      UPDATEJSFPMAP(JSFPMAP);                                  <<04584>>23290000
      END;                                                     <<04584>>23292000
END;                                                           <<04584>>23294000
$PAGE "MISC PROCEDURE - GENPMAPLIST"                                    23296000
PROCEDURE GENPMAPLIST;                                         <<04584>>23298000
                                                               <<04584>>23300000
<< THIS PROCEDURE LISTS THE PROGRAM PMAP AS USER'S REQUEST >>  <<04584>>23302000
<< 1. LIST A PROCEDURE IF PROCEDURE NAME SPECIFIED         >>  <<04584>>23304000
<< 2. LIST A SEGMENT IF SEG NAME SPECIFIED                 >>  <<04584>>23306000
<< 3. LIST ALL SEGMENT IF NONE OF ABOVE IS SPECIFIED       >>  <<04584>>23308000
                                                               <<04584>>23310000
BEGIN                                                          <<04584>>23312000
   INTEGER ARRAY INMAPBUF(0:14);                               <<04584>>23314000
   INTEGER ARRAY PMAPCB (0:640);                               <<04584>>23316000
   INTEGER POINTER INMAPP=INMAPBUF;                            <<04584>>23318000
   BYTE ARRAY INMAPBP(*)=INMAPBUF;                             <<04584>>23320000
   INTEGER POINTER INMAPP1;                                    <<04584>>23322000
   DOUBLE POINTER INMAPDP1=INMAPP1;                            <<04584>>23324000
   BYTE ARRAY HEADING(*)=PB:=                                  <<04584>>23326000
   "  NAME            TYPE     CODE    ENTRY   LENGTH";        <<04584>>23328000
   LOGICAL HEADPRINTED;                                        <<04584>>23330000
   INTEGER SCANCODE;                                           <<04584>>23332000
   INTEGER STATUS;                                             <<04584>>23334000
   EQUATE SCANALL=0,                                           <<04584>>23336000
          SCANCURSEG=1;                                        <<04584>>23338000
   BYTE ARRAY NAMEBLOCK(0:15);                                 <<04584>>23340000
   DEFINE                                                      <<04584>>23342000
   INMAPFNum      = PmapCB(1)#,   << # of prog/SL file >>      <<04584>>23344000
   INMAPFileCode  = PmapCB(2)#;   << Prog file code >>         <<04584>>23346000
<<-------------------------------------------------------------<<04584>>23348000
<<                                                             <<04584>>23350000
<< Internal PMAP Records.                                      <<04584>>23352000
<<                                                             <<04584>>23354000
<<-------------------------------------------------------------<<04584>>23356000
<<                                                             <<04584>>23358000
<< Pointers referenced:                                        <<04584>>23360000
<<                                                             <<04584>>23362000
<<    INMAPP   - Integer pointer to 1st word of an internal    <<04584>>23364000
<<               record.                                       <<04584>>23366000
<<    INMAPBP  - Byte pointer to 1st byte of an internal PMAP  <<04584>>23368000
<<               record.                                       <<04584>>23370000
<<    INMAPP1  - Integer pointer to 1st word after name in an  <<04584>>23372000
<<               internal PMAP record.                         <<04584>>23374000
<<    INMAPDP1 - Double pointer to 1st word after name in an   <<04584>>23376000
<<               internal PMAP record.                         <<04584>>23378000
<<                                                             <<04584>>23380000
<<-------------------------------------------------------------<<04584>>23382000
                                                               <<04584>>23384000
<< Field definitions common to all record types: >>            <<04584>>23386000
                                                               <<04584>>23388000
define                                                         <<04584>>23390000
   INMAP'Type      = INMAPP.(0:4)#;                            <<04584>>23392000
define                                                         <<04584>>23394000
   INMAP'NameNumCh = INMAPP.(4:4)#, << # chars in ent name >>  <<04584>>23396000
   INMAP'Name      = INMAPBP#,                                 <<04584>>23398000
                                                               <<04584>>23400000
<< Segment record field definitions: >>                        <<04584>>23402000
                                                               <<04584>>23404000
   INMAP'SttLen    = INMAPP1.(0:8)#,                           <<04584>>23406000
   INMAP'SegNum    = INMAPP1.(8:8)#,                           <<04584>>23408000
   INMAP'SegLen    = INMAPP1(1)#, << Segment length, including <<04584>>23410000
                                  <<   the STT.                <<04584>>23412000
                                                               <<04584>>23414000
<< Procedure record field definitions: >>                      <<04584>>23416000
                                                               <<04584>>23418000
   INMAP'Flags     = INMAPP1#,                                 <<04584>>23420000
      INMAP'Hidden = INMAPP1.(0:1)#,                           <<04584>>23422000
                                                               <<04584>>23424000
   INMAP'ProcStart = INMAPP1(1)#,                              <<04584>>23426000
   INMAP'ProcLen   = INMAPP1(2)#,                              <<04584>>23428000
   INMAP'ProcEntry = INMAPP1(3)#,                              <<04584>>23430000
   INMAP'TboxLink  = INMAPDP1(2)#,                             <<04584>>23432000
   INMAP'TboxId    = INMAPP1(6)#,                              <<04584>>23434000
                                                               <<04584>>23436000
<< Secondary entry point record definitions: >>                <<04584>>23438000
                                                               <<04584>>23440000
   INMAP'SecEntry  = INMAPP1(1)#,                              <<04584>>23442000
   INMAP'SecEntNum = INMAPP1(2)#;                              <<04584>>23444000
                                                               <<04584>>23446000
SUBROUTINE PRINTPROGRAM;                                       <<04584>>23448000
                                                               <<04584>>23450000
BEGIN                                                          <<04584>>23452000
                                                               <<04584>>23454000
   << PRINT PROGRAM NAME >>                                    <<04584>>23456000
                                                               <<04584>>23458000
   BLANKLINE;                                                  <<04584>>23460000
   TOS := INMAPFNUM;                                           <<04584>>23462000
   MOVE BLINE := "PROGRAM FILE ",2;                            <<04584>>23464000
   FGETINFO(*,*);                                              <<04584>>23466000
   PRINTLINE;                                                  <<04584>>23468000
   BLANKLINE;                                                  <<04584>>23470000
   HEADPRINTED := FALSE;                                       <<04584>>23472000
END;                                                           <<04584>>23474000
                                                               <<04584>>23476000
SUBROUTINE PRINTSEGMENT;                                       <<04584>>23478000
                                                               <<04584>>23480000
BEGIN                                                          <<04584>>23482000
                                                               <<04584>>23484000
   << PRINT SEGMENT NAME >>                                    <<04584>>23486000
                                                               <<04584>>23488000
   BLANKLINE;                                                  <<04584>>23490000
   MOVE BLINE := INMAP'NAME(1),(INMAP'NAMENUMCH);              <<04584>>23492000
   NTOA(INMAP'SEGNUM,8,BLINE(18));                             <<04584>>23494000
   NTOA(INMAP'SEGLEN,8,BLINE(26));                             <<04584>>23496000
   PRINTLINE;                                                  <<04584>>23498000
   HEADPRINTED := FALSE;                                       <<04584>>23500000
END;                                                           <<04584>>23502000
                                                               <<04584>>23504000
SUBROUTINE PRINTHEADING;                                       <<04584>>23506000
                                                               <<04584>>23508000
BEGIN                                                          <<04584>>23510000
                                                               <<04584>>23512000
   << PRINT COLUMN HEADING >>                                  <<04584>>23514000
                                                               <<04584>>23516000
   BLANKLINE;                                                  <<04584>>23518000
   MOVE BLINE := HEADING,(49);                                 <<04584>>23520000
   PRINTLINE;                                                  <<04584>>23522000
   HEADPRINTED := TRUE;                                        <<04584>>23524000
END;                                                           <<04584>>23526000
                                                               <<04584>>23528000
SUBROUTINE PRINTENTRY;                                         <<04584>>23530000
                                                               <<04584>>23532000
BEGIN                                                          <<04584>>23534000
                                                               <<04584>>23536000
   << PRINT ENTRIES >>                                         <<04584>>23538000
                                                               <<04584>>23540000
   IF NOT HEADPRINTED THEN PRINTHEADING;                       <<04584>>23542000
   MOVE BLINE(2) := INMAP'NAME(1),(INMAP'NAMENUMCH);           <<04584>>23544000
   IF INMAP'TYPE = PMAPPROCTYPE THEN                           <<04584>>23546000
      BEGIN                                                    <<04584>>23548000
         MOVE BLINE(20) := "P";                                <<04584>>23550000
         NTOA(INMAP'PROCSTART,8,BLINE(30));                    <<04584>>23552000
         NTOA(INMAP'PROCENTRY,8,BLINE(39));                    <<04584>>23554000
         NTOA(INMAP'PROCLEN,8,BLINE(48));                      <<04584>>23556000
      END                                                      <<04584>>23558000
   ELSE                                                        <<04584>>23560000
      BEGIN                                                    <<04584>>23562000
         MOVE BLINE(19) := "SP";                               <<04584>>23564000
         NTOA(INMAP'SECENTRY,8,BLINE(39));                     <<04584>>23566000
      END;                                                     <<04584>>23568000
   PRINTLINE;                                                  <<04584>>23570000
END;                                                           <<04584>>23572000
                                                               <<04584>>23574000
<< BEGINNING OF GENPMAPLIST >>                                 <<04584>>23576000
                                                               <<04584>>23578000
   INMAPFNUM:=FOPEN(PROGNAME,%(2)11,%(2)100010000);            <<04584>>23580000
   IF < THEN                                                   <<04584>>23582000
      BEGIN                                                    <<04584>>23584000
         TOS:=37;                                              <<04584>>23586000
         TOS:=0D;                                              <<04584>>23588000
         FCHECK(0,S0);                                         <<04584>>23590000
         ERRORN(*,*);                                          <<04584>>23592000
         RETURN;                                               <<04584>>23594000
      END;                                                     <<04584>>23596000
                                                               <<04584>>23598000
   PMAPCBINIT(INMAPFNUM,PMAPCB,STATUS);                        <<04584>>23600000
   IF STATUS <> 0 THEN                                         <<04584>>23602000
      GO NFG;                                                  <<04584>>23604000
   IF INMAPFILECODE <> PROGFILECODE THEN                       <<04584>>23606000
      BEGIN                                                    <<04584>>23608000
         STATUS:=11;                                           <<04584>>23610000
         GO NFG;                                               <<04584>>23612000
      END;                                                     <<04584>>23614000
                                                               <<04584>>23616000
   PRINTPROGRAM;                                               <<04584>>23618000
   PMAPFINDSEGNUM(0,PMAPCB,STATUS);                            <<04584>>23620000
   IF STATUS <> 0 THEN GO NFG;                                 <<04584>>23622000
   SCANCODE:=SCANALL;                                          <<04584>>23624000
   IF SEG'PROCNAME <> " " THEN                                 <<04584>>23626000
      BEGIN                                                    <<04584>>23628000
         BUILDNAMEBLOCK(NAMEBLOCK,16,SEG'PROCNAME,,STATUS);    <<04584>>23630000
         WHILE GETIPMAPREC(INMAPBUF,INMAPP1,SCANCODE,          <<04584>>23632000
                           PMAPCB,STATUS) DO                   <<04584>>23634000
            BEGIN                                              <<04584>>23636000
               IF NAMESMATCH(INMAP'NAME,NAMEBLOCK) THEN        <<04584>>23638000
                  BEGIN                                        <<04584>>23640000
                     IF INMAP'TYPE > 0 THEN                    <<04584>>23642000
                        BEGIN                                  <<04584>>23644000
                           PRINTENTRY;                         <<04584>>23646000
                           GO EXIT';                           <<04584>>23648000
                        END                                    <<04584>>23650000
                     ELSE                                      <<04584>>23652000
                        BEGIN                                  <<04584>>23654000
                           PRINTSEGMENT;                       <<04584>>23656000
                           SCANCODE :=SCANCURSEG;              <<04584>>23658000
                           WHILE GETIPMAPREC(INMAPBUF,INMAPP1, <<04584>>23660000
                              SCANCODE,PMAPCB,STATUS) DO       <<04584>>23662000
                              PRINTENTRY;                      <<04584>>23664000
                           GO EXIT';                           <<04584>>23666000
                        END;                                   <<04584>>23668000
                  END;                                         <<04584>>23670000
            END;                                               <<04584>>23672000
         STATUS:=1;                                            <<04584>>23674000
         GO NFG;                                               <<04584>>23676000
      END                                                      <<04584>>23678000
$PAGE "COMMAND INTERPRETER SUPPORT PROCEDURES - CORRECTCLASS"  <<00207>>23680000
   ELSE                                                        <<04584>>23682000
      BEGIN                                                    <<04584>>23684000
         WHILE GETIPMAPREC(INMAPBUF,INMAPP1,SCANCODE,          <<04584>>23686000
                           PMAPCB,STATUS) DO                   <<04584>>23688000
            IF INMAP'TYPE = PMAPSEGTYPE THEN                   <<04584>>23690000
               PRINTSEGMENT                                    <<04584>>23692000
            ELSE                                               <<04584>>23694000
               PRINTENTRY;                                     <<04584>>23696000
      END;                                                     <<04584>>23698000
   GO TO EXIT';                                                <<04584>>23700000
   NFG:                                                        <<04584>>23702000
   CASE * STATUS OF                                            <<04584>>23704000
      BEGIN                                                    <<04584>>23706000
         TOS:=-1;                                              <<04584>>23708000
         TOS:=MSG'CANTLOCATEITEM;                              <<04584>>23710000
         ;;;;;;;;                                              <<04584>>23712000
         TOS:=MSG'NOPMAP;                                      <<04584>>23714000
         TOS:=MSG'BADPROGFILE;                                 <<04584>>23716000
         BEGIN                                                 <<04584>>23718000
            TOS:=MSG'UNEXPECTEDIOERR;                          <<04584>>23720000
            TOS:=0D;                                           <<04584>>23722000
            FCHECK(INMAPFNUM,S0);                              <<04584>>23724000
            ERRORN(*,*);                                       <<04584>>23726000
            GO EXIT';                                          <<04584>>23728000
         END;                                                  <<04584>>23730000
      END;                                                     <<04584>>23732000
   IF S0 <> -1 THEN ERROR(*);                                  <<04584>>23734000
EXIT':                                                         <<04584>>23736000
   IF INMAPFNUM <> 0 THEN FCLOSE(INMAPFNUM,0,0);               <<04584>>23738000
END;                                                           <<04584>>23740000
$PAGE "COMMAND INTERPRETER SUPPORT PROCEDURE - CORRECTCLASS"   <<04584>>23742000
<<----------------------------------------------------------------------23744000
*                                                                      *23746000
*  COMMAND INTERPRETER SUPPORT PROCEDURES                              *23748000
*                                                                      *23750000
---------------------------------------------------------------------->>23752000
                                                                        23754000
$ CONTROL SEGMENT = SEG1                                                23756000
LOGICAL PROCEDURE CORRECTCLASS;                                         23758000
   <<CHECKS THE CURRENT ENTRY TO SEE IF IT IS OF THE SPECIFIED          23760000
     CLASS>>                                                            23762000
   BEGIN                                                                23764000
   INTEGER RESULT = CORRECTCLASS;                                       23766000
   XREG _ ENTTYPE;                                                      23768000
   ASSEMBLE(LDXA,ADAX);                                                 23770000
   IF CLASS = (%(2)0101100110010011&CSR(XREG)).(14:2) OR                23772000
      CLASS = (%(2)1010101010100011&CSR(XREG)).(14:2) OR       <<04123>>23774000
      ENTTYPE = 8 AND CLASS = 2  THEN                          <<04123>>23776000
      RESULT _ RESULT+1                                                 23778000
   END;                                                                 23780000
$PAGE  "COMMAND INTERPRETER SUPPORT PROCEDURES - DETERMINE'FPMAP"       23782000
$CONTROL SEGMENT=SEG1                                                   23784000
PROCEDURE DETERMINE'FPMAP;                                     <<04102>>23786000
                                                               <<04102>>23788000
<< THIS PROCEDURE LOOKS INTO SYSFPMAP AND JSFPMAP     >>       <<04102>>23790000
<< AND PARAMETERS SPECIFIED TO DETERMINE FPMAP OPTION >>       <<04102>>23792000
<<                                                    >>       <<04102>>23794000
<<   SYSFPMAP  : THE %102 WORD OF SYSGLOB EXTENSION   >>       <<04102>>23796000
<<   JSFPMAP   : THE 6TH WORD OF JIT                 >>        <<04584>>23798000
<<                                                    >>       <<04102>>23800000
<<   PARAMETERS                                       >>       <<04102>>23802000
<<      FPMAP   : NUM3.(8:1)                          >>       <<04102>>23804000
<<      NOFPMAP : NUM3.(7:1)                          >>       <<04102>>23806000
                                                               <<04102>>23808000
BEGIN                                                          <<04102>>23810000
   GETSYSFPMAP(SYSFPMAP);                                      <<04584>>23814000
   GETJSFPMAP(JSFPMAP);                                        <<04584>>23816000
   IF SYSFPMAP = 2 THEN    <<SYSFPMAP=2:FORCED FPMAP SYSTEMWIDE<<04102>>23818000
      FPMAP:=1             <<IGNOR JSFPMAP AND PARAMETERS      <<04102>>23820000
   ELSE                    <<SYSFPMAP=1 OR 0:SYSTEM FPMAP CAN  <<04102>>23822000
      IF JSFPMAP.(15:1)=1 THEN <<BE OVERRIDE BY JSFPMAP        <<04584>>23824000
        IF NOT NOFPMAP THEN<<JSFPMAP CAN BE OVERRIDE BY FPMAP  <<04102>>23826000
            FPMAP:=1;      <<OR NOFPMAP PARAMETER              <<04102>>23828000
END;                                                           <<04102>>23832000
$PAGE "COMMAND INTERPRETER SUPPORT PROCEDURES - DETERMINE'CKSUM"        23834000
$CONTROL SEGMENT=SEG1                                                   23836000
PROCEDURE DETERMINE'CKSUM;                                     <<04257>>23838000
                                                               <<04257>>23840000
<< THIS PROCEDURE CKECK THE EXISTENCE OF PATCH AREA >>         <<04257>>23842000
<< IF CHECKSUM SPECIFIED. IF PATCH IS NOT SPECIFIED >>         <<04257>>23844000
<< THEN SET PATCH TO ZERO. NOTE THAT CHECKSUM IS    >>         <<04257>>23846000
<< STORE IN A FIELD OF PATCH AREA.                  >>         <<04257>>23848000
                                                               <<04257>>23850000
BEGIN                                                          <<04257>>23852000
   IF CHECKSUMSPECIFIED THEN                                   <<04257>>23854000
      IF INITPATCH = -1 THEN                                   <<04257>>23856000
         INITPATCH := 0;                                       <<04257>>23858000
END;                                                           <<04257>>23860000
$PAGE "COMMAND INTERPRETER "                                   <<00207>>23862000
$ CONTROL SEGMENT = SEG1                                                23864000
<<----------------------------------------------------------------------23866000
*                                                                      *23868000
*  COMMAND INTERPRETER                                                 *23870000
*                                                                      *23872000
---------------------------------------------------------------------->>23874000
                                                                        23876000
<<* * * INITIALIZE GLOBAL PARAMETERS * * *>>                            23878000
                                                                        23880000
TURNOFFTRAPS;                                                           23882000
PUSH(DL);                                                               23884000
@DLAREA2 _ S0;  <<INIT. DL AREA 2 LIMIT>>                               23886000
@DLAVAIL _ TOS;  <<INIT. DL AVAILABLE AREA LIMIT>>                      23888000
WHO(USERMODE,USERCAP);  <<GET USER'S PARM'S>>                           23890000
<<* * * OPEN $STDINX FILE * * *>>                              <<00.DM>>23892000
                                                               <<00.DM>>23894000
IF USERMODE.(12:2) = 1 THEN  << IT'S A SESSION >>              <<00.DM>>23896000
   BEGIN                                                       <<00.DM>>23898000
   INFNUM := FOPEN( ,%2054, 0, -80);                           <<00.DM>>23900000
   IF <> THEN QUIT(0);                                         <<00.DM>>23902000
   END                                                         <<00.DM>>23904000
ELSE                                                           <<00.DM>>23906000
   INFNUM := 0;                                                <<00.DM>>23908000
                                                               <<00.DM>>23910000
<<* * * SET UP CONTROL Y TRAP * * *>>                          <<00.DM>>23912000
                                                               <<00.DM>>23914000
XCONTRAP(@CTLY'TRAP,I);                                        <<00.DM>>23916000
FCONTROL(INFNUM,DISABLE'CTLY,I);                               <<00.DM>>23918000
                                                               <<00.DM>>23920000
GETPRIVMODE;  <<GET INTO PRIV. MODE>>                                   23922000
IF THISCPU <> 0 THEN                                           <<00.DM>>23924000
   BEGIN      <<SERIES II>>                                    <<00.DM>>23926000
   TOS := SETSYSDB;                                            <<00.DM>>23928000
   TOS := SDBDEFAULTSTK2;                                      <<00.DM>>23930000
   TOS := SDBMAXCODE2;                                         <<00.DM>>23932000
   TOS := PCBSIZE2;                                            <<00.DM>>23934000
   END                                                         <<00.DM>>23936000
 ELSE                                                          <<00.DM>>23938000
   BEGIN      <<SERIES I>>                                     <<00.DM>>23940000
   TOS := SETSYSDB;                                            <<00.DM>>23942000
   TOS := SDBDEFAULTSTK1;                                      <<00.DM>>23944000
   TOS := SDBMAXCODE1;                                         <<00.DM>>23946000
   TOS := PCBSIZE1;                                            <<00.DM>>23948000
   END;                                                        <<00.DM>>23950000
RESETDB(S3);                                                   <<00.DM>>23952000
CONFIG := TOS;      <<PCB SIZE>>                               <<00.DM>>23954000
CONFIG(1) := TOS;   <<MAX. CODE SEGMENT SIZE>>                 <<00.DM>>23956000
CONFIG(2) := TOS;   <<MIN. STACK SIZE>>                        <<00.DM>>23958000
DEL;                                                           <<00.DM>>23960000
                                                                        23962000
OB:                                                                     23964000
AWAKE(FATHERPIN*PCBSIZE,2,1);  <<ACTIVATE FATHER - SUSPEND SELF>>       23966000
                                                                        23968000
<<* * * RECEIVE COMMAND FROM FATHER * * *>>                             23970000
                                                                        23972000
RECEIVEMAIL(0,COMBUF,FALSE);  <<GET COMMAND THRU MAIL>>                 23974000
IF <> THEN QUIT(4);  <<ERROR?>>                                         23976000
GETUSERMODE;  <<BACK INTO USER MODE>>                                   23978000
MOVE AUXCOMBUF _ COMBUF,(AUXMAILLENGTH);                                23980000
                                                                        23982000
<<* * * OPEN LIST FILE * * *>>                                          23984000
                                                                        23986000
IF LIST AND LISTFNUM = 0 THEN  <<OPEN LIST FILE?>>                      23988000
   BEGIN                                                                23990000
   TOS _ 0;  <<FOR RESULT OF FOPEN>>                                    23992000
   TOS _ @LISTDESIG;  <<LIST DESIGNATOR>>                               23994000
   TOS := %(2)00100001100;                                              23996000
   TOS.(5:1) _ INHIBITFILEEQ;  <<INHIBIT FILE EQUATION?>>               23998000
   LISTFNUM := FOPEN(*,*,%(2)011000001);                                24000000
   IF < THEN  <<ERROR?>>                                                24002000
      BEGIN                                                             24004000
      TOS _ 83;                                                         24006000
      TOS _ 0D; FCHECK(0,S0);                                           24008000
      ERRORN(*,*);                                                      24010000
      GO OB1                                                            24012000
      END;                                                              24014000
   FGETINFO(LISTFNUM,,,,LISTWIDTH)  <<GET LINE WIDTH>>                  24016000
   END;                                                                 24018000
                                                                        24020000
<<* * * PROCESS COMMAND * * *>>                                         24022000
                                                                        24024000
TOS _ COMMAND;  <<LOAD COMMAND NR.>>                                    24026000
ERRORNR _ NOERROR;  <<INIT. ERROR FLAG>>                                24028000
GO COMSWITCH(TOS);                                                      24030000
                                                                        24032000
<<ADDRL>>                                                               24034000
                                                                        24036000
ADDRL:                                                                  24038000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24040000
IF RLFNUM = 0 THEN GO ERR7;  <<RL FILE OPENED?>>                        24042000
IF NOT SEARCHUSL(NAME,INDEX,USLNONSEG) THEN GO ERR2;                    24044000
INSERTRL;                                                               24046000
GO OB1;                                                                 24048000
                                                                        24050000
<<ADDSL>>                                                               24052000
                                                                        24054000
ADDSL:                                                                  24056000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24058000
IF SPLFNUM = 0 THEN GO ERR6;  <<SL FILE OPENED?>>                       24060000
IF NOT SEARCHUSL(SEGNAME,0,USLSEG) THEN GO ERR2;                        24062000
SymDBug := NOT NOSYM;                                          <<04102>>24064000
DETERMINE'FPMAP;                                               <<04102>>24066000
DETERMINE'CKSUM;                                               <<04257>>24068000
INSERTSL;                                                               24070000
GO OB1;                                                                 24072000
                                                                        24074000
<<AUXUSL>>                                                              24076000
                                                                        24078000
AUXUSL:                                                                 24080000
CHANGESTATE;  <<BACK TO AUX. USL>>                                      24082000
OPENUSL(FALSE);  <<OPEN AUX. USL>>                                      24084000
CHANGESTATE;  <<BACK TO ORIG. USL>>                                     24086000
GO OB1;                                                                 24088000
                                                                        24090000
<<BUILDRL>>                                                             24092000
                                                                        24094000
BUILDRL:                                                                24096000
OPENRL(TRUE);                                                           24098000
GO OB1;                                                                 24100000
                                                                        24102000
<<BUILDSL>>                                                             24104000
                                                                        24106000
BUILDSL:                                                                24108000
OPENSL(TRUE);                                                           24110000
GO OB1;                                                                 24112000
                                                                        24114000
<<BUILDUSL>>                                                            24116000
                                                                        24118000
BUILDUSL:                                                               24120000
OPENUSL(TRUE);                                                          24122000
GO OB1;                                                                 24124000
                                                                        24126000
<<CEASE>>                                                               24128000
                                                                        24130000
CEASE:                                                                  24132000
FLAG _ TRUE;  <<SET FLAG FOR DEACTIVATION>>                             24134000
IF USLFNUM = 0 THEN GO ERR4;                                   <<03026>>24136000
IF NOT SEARCHUSL (NAME,INDEX,CLASS) THEN GO ERR2;              <<03026>>24138000
GO USE1;                                                                24140000
                                                               <<00207>>24142000
<<CLEANSL>>                                                    <<00207>>24144000
CLEANSL:                                                       <<00207>>24146000
SLCLEAN(0D);                                                   <<00207>>24148000
                                                               <<00207>>24150000
GO TO OB1;                                                     <<00207>>24152000
                                                               <<00207>>24154000
<<CLEANUSL>>                                                   <<00207>>24156000
CLEANUSL':                                                     <<00207>>24158000
USLCLEAN;                                                      <<00207>>24160000
GO TO OB1;                                                     <<00207>>24162000
                                                                        24164000
<<COPY>>                                                                24166000
                                                                        24168000
COPY:                                                                   24170000
IF CLASS = ENTRYCLASS THEN GO ERR89;                                    24172000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24174000
IF XUSLFNUM = 0 THEN GO ERR3;  <<AUX. USL FILE OPENED?>>                24176000
CHANGESTATE;                                                            24178000
IF NOT SEARCHUSL(NAME,INDEX,CLASS) THEN                                 24180000
   BEGIN                                                                24182000
   CHANGESTATE;  <<GET ORIGIONAL USL>>                                  24184000
   GO ERR2                                                              24186000
   END;                                                                 24188000
IF NOT CORRECTCLASS THEN                                                24190000
   BEGIN                                                                24192000
   CHANGESTATE;  <<GET ORIGIONAL USL>>                                  24194000
   GO ERR86;                                                            24196000
   END;                                                                 24198000
COPYFAMILY;                                                             24200000
GO OB1;                                                                 24202000
                                                               <<00207>>24204000
<<COPYSL>>                                                     <<00207>>24206000
                                                               <<00207>>24208000
COPYSL:                                                        <<00207>>24210000
TOS := DOUBLE(NUM1)+100D;                                      <<00465>>24212000
IF DS1 < 100D OR DS1 > 10000D THEN                             <<00465>>24214000
   BEGIN                                                       <<00465>>24216000
   DDEL;                                                       <<00465>>24218000
   ERROR(95);                                                  <<00465>>24220000
   GO OB1;                                                     <<00465>>24222000
   END;                                                        <<00465>>24224000
SLCLEAN(*);                                                    <<00465>>24226000
GO OB1;                                                        <<00465>>24228000
                                                               <<00207>>24230000
<<COPYUSL>>                                                    <<00207>>24232000
                                                               <<00207>>24234000
COPYUSL:                                                       <<00207>>24236000
   USLCOPY;                                                    <<00207>>24238000
   GO TO OB1;                                                  <<00207>>24240000
                                                                        24242000
<<EXIT>>                                                                24244000
                                                                        24246000
EXIT':                                                                  24248000
CLOSEUSL;  <<CLOSE USL FILE>>                                           24250000
CHANGESTATE;  <<BACK TO AUX. USL FILE>>                                 24252000
CLOSEUSL;  <<CLOSE AUX. USL FILE>>                                      24254000
CHANGESTATE;  <<BACK TO ORIG. USL>>                                     24256000
CLOSESL;  <<CLOSE SL FILE>>                                             24258000
CLOSERL;  <<CLOSE RL FILE>>                                             24260000
TERMINATE;                                                              24262000
                                                                        24264000
<<HIDE>>                                                                24266000
                                                                        24268000
HIDE:                                                                   24270000
FLAG _ TRUE;  <<SET FLAG FOR HIDE>>                                     24272000
HIDE1:                                                                  24274000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24276000
IF NOT SEARCHUSL(NAME,INDEX,USLNONSEG) THEN GO ERR2;                    24278000
IF NOT BITMAP10&CSR(ENTTYPE) THEN GO ERR88;                             24280000
ENTP(2).(3:1) _ FLAG;  <<ADJ. HIDDEN BIT>>                              24282000
USLDIRMOD _ TRUE;  <<SET MODIFIED FLAG>>                                24284000
GO OB1;                                                                 24286000
                                                                        24288000
<<LISTAUX>>                                                    <<03027>>24290000
                                                               <<03027>>24292000
LISTAUX:                                                       <<03027>>24294000
IF XUSLFNUM = 0 THEN GO ERR3;                                  <<03027>>24296000
CHANGESTATE;                                                   <<03027>>24298000
LISTUSL';                                                      <<03027>>24300000
CHANGESTATE;                                                   <<03027>>24302000
GO OB1;                                                        <<03027>>24304000
                                                               <<03027>>24306000
<<LISTPMAP>>                                                   <<04584>>24308000
                                                               <<04584>>24310000
LISTPMAP:                                                      <<04584>>24312000
GENPMAPLIST;                                                   <<04584>>24314000
GO OB1;                                                        <<04584>>24316000
                                                               <<04584>>24318000
<<LISTRL>>                                                              24320000
                                                                        24322000
LISTRL:                                                                 24324000
IF RLFNUM = 0 THEN GO ERR7;  <<RL FILE OPENED?>>                        24326000
LISTRL';                                                                24328000
GO OB1;                                                                 24330000
                                                                        24332000
<<LISTSL>>                                                              24334000
                                                                        24336000
LISTSL:                                                                 24338000
IF SPLFNUM = 0 THEN GO ERR6;  <<SL FILE OPENED?>>                       24340000
LISTSL';                                                                24342000
GO OB1;                                                                 24344000
                                                                        24346000
<<LISTUSL>>                                                             24348000
                                                                        24350000
LISTUSL:                                                                24352000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24354000
LISTUSL';                                                               24356000
GO OB1;                                                                 24358000
                                                                        24360000
<<NEWSEG>>                                                              24362000
                                                                        24364000
NEWSEG:                                                                 24366000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24368000
IF NOT SEARCHUSL(NAME,INDEX,USLNONSEG) THEN GO ERR2;                    24370000
IF MAP12(ENTTYPE) <> 1 THEN GO ERR88;                                   24372000
I _ ENTFILEADR;  <<SAVE ENTRY ADDRESS>>                                 24374000
UNLINKFAMILY(I);  <<UNLINK FAMILY OF ENTRIES>>                          24376000
IF NOT SEARCHUSL(SEGNAME,0,USLSEG) THEN  <<CREATE SEGMENT ENTRY?>>      24378000
   BEGIN                                                                24380000
   CREATESEGENTRY(SEGNAME);  <<CREATE SEGMENT ENTRY>>                   24382000
   IF < THEN GO OB1  <<ERROR?>>                                         24384000
   END;                                                                 24386000
TOS _ ESL;  <<SAVE SON LINK>>                                           24388000
ESL _ I;  <<INSERT NEW SON LINK>>                                       24390000
USLDIRMOD _ TRUE;                                                       24392000
GETENTRY(I);                                                            24394000
EBL _ TOS;  <<INSERT SAVED SON LINK>>                                   24396000
USLDIRMOD _ TRUE;                                                       24398000
GO OB1;                                                                 24400000
                                                                        24402000
<<PREPARE>>                                                             24404000
                                                                        24406000
PREPARE:                                                                24408000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24410000
SymDBug := not NoSym;                                          <<04102>>24412000
DETERMINE'FPMAP;                                               <<04102>>24414000
DETERMINE'CKSUM;                                               <<04257>>24416000
PREPAREPROGRAM;  <<PREPARE PROGRAM FILE>>                               24418000
GO OB1;                                                                 24420000
                                                                        24422000
<<PURGERBM>>                                                            24424000
                                                                        24426000
PURGERBM:                                                               24428000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24430000
IF CLASS = ENTRYCLASS THEN GO ERR88;                                    24432000
IF NOT SEARCHUSL(NAME,INDEX,CLASS) THEN GO ERR2;                        24434000
IF NOT CORRECTCLASS THEN GO ERR86;                                      24436000
REMOVEFAMILY(ENTFILEADR);  <<REMOVE FAMILY OF ENTRIES>>                 24438000
GO OB1;                                                                 24440000
                                                                        24442000
<<PURGERL>>                                                             24444000
                                                                        24446000
PURGERL:                                                                24448000
IF RLFNUM = 0 THEN GO ERR7;  <<RL FILE OPENED?>>                        24450000
IF CLASS = SEGCLASS THEN GO ERR89;                                      24452000
IF NOT SEARCHRL(NAME) THEN GO ERR2;                                     24454000
REMOVERL;                                                               24456000
GO OB1;                                                                 24458000
                                                                        24460000
<<PURGESL>>                                                             24462000
                                                                        24464000
PURGESL:                                                                24466000
IF SPLFNUM = 0 THEN GO ERR6;  <<SL FILE OPENED?>>                       24468000
IF CLASS = UNITCLASS THEN GO ERR89;                                     24470000
REMOVESL;                                                               24472000
GO OB1;                                                                 24474000
                                                                        24476000
<<REVEAL>>                                                              24478000
                                                                        24480000
REVEAL:                                                                 24482000
FLAG _ FALSE;  <<SET FLAG FOR REVEAL>>                                  24484000
GO HIDE1;                                                               24486000
                                                                        24488000
<<RL>>                                                                  24490000
                                                                        24492000
RL:                                                                     24494000
OPENRL(FALSE);                                                          24496000
GO OB1;                                                                 24498000
                                                               <<04584>>24500000
<<SETFPMAP>>                                                   <<04584>>24502000
                                                               <<04584>>24504000
SETFPMAP:                                                      <<04584>>24506000
SETFPMAPFLAG;                                                  <<04584>>24508000
GO OB1;                                                        <<04584>>24510000
                                                                        24512000
<<SHOW>>                                                       <<04584>>24514000
                                                               <<04584>>24516000
SHOW:                                                          <<04584>>24518000
SHOWALL;                                                       <<04584>>24520000
GO OB1;                                                        <<04584>>24522000
                                                               <<04584>>24524000
<<SL>>                                                                  24526000
                                                                        24528000
SL:                                                                     24530000
OPENSL(FALSE);                                                          24532000
GO OB1;                                                                 24534000
                                                                        24536000
<<USE>>                                                                 24538000
                                                                        24540000
USE:                                                                    24542000
FLAG _ FALSE;  <<SET FLAG FOR ACTIVATION>>                              24544000
IF USLFNUM = 0 THEN GO ERR4;  <<USL FILE OPENED?>>                      24548000
IF NOT SEARCHUSL(NAME,INDEX,CLASS,1) THEN GO ERR2;             <<03026>>24550000
USE1:                                                          <<03026>>24552000
IF NOT CORRECTCLASS THEN GO ERR86;                                      24554000
SETACTIVITY(FLAG);  <<ADJUST ACTIVITY BITS>>                            24556000
GO OB1;                                                                 24558000
                                                                        24560000
<<USL>>                                                                 24562000
                                                                        24564000
USL:                                                                    24566000
OPENUSL(FALSE);                                                         24568000
GO OB1;                                                                 24570000
                                                                        24572000
<<DEBUG>>                                                               24574000
                                                                        24576000
DEBUG':                                                                 24578000
IF NOT USERCAP2.(9:1) THEN GO ERR44;                           <<01107>>24580000
DEBUG;                                                                  24582000
                                                                        24584000
<<* * * SEND RESULT TO FATHER * * *>>                                   24586000
                                                                        24588000
OB1:                                                                    24590000
GETPRIVMODE;  <<GET INTO PRIV. MODE>>                                   24592000
SENDMAIL(0,1,AUXCOMBUF,FALSE);  <<RETURN ANSWER>>                       24594000
IF <> THEN QUIT(5);  <<ERROR?>>                                         24596000
GO OB;                                                                  24598000
                                                                        24600000
<<ERROR MESSAGES>>                                                      24602000
                                                                        24604000
ERR86: ERROR(86); GO OB1;<<ITEM DIFF CLASS>>                            24606000
ERR87: ERROR(87); GO OB1;<<ITEM NOT PRIM ENTRY>>                        24608000
ERR88: ERROR(88); GO OB1;<<INCOMP. ITEM TYPE>>                          24610000
ERR89: ERROR(89); GO OB1;<<INVALID CLASS SPEC>>                         24612000
ERR2: ERROR(93); GO OB1;  <<UNABLE TO LOCATE ITEM>>                     24614000
ERR3: ERROR(120); GO OB1;  <<AUX. USL FILE NOT DESIGNATED>>             24616000
ERR4: ERROR(5); GO OB1;  <<USL FILE NOT DESIGNATED>>                    24618000
ERR6: ERROR(16); GO OB1;  <<SL FILE NOT DESIGNATED>>                    24620000
ERR7: ERROR(21); GO OB1;  <<RL FILE NOT DESIGNATED>>                    24622000
ERR44: ERROR(44); GO OB1; <<NO CAPABILITY>>                    <<01107>>24624000
end. << SegProc >>                                             <<02817>>24626000
