$CONTROL USLINIT,CODE,MAP                                               00010000
<< LOAD - MODULE 05 >>                                                  00012000
<<HP32002C MPE SOURCE C.00.00>>                                         00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$ TITLE "            MPE LOAD PROCESS"                                  00028000
$ CONTROL SEGMENT=LOAD,MAIN=LOAD                                        00030000
$ CONTROL PRIVILEGED,UNCALLABLE                                         00032000
$THIRTY                                                                 00034000
BEGIN                                                                   00036000
                                                                        00038000
<<----------------------------------------------------------------------00040000
*                                                                      *00042000
*                             LOAD PROCESS                             *00044000
*                                                                      *00046000
---------------------------------------------------------------------->>00048000
                                                                        00050000
<<ERROR NUMBERS>>                                                       00052000
                                                                        00054000
EQUATE ERR20 = 20,  <<ILLEGAL LIBRARY SEARCH>>                          00056000
       ERR21 = 21,  <<UNKNOWN ENTRY POINT>>                             00058000
       ERR22 = 22,  <<TRACE SYBSYSTEM NOT PRESENT>>                     00060000
       ERR23 = 23,  <<STACK SIZE TOO SMALL>>                            00062000
       ERR24 = 24,  <<MAX. DATA > 32K>>                                 00064000
       ERR25 = 25,  <<DATA SEGMENT > MAX DATA SEGMENT>>                 00066000
       ERR26 = 26,  <<PROGRAM LOADED IN OPPOSITE MODE>>                 00068000
       ERR27 = 27,  <<SL BINDING ERROR>>                                00070000
       ERR28 = 28,  <<INVALID SYSTEM SL FILE>>                          00072000
       ERR29 = 29,  <<INVALID PUBLIC SL FILE>>                          00074000
       ERR30 = 30,  <<INVALID GROUP SL FILE>>                           00076000
       ERR31 = 31,  <<INVALID PROGRAM FILE>>                            00078000
       ERR32 = 32,  <<INVALID LIST FILE>>                               00080000
       ERR33 = 33,  <<CODE SEGMENT > SYSTEM MAX.>>                      00082000
       ERR34 = 34,  <<PROGRAM USES MORE THAN ONE EXTENT>>               00084000
       ERR35 = 35,  <<DATA SEGMENT > 32K>>                              00086000
       ERR36 = 36,  <<DATA SEGMENT > SYSTEM MAX.>>                      00088000
       ERR37 = 37,  <<NR. CODE SEGMENTS > 63>>                          00090000
       ERR38 = 38,  <<NR. CODE SEGMENTS > SYSTEM MAX.>>                 00092000
       ERR39 = 39,  <<ILLEGAL CAPABILITY>>                              00094000
       ERR40 = 40,  <<TOO MANY PROCEDURES LOADED>>                      00096000
       ERR41 = 41,  <<UNKNOWN PROCEDURE NAME>>                          00098000
       ERR42 = 42,  <<INVALID PROCEDURE NUMBER>>                        00100000
       ERR43 = 43,  <<ILLEGAL PROCEDURE UNLOAD>>                        00102000
       ERR44 = 44,  <<ILLEGAL SL CAPABILITY>>                  <<00.02>>00104000
       ERR45 = 45,  <<INVALID ENTRY POINT>>                    <<00.02>>00106000
       ERR50 = 50,  <<UNABLE TO OPEN SYSTEM SL FILE>>                   00108000
       ERR51 = 51,  <<UNABLE TO OPEN PUBLIC SL FILE>>                   00110000
       ERR52 = 52,  <<UNABLE TO OPEN GROUP SL FILE>>                    00112000
       ERR53 = 53,  <<UNABLE TO OPEN PROGRAM FILE>>                     00114000
       ERR54 = 54,  <<UNABLE TO OPEN LIST FILE>>                        00116000
       ERR55 = 55,  <<UNABLE TO CLOSE SYSTEM SL FILE>>                  00118000
       ERR56 = 56,  <<UNABLE TO CLOSE PUBLIC SL FILE>>                  00120000
       ERR57 = 57,  <<UNABLE TO CLOSE GROUP SL FILE>>                   00122000
       ERR58 = 58,  <<UNABLE TO CLOSE PROGRAM FILE>>                    00124000
       ERR59 = 59,  <<UNABLE TO CLOSE LIST FILE>>                       00126000
       ERR60 = 60,  <<EOF OR I/O ERROR ON SYSTEM SL FILE>>              00128000
       ERR61 = 61,  <<EOF OR I/O ERROR ON PUBLIC SL FILE>>              00130000
       ERR62 = 62,  <<EOF OR I/O ERROR ON GROUP SL FILE>>               00132000
       ERR63 = 63,  <<EOF OR I/O ERROR ON PROGRAM FILE>>                00134000
       ERR64 = 64,  <<EOF OR I/O ERROR ON LIST FILE>>                   00136000
       ERR65 = 65,  <<UNABLE TO OBTAIN CST ENTRIES>>                    00138000
       ERR66 = 66,  <<UNABLE TO OBTAIN PROCESS DST ENTRY>>              00140000
       ERR67 = 67,  <<UNABLE TO OBTAIN MAIL DATA SEGMENT>>              00142000
       ERR68 = 68,  <<UNABLE TO OBTAIN WORKING SET>>                    00144000
       ERR70 = 70,  <<SEGMENT TABLE OVERFLOW>>                          00146000
       ERR71 = 71,  <<UNABLE TO OBTAIN SUFFICIENT DL STORAGE>>          00148000
       ERR72 = 72,  <<ATTIO ERROR>>                                     00150000
       ERR73 = 73,  <<UNABLE TO OBTAIN VIRTUAL MEMORY>>                 00152000
       ERR74 = 74,  <<DIRECTORY I/O ERROR>>                             00154000
       ERR75 = 75,  <<PRINT I/O ERROR>>                                 00156000
       ERR76 = 76,  <<ILLEGAL DLSIZE>>                                  00158000
       ERR80 = 80,  <<PROGRAM ALREADY ALLOCATED>>                       00160000
       ERR81 = 81,  <<ILLEGAL PROGRAM ALLOCATION>>                      00162000
       ERR82 = 82,  <<PROGRAM NOT ALLOCATED>>                           00164000
       ERR83 = 83,  <<ILLEGAL PROGRAM DEALLOCATION>>                    00166000
       ERR84 = 84,  <<PROCEDURE ALREADY ALLOCATED>>                     00168000
       ERR85 = 85,  <<ILLEGAL PROCEDURE ALLOCATION>>                    00170000
       ERR86 = 86,  <<PROCEDURE NOT ALLOCATED>>                         00172000
       ERR87 = 87,  <<ILLEGAL PROCEDURE DEALLOCATION>>         <<00784>>00174000
       ERR93 = 93,  <<UNABLE TO MOUNT PROG'S HOME VOL. SET>>   <<00784>>00176000
       ERR94 = 94,  <<UNABLE TO MOUNT SYS SL'S H.V.S (FAKE)>>  <<00784>>00178000
       ERR95 = 95,  <<UNABLE TO MOUNT PRIVATE SL'S H.V.S>>     <<00784>>00180000
       ERR96 = 96;  <<UNABLE TO MOUNT GROUP SL'S H.V.S>>       <<00784>>00182000
                                                                        00184000
<<MISC. DECLARATIONS>>                                                  00186000
                                                                        00188000
DEFINE ASMB = ASSEMBLE#,                                       <<00.02>>00190000
       ABS = ABSOLUTE#,                                        <<00.02>>00192000
       CAB' = ASMB(CAB)#,                                      <<00.02>>00194000
       DEL' = ASSEMBLE(DEL)#,                                           00196000
       DELB' = ASSEMBLE(DELB)#,                                         00198000
       DUP' = ASSEMBLE(DUP)#,                                           00200000
       DZRO' = ASSEMBLE(DZRO)#,                                         00202000
       SETBIT0 = ASSEMBLE(TSBC 0)#,                                     00204000
       XCH' = ASSEMBLE(XCH)#;                                           00206000
EQUATE CCG = 0,  <<"GREATER THAN" CONDITION CODE>>                      00208000
       CCL = 1,  <<"LESS THAN" CONDITION CODE>>                         00210000
       CCE = 2;  <<"EQUAL" CONDITION CODE>>                             00212000
EQUATE SYSWAITTODISPMSG=%1053;                                 <<01549>>00214000
DEFINE PHASETRANSFLAG=(3:1)#;                                  <<01549>>00216000
INTEGER XREG = X;  <<X REGISTER>>                                       00218000
DOUBLE DDB0 = DB+0;                                                     00220000
BYTE BS0 = S-0;                                                         00222000
BYTE BS1 = S-1;                                                         00224000
BYTE BS2 = S-2;                                                         00226000
INTEGER S0 = S-0;                                                       00228000
INTEGER S1 = S-1;                                                       00230000
INTEGER S2 = S-2;                                                       00232000
INTEGER S3 = S-3;                                                       00234000
INTEGER S4 = S-4;                                                       00236000
INTEGER S5 = S-5;                                                       00238000
INTEGER S6 = S-6;                                                       00240000
INTEGER S7 = S-7;                                                       00242000
LOGICAL LS0 = S-0;                                                      00244000
LOGICAL LS1 = S-1;                                                      00246000
LOGICAL LS2 = S-2;                                                      00248000
LOGICAL LS3 = S-3;                                                      00250000
LOGICAL LS4 = S-4;                                             <<00.04>>00252000
DOUBLE DS1 = S-1;                                                       00254000
DOUBLE DS2 = S-2;                                                       00256000
DOUBLE DS3 = S-3;                                                       00258000
DOUBLE DS4 = S-4;                                                       00260000
DOUBLE DS5 = S-5;                                                       00262000
DOUBLE DS6 = S-6;                                                       00264000
BYTE POINTER BPS0 = S-0;                                                00266000
BYTE POINTER BPS1 = S-1;                                                00268000
BYTE POINTER BPS2 = S-2;                                                00270000
BYTE POINTER BPS3 = S-3;                                                00272000
INTEGER POINTER PS0 = S-0;                                              00274000
INTEGER POINTER PS1 = S-1;                                              00276000
INTEGER POINTER PS2 = S-2;                                              00278000
INTEGER POINTER PS3 = S-3;                                              00280000
INTEGER POINTER PS4 = S-4;                                              00282000
LOGICAL POINTER LPS0 = S-0;                                             00284000
DOUBLE POINTER DPS0 = S-0;                                              00286000
DOUBLE POINTER DPS1 = S-1;                                              00288000
DOUBLE POINTER DPS2 = S-2;                                              00290000
BYTE ARRAY BAS0 (*) = S-0;                                              00292000
INTEGER STATUS = Q-1;  <<STATUS WORD OF STACK MARKER>>                  00294000
DEFINE CONDCODE = STATUS.(6:2)#;  <<COND. CODE BITS>>                   00296000
DEFINE TURNOFFTRAPS = PUSH(STATUS); TOS.(2:1) := 0; SET(STATUS)#;       00298000
                                                                        00300000
<<SYSTEM PARAMETERS>>                                                   00302000
                                                                        00304000
EQUATE CSTP = 0,                                                        00306000
       PCBB = 3,                                                        00308000
       SSLKEYA = %1126,    << SYSTEM SL KEY >>                          00310000
       MAXCODESEG = %1106, << MAX CODE SEGMENTS IN PROG >>              00312000
       MAXCODE = %1105,    << MAX CODE SEG SIZE >>                      00314000
       LCT = %1220,        << LOADER COMMUNICATION TABLE >>             00316000
       PCBSIZE = 16;                                                    00318000
DEFINE LASTCST = ABSOLUTE(ABSOLUTE(CSTP))#;                             00320000
                                                                        00322000
<<UTILITY CONSTANTS>>                                                   00324000
                                                                        00326000
INTEGER P256 := 256;                                                    00328000
INTEGER P384 := 384;                                                    00330000
INTEGER P512 := 512;                                                    00332000
                                                                        00334000
<<UTILITY BUFFERS>>                                                     00336000
                                                                        00338000
INTEGER ARRAY BUF1 (0:127);                                             00340000
INTEGER ARRAY BUF2 (0:127);                                             00342000
                                                                        00344000
INTEGER SAVESIR := -1;                                                  00346000
LOGICAL USERCAP;                                               <<00.02>>00348000
                                                                        00350000
<<----------------------------------------------------------------------00352000
*                                                                      *00354000
*  DL AREA PARAMETERS                                                  *00356000
*                                                                      *00358000
---------------------------------------------------------------------->>00360000
                                                                        00362000
EQUATE SYSDL = 10,  <<NR. WORDS DL AREA RESERVED FOR SYSTEM>>           00364000
       DLINCREMENT = 128;  <<NR. WORDS BY WHICH DL IS EXPANDED>>        00366000
INTEGER POINTER DLAREA1 := -SYSDL;  <<DL USED AREA 1 POINTER>>          00368000
INTEGER POINTER DLAREA2;  <<DL USED AREA 2 POINTER>>                    00370000
INTEGER POINTER DLAVAIL;  <<DL AVAILABLE AREA POINTER>>                 00372000
INTEGER DLSZE;             <<INITIAL DL SIZE>>                          00374000
                                                                        00376000
<<----------------------------------------------------------------------00378000
*                                                                      *00380000
*  LIST FILE BUFFERS AND PARAMETERS                                    *00382000
*                                                                      *00384000
---------------------------------------------------------------------->>00386000
                                                                        00388000
INTEGER LISTFNUM := 0;  <<LIST DEVICE FILE NR.>>                        00390000
BYTE ARRAY LISTDESIG (0:8) := "LOADLIST ";                              00392000
INTEGER ARRAY LINE (0:35);  <<LIST BUFFER>>                             00394000
BYTE ARRAY BLINE (*) = LINE;                                            00396000
LOGICAL LISTFLAG := FALSE;   << TRUE IF LISTING GENERATED >>            00398000
DOUBLE LISTADDR;  << LOADLIST FILE DISK ADDRESS >>                      00400000
INTEGER LISTADDR1 = LISTADDR;                                           00402000
INTEGER LISTADDR2 = LISTADDR+1;                                         00404000
                                                                        00406000
<<----------------------------------------------------------------------00408000
*                                                                      *00410000
*  COMMAND BUFFER AND PARAMETERS                                       *00412000
*                                                                      *00414000
---------------------------------------------------------------------->>00416000
                                                                        00418000
<<INCOMMING>>                                                           00420000
                                                                        00422000
EQUATE MAILLENGTH = 22;  <<MAIL BUFFER LENGTH>>                <<00211>>00424000
INTEGER ARRAY MAILBUF (0:MAILLENGTH-1) = DB;  <<MAIL BUFFER>>           00426000
BYTE ARRAY MAILBBUF (*) = MAILBUF;                                      00428000
DOUBLE ARRAY MAILDBUF (*) = MAILBUF;                                    00430000
DEFINE MALLOCATE = LOGICAL(MAILBUF.(0:1))#,  <<ALLOCATE SEGMENTS?>>     00432000
       MCOMMAND = MAILBUF.(0:2)#,  <<COMMAND NR.>>                      00434000
       MLIBSEARCH = MAILBUF.(2:2)#,  <<S = 0, P = 1, G = 2>>            00436000
       MPMODE = LOGICAL(MAILBUF.(4:1))#,  <<NORMAL/NO PRIV. MODE>>      00438000
       MLMAPBIT = MAILBUF.(6:1)#,  <<LOAD MAP BIT>>                     00440000
       MLMAP = LOGICAL(MAILBUF.(6:1))#,  <<LOAD MAP?>>                  00442000
       MPIN = MAILBUF.(8:8) #,  <<PIN OF PROCESS>>             <<00211>>00444000
       MEXTENSION = MAILBBUF(3)#,  <<EXTENSION NR. OF PROCEDURE>>       00446000
       WPROC = MAILBUF(11)#,       <<WAITING PROCESS>>                  00448000
       USERCAP2 = MAILBUF(12)#,    <<CAPABILITY>>                       00450000
       MPVINFO = MAILBUF (21)#,    <<PV MOUNT INFO>>           <<00211>>00452000
       MGROUP = MAILBBUF(26)#,     <<USER GROUP>>                       00454000
       MACCT = MAILBBUF(34)#;      <<USER ACCOUNT>>                     00456000
DOUBLE MPROGKEY = MAILBUF+1;  <<PROG. FILE KEY>>                        00458000
INTEGER ARRAY MPROCNAME (*) = MAILBUF(3);  <<PROCEDURE NAME>>           00460000
                                                                        00462000
<<OUTGOING>>                                                            00464000
                                                                        00466000
DOUBLE MAILDBACK := 0D;  <<MAIL BUFFER>>                                00468000
INTEGER MSTARTINGCST = MAILDBACK;  <<STARTING CST NR.>>                 00470000
INTEGER MPLABEL = MAILDBACK;  <<STARTING P-LABEL>>                      00472000
INTEGER MFERROR = MAILDBACK;  <<FILE SYS. ERROR NR'S>>                  00474000
INTEGER MERROR = MAILDBACK+1;  <<ERROR NR.>>                            00476000
                                                                        00478000
<<----------------------------------------------------------------------00480000
*                                                                      *00482000
*  UNSATISFIED EXTERNAL TABLE AND PARAMETERS                           *00484000
*                                                                      *00486000
---------------------------------------------------------------------->>00488000
                                                                        00490000
INTEGER POINTER SAVEUXP;  <<SAVE ENTRY POINTER>>                        00492000
INTEGER POINTER UXP;  <<POINTS TO NAME>>                                00494000
INTEGER POINTER UXP1;  <<SECONDARY POINTER>>                            00496000
INTEGER POINTER UXP2;  <<SECONDARY POINTER>>                            00498000
INTEGER UXNW;  <<NR. WORDS IN ENTRY>>                                   00500000
INTEGER UXNC;  <<NR. CHAR'S IN NAME>>                                   00502000
DEFINE UXNAME = UXP#,  <<EXTERNAL NAME>>                                00504000
       UXUTYPE = UXP1.(0:4)#,  <<ORIGIN OF EXTERNAL>>                   00506000
       UXSTYPE = UXP1.(4:4)#,  <<SATISFIER OF EXTERNAL>>                00508000
       UXNR = UXP1.(8:8)#,  <<NR. REFERENCES>>                          00510000
       UXPARMS = UXP2#;  <<PARM. INFO>>                                 00512000
                                                                        00514000
<<----------------------------------------------------------------------00516000
*                                                                      *00518000
*  SATISFIED EXTERNAL TABLE AND PARAMETERS                             *00520000
*                                                                      *00522000
---------------------------------------------------------------------->>00524000
                                                                        00526000
INTEGER POINTER SXTABLE;  <<EXTERNAL TABLE>>                            00528000
INTEGER NWSXTABLE := 0;  <<NR. WORDS IN TABLE>>                         00530000
                                                                        00532000
<<----------------------------------------------------------------------00534000
*                                                                      *00536000
*  CST TABLE AND PARAMETERS                                            *00538000
*                                                                      *00540000
---------------------------------------------------------------------->>00542000
                                                                        00544000
INTEGER POINTER CSTNRS;  <<CST TABLE>>                                  00546000
INTEGER NCSTS;  <<NR. OF CST'S ALLOCATED>>                              00548000
INTEGER CSTBX;  <<CST BLOCK INDEX>>                                     00550000
INTEGER CSTBLOCKALLOCATED := 0;   <<ALLOCATED FLAG>>                    00552000
INTEGER WSP := 0;    << WORKING SET BLOCK FLAG >>                       00554000
INTEGER CSTSALLOCATED := 0;  <<CST'S ALLOCATED FLAG>>                   00556000
LOGICAL ARRAY FIXEDCSTS (0:15);  <<CST'S INITIALIZED>>                  00558000
BYTE ARRAY CSTFLAGS (*) = BUF1;  <<CST FLAGS (128)>>                    00560000
                                                                        00562000
<<SL SEGMENTS REFERENCED BUT NOT ALLOCATED>>                            00564000
                                                                        00566000
INTEGER ARRAY SLAP (*) = DB;                                            00568000
INTEGER POINTER SSLAP;  <<SYSTEM SL SEG'S NOT ALLOCATED>>               00570000
INTEGER POINTER PSLAP;  <<PUBLIC SL SEG'S NOT ALLOCATED>>               00572000
INTEGER POINTER GSLAP;  <<GROUP SL SEG'S NOT ALLOCATED>>                00574000
                                                                        00576000
INTEGER ARRAY NSLA (*) = DB;                                            00578000
INTEGER NSSLA := 0;  <<NR. SYSTEM SL SEG'S NOT ALLOCATED>>              00580000
INTEGER NPSLA := 0;  <<NR. PUBLIC SL SEG'S NOT ALLOCATED>>              00582000
INTEGER NGSLA := 0;  <<NR. GROUP SL SEG'S NOT ALLOCATED>>               00584000
                                                                        00586000
<<PROGRAM FILE SEGMENTS REFERENCED BUT NOT ALLOCATED>>                  00588000
                                                                        00590000
INTEGER POINTER PAP;  <<PROG. SEG'S NOT ALLOCATED>>                     00592000
INTEGER NPA := 0;  <<NR. PROG. SEG'S NOT ALLOCATED>>                    00594000
                                                                        00596000
<<SL SEGMENTS REFERENCED AND ALREADY ALLOCATED>>                        00598000
                                                                        00600000
INTEGER ARRAY NSLR (*) = DB;                                            00602000
INTEGER NSSLR := 0;  <<NR. SYSTEM SL SEG'S ALREADY ALLOCATED>>          00604000
INTEGER NPSLR := 0;  <<NR. PUBLIC SL SEG'S ALREADY ALLOCATED>>          00606000
INTEGER NGSLR := 0;  <<NR. GROUP SL SEG'S ALREADY ALLOCATED>>           00608000
                                                                        00610000
<<----------------------------------------------------------------------00612000
*                                                                      *00614000
*  PROGRAM FILE BUFFERS AND PARAMETERS                                 *00616000
*                                                                      *00618000
---------------------------------------------------------------------->>00620000
                                                                        00622000
INTEGER PROGFNUM := 0;  <<PROGRAM FILE NR.>>                            00624000
DOUBLE PROGKEY;  <<ENTRY KEY>>                                          00626000
INTEGER POINTER PROGREC0;  <<RECORD 0,1 (256)>>                         00628000
DEFINE PCAPABILITY = PROGREC0.(6:10)#,  <<CAPABILITY>>                  00630000
       PPRIVMODE = LOGICAL(PROGREC0.(9:1))#,  <<PRIV. MODE?>>           00632000
       PNRSEGS = PROGREC0(1)#,  <<NR. SEGMENTS>>                        00634000
       PSEGMENTRECD = PROGREC0(4)#,  <<REC. NR. OF SEGMENT LIST>>       00636000
       PENTRYRECD = PROGREC0(8)#,  <<REC. NR. OF ENTRY POINT LIST>>     00638000
       PSTARTINGSEG = PROGREC0(9)#,  <<STARTING SEG. NR.>>              00640000
       PEXTERNALRECD = PROGREC0(13)#;  <<REC. NR. OF EXTERNAL LIST>>    00642000
INTEGER PROGLOADBIT := 0;  <<"LOADED" BIT SET FLAG>>                    00644000
                                                                        00646000
<<----------------------------------------------------------------------00648000
*                                                                      *00650000
*  SL FILE BUFFERS AND PARAMETERS                                      *00652000
*                                                                      *00654000
---------------------------------------------------------------------->>00656000
                                                                        00658000
EQUATE SLFILECODE = 1031,  <<FILE CODE>>                                00660000
       SLFILEID = 3,  <<VERSION NR.>>                                   00662000
       FHI = 33;  <<INDEX OF FIRST HASH BUCKET>>                        00664000
INTEGER SLNR;  <<CURRENT SL NR.: 0 = SSL, 1 = PSL, 2 = GSL>>            00666000
                                                                        00668000
<<FILE NAME BUFFERS>>                                                   00670000
                                                                        00672000
INTEGER ARRAY SLFNAME (*) = DB;                                         00674000
BYTE ARRAY SSLFNAME (0:10);  <<SYSTEM SL FILE NAME>>                    00676000
BYTE ARRAY PSLFNAME (0:15);  <<PUBLIC SL FILE NAME>>                    00678000
BYTE ARRAY GSLFNAME (0:20);  <<GROUP SL FILE NAME>>                     00680000
                                                                        00682000
<<FILE NUMBERS>>                                                        00684000
                                                                        00686000
INTEGER ARRAY SLFNUM (*) = DB;                                          00688000
INTEGER SSLFNUM := 0;  <<SYSTEM SL FILE NR.>>                           00690000
INTEGER PSLFNUM := 0;  <<PUBLIC SL FILE NR.>>                           00692000
INTEGER GSLFNUM := 0;  <<GROUP SL FILE NR.>>                            00694000
LOGICAL ARRAY FDA (0:15) := 16 (0); <<FOPENDA: FNUM BITMAP>>   <<RV.PV>>00696000
                                                                        00698000
<<FILE KEYS>>                                                           00700000
                                                                        00702000
DOUBLE ARRAY SLKEY (*) = DB;                                            00704000
DOUBLE SSLKEY;  <<SYSTEM SL FILE KEY>>                                  00706000
DOUBLE PSLKEY;  <<PUBLIC SL FILE KEY>>                                  00708000
DOUBLE GSLKEY;  <<GROUP SL FILE KEY>>                                   00710000
                                                                        00712000
<< FILE CAPABILITY >>                                          <<00.02>>00714000
ARRAY  SLCAP(*) = DB;                                          <<00.02>>00716000
LOGICAL SSLCAP; << SYSTEM SL CAP. >>                           <<00.02>>00718000
LOGICAL PSLCAP;  << PUBLIC SL CAP. >>                          <<00.02>>00720000
LOGICAL GSLCAP;  << GROUP SL CAP. >>                           <<00.02>>00722000
                                                               <<00.02>>00724000
<<RECORD 0 BUFFER AND PARAMETERS>>                                      00726000
                                                                        00728000
INTEGER ARRAY SLREC0 (*) = BUF1;  <<RECORD 0 BUFFER (128)>>             00730000
DEFINE SLID = SLREC0#;  <<VERSION NR.>>                                 00732000
                                                                        00734000
<<RECORD 1 BUFFER>>                                                     00736000
                                                                        00738000
INTEGER ARRAY SLREC1 (*) = DB;                                          00740000
INTEGER POINTER SSLREC1;  <<SYSTEM SL RECORD 1 BUFFER>>                 00742000
INTEGER POINTER PSLREC1;  <<PUBLIC SL RECORD 1 BUFFER>>                 00744000
INTEGER POINTER GSLREC1;  <<GROUP SL RECORD 1 BUFFER>>                  00746000
                                                                        00748000
<<DIRECTORY BUFFER AND PARAMETERS>>                                     00750000
                                                                        00752000
INTEGER ARRAY SLDIR (*) = BUF2;  <<DIRECTORY BUFFER (128)>>             00754000
INTEGER POINTER SLP;  <<POINTS TO FIRST WORD OF ENTRY>>                 00756000
INTEGER POINTER SLP1;  <<SECONDARY POINTER>>                            00758000
DEFINE SLNAME = SLP#,  <<ENTRY POINT NAME>>                             00760000
       SLPLABEL = SLP1#,  <<ENTRY POINT P-LABEL>>                       00762000
       SLSTTNR = SLP1.(0:8)#,  <<STT NR. OF ENTRY POINT>>               00764000
       SLSEGNR = SLP1.(8:8)#,  <<ENTRY POINT SEG. NR.>>                 00766000
       SLPARMS = SLP1(1)#;  <<ENTRY POINT PARM. INFO>>                  00768000
                                                                        00770000
<<REFERENCE TABLE BUFFER AND PARAMETERS>>                               00772000
                                                                        00774000
INTEGER ARRAY RTBUF (*) = SLDIR;  <<REFERENCE TABLE BUFFER (128)>>      00776000
INTEGER POINTER RTP;  <<REF. TAB. ENTRY POINTER>>                       00778000
LOGICAL POINTER RTLP = RTP;                                             00780000
DOUBLE POINTER RTDP = RTP;                                              00782000
DOUBLE DRTRECD := 0D;  <<CURRENT REC. NR.>>                             00784000
INTEGER RTRECD = DRTRECD+1;                                             00786000
INTEGER RTMODIFIED := 0;  <<BUFFER MODIFIED?>>                          00788000
DEFINE SLSLD = RTP#,  <<SEGMENT LENGTH DESCRIPTOR>>                     00790000
       SLSL = RTP.(2:14)#,  <<SEGMENT LENGTH>>                          00792000
       SLSA = RTP(1)#,  <<S.A. OF SEGMENT>>                             00794000
       SLNRRECS = RTP(2)#,  <<NR. REC'S FOR SEG. AND EXTN. LIST>>       00796000
       SLFLAGS = RTLP(3)#,  <<SEGMENT FLAGS>>                           00798000
       SLSATISFIEDSEG = RTLP(3).(1:1)#,  <<SATISFIED SEGMENT?>>         00800000
       SLALLOCATEDSEG = RTLP(3).(4:1)#,  <<ALLOCATED SEGMENT?>>         00802000
       SLCORESEG = RTLP(3).(5:1)#,  <<CORE RESIDENT SEGMENT?>>          00804000
       SLSYSTEMSEG = RTLP(3).(6:1)#,  <<SYSTEM SEGMENT?>>               00806000
       SLSEGNAME = RTP(8)#,  <<SEGMENT NAME>>                           00808000
       SLREFEDSEGS = RTP(16)#;  <<SEGMENTS REFERNCED BIT MAP>>          00810000
                                                                        00812000
<<REFERENCED SEGMENT BIT MAPS>>                                         00814000
                                                                        00816000
LOGICAL ARRAY SLSEGS (*) = DB;                                          00818000
LOGICAL ARRAY SSLSEGS (0:15);  <<SYSTEM SL SEGMENTS REFERENCED>>        00820000
LOGICAL ARRAY PSLSEGS (0:15);  <<PUBLIC SL SEGMENTS REFERENCED>>        00822000
LOGICAL ARRAY GSLSEGS (0:15);  <<GROUP SL SEGMENTS REFERENCED>>         00824000
                                                                        00826000
<<SEGMENTS TO BE ALLOCATED BIT MAPS>>                                   00828000
                                                                        00830000
LOGICAL ARRAY SLASEGS (*) = DB;                                         00832000
LOGICAL ARRAY SSLASEGS (0:15);  <<SYSTEM SL SEGMENTS TO BE ALLOCATED>>  00834000
LOGICAL ARRAY PSLASEGS (0:15);  <<PUBLIC SL SEGMENTS TO BE ALLOCATED>>  00836000
LOGICAL ARRAY GSLASEGS (0:15);  <<GROUP SL SEGMENTS TO BE ALLOCATED>>   00838000
                                                                        00840000
<<SEGMENT TO CST MAPS>>                                                 00842000
                                                                        00844000
INTEGER ARRAY SLMAP (*) = DB;                                           00846000
BYTE POINTER SSLMAP;  <<SYSTEM SL SEGMENT TO CST MAP>>                  00848000
BYTE POINTER PSLMAP;  <<PUBLIC SL SEGMENT TO CST MAP>>                  00850000
BYTE POINTER GSLMAP;  <<GROUP SL SEGMENT TO CST MAP>>                   00852000
                                                                        00854000
<<LOADED BIT FLAGS>>                                                    00856000
                                                                        00858000
INTEGER ARRAY SLLOADBIT (*) = DB;                                       00860000
INTEGER SSLLOADBIT := 0;  <<SYSTEM SL LOAD BIT FLAG>>                   00862000
INTEGER PSLLOADBIT := 0;  <<PUBLIC SL LOAD BIT FLAG>>                   00864000
INTEGER GSLLOADBIT := 0;  <<GROUP SL LOAD BIT FLAG>>                    00866000
<<PVINFO WORDS>>                                               <<00211>>00868000
INTEGER ARRAY SLPVINFO (*) = DB;                               <<00211>>00870000
INTEGER                                                        <<00211>>00872000
    SSLPVINFO,                                                 <<00211>>00874000
    PSLPVINFO,                                                 <<00211>>00876000
    GSLPVINFO;                                                 <<00211>>00878000
                                                                        00880000
<<----------------------------------------------------------------------00882000
*                                                                      *00884000
*  SEGMENT TABLE DATA SEGMENT PARAMETERS                               *00886000
*                                                                      *00888000
---------------------------------------------------------------------->>00890000
                                                                        00892000
<<PSEUDO GLOBAL AREA>>                                                  00894000
                                                                        00896000
EQUATE SEGTABDST = 18,  <<SEGMENT TABLE DST NR.>>                       00898000
       SEGTABSIR = 17;  <<SEGMENT TABLE SIR NR.>>                       00900000
INTEGER SO = DB+0;  <<UTILITY INTEGER>>                                 00902000
INTEGER DIRLEN = DB+1;  <<DIRECTORY LENGTH>>                            00904000
DEFINE DIRBND = (DIRLEN-1)#;  <<TABLE BOUND>>                           00906000
INTEGER ARRAY DIR (@) = DB+2;  <<ENTRY TABLE>>                          00908000
INTEGER ARRAY REFCOUNT (@) = DB+3;  <<REFERENCE COUNT TABLE>>           00910000
INTEGER ARRAY XFORM (@) = DB+4;  <<CST TO LCST AND FLAG TABLE>>         00912000
INTEGER ARRAY ENTTAB (@) = DB+5;  <<CST TO ENTRY INDEX TABLE>>          00914000
INTEGER POINTER ENTP2 = DB+6;  <<SECONDARY ENTRY POINTER>>              00916000
BYTE POINTER ENTBP2 = ENTP2;  <<SECONDARY ENTRY POINTER>>               00918000
INTEGER POINTER ENTP = DB+7;  <<ENTRY POINTER>>                         00920000
DOUBLE POINTER ENTDP = ENTP;  <<ENTRY POINTER>>                         00922000
INTEGER POINTER ENTP1 = DB+8;  <<SECONDARY ENTRY POINTER>>              00924000
DOUBLE POINTER ENTDP1 = ENTP1;  <<SECONDARY ENTRY POINTER>>             00926000
INTEGER ARRAY SBUF0 (@) = DB+9;  <<SINGLE RECORD DISC BUFFER>>          00928000
INTEGER ARRAY SBUF1 (@) = DB+10;  <<SINGLE RECORD DISC BUFFER>>         00930000
INTEGER ARRAY SBUF2 (@) = DB+11;  <<SINGLE RECORD DISC BUFFER>>         00932000
INTEGER ARRAY SBUF3 (@) = DB+12;  <<SINGLE RECORD DISC BUFFER>>         00934000
INTEGER ARRAY SBUF4 (@) = DB+13;  <<SINGLE RECORD DISC BUFFER>>         00936000
INTEGER SI = DB+14;  <<UTILITY INTEGER>>                                00938000
INTEGER SJ = DB+15;  <<UTILITY INTEGER>>                                00940000
INTEGER SK = DB+16;  <<UTILITY INTEGER>>                                00942000
INTEGER SL = DB+17;  <<UTILITY INTEGER>>                                00944000
INTEGER SM = DB+18;  <<UTILITY INTEGER>>                                00946000
INTEGER SN = DB+19;  <<UTILITY INTEGER>>                                00948000
INTEGER SP = DB+20;  <<UTILITY INTEGER>>                                00950000
INTEGER SQ = DB+21;  <<UTILITY INTEGER>>                                00952000
INTEGER SR = DB+22;  <<UTILITY INTEGER>>                                00954000
INTEGER SS = DB+23;  <<UTILITY INTEGER>>                                00956000
INTEGER ST = DB+24;  <<UTILITY INTEGER>>                                00958000
                                                                        00960000
<<ENTRY PARAMETERS>>                                                    00962000
                                                                        00964000
DEFINE EPA = ENTP.(7:1)#,  << SET IF PROGRAM ALLOCATED >>               00966000
       ELIB = ENTP.(8:2)#,  << LIBRARY SEARCH >>                        00968000
       EFMODE = ENTP.(10:1)#,  <<FILE MODE>>                            00970000
       EPMODE = ENTP.(11:1)#,  <<PROGRAM MODE>>                         00972000
       EFORMAT = ENTP.(12:1)#,  <<CST FORMAT>>                          00974000
       ETYPE = ENTP.(13:3)#,  <<ENTRY TYPE NR.>>                        00976000
       ENWG = ENTP(1)#,  <<NR. WORDS IN GARBAGE ENTRY>>                 00978000
       EPID = ENTP(1)#,  <<PROCESS ID>>                                 00980000
       EEXT = ENTP(1).(0:8)#,  <<EXTENSION NR.>>                        00982000
       EPIN = ENTP(1).(8:8)#,  <<PIN NUMBER>>                           00984000
       EFID1 = ENTP(1)#,  <<FIRST WORD OF FILE ID>>                     00986000
       EFID2 = ENTP(2)#,  <<SECOND WORD OF FILE ID>>                    00988000
       ECST = ENTP(4)#,   <<CST BLOCK INDEX>>                           00990000
       ESHR = ENTP(5)#,   <<PROGRAM FILE REFERENCE COUNT>>              00992000
       ESEG = ENTP(6)#,   <<# OF SEGMENTS IN FILE>>                     00994000
       EPVINFO'SL = ENTP (3)#,  <<PVINFO FOR SL TYPE ENTRY>>   <<00211>>00996000
       EPVINFO'PROG = ENTP (7)#, <<PVINFO FOR PROG TYPE ENTRY>><<00211>>00998000
       EWAITINGPIN = ENTP1#;  <<PIN OF WAITING PROCESS>>                01000000
EQUATE GARBAGE = 0,  <<GARBAGE ENTRY TYPE NR.>>                         01002000
       SLFILE = 1,  <<SL FILE ENTRY TYPE NR.>>                          01004000
       PROGFILE = 2,  <<PROGRAM FILE ENTRY TYPE NR.>>                   01006000
       LOADING = 3,  <<PROGRAM FILE LOADING ENTRY TYPE NR.>>            01008000
       WAITING = 4,  <<PROCESS WAITING ENTRY TYPE NR.>>                 01010000
       LOADED = 5,  <<PROCESS BLOCKED ENTRY TYPE NR.>>                  01012000
       SHARER = 6,  <<SHARER PROCESS ENTRY TYPE NR.>>                   01014000
       EXTENSION = 7;  <<PROCESS EXTENSION ENTRY TYPE NR.>>             01016000
DEFINE GARBAGEENTRY = (ETYPE = GARBAGE)#,                               01018000
       SLFILEENTRY = (ETYPE = SLFILE)#,                                 01020000
       PROGFILEENTRY = (ETYPE = PROGFILE)#,                             01022000
       SHARERENTRY = (ETYPE = SHARER)#,                                 01024000
       LOADINGENTRY = (ETYPE = LOADING)#,                               01026000
       WAITINGENTRY = (ETYPE = WAITING)#,                               01028000
       EXTENSIONENTRY = (ETYPE = EXTENSION)#;                           01030000
EQUATE BITMAP = 1,  <<CST BIT MAP>>                                     01032000
       ANYMODE = -1,  <<ANY MODE>>                                      01034000
       NORMAL = 0,  <<NORMAL (PRIV.) MODE>>                             01036000
       NOPRIV = 1,  <<NO PRIV. MODE>>                                   01038000
       SLOW = 0,  <<SLOW MODE>>                                         01040000
       FAST = 1,  <<FAST MODE>>                                         01042000
       SSL = 0,  << SYSTEM SL >>                                        01044000
       PSL = 1,  << PUBLIC SL >>                                        01046000
       GSL = 2;  << GROUP SL >>                                         01048000
                                                               <<00807>>01050000
<<LOAD CACHE DECLARATIONS>>                                    <<00807>>01052000
                                                               <<00807>>01054000
DEFINE LOADCACHESEG=ABSOLUTE(ABSOLUTE(%1377)+%1072)#; <<EDS #>><<00807>>01056000
EQUATE BUCKETSIZE = 42,  <<SIZE OF EACH CACHE BUCKET>>         <<00807>>01058000
       CACHEHITS=0,      <<HIT COUNTER POINTER>>               <<00807>>01060000
       CACHEMISSES=2,    <<MISS COUNTER POINTER>>              <<00807>>01062000
       BUCKET0=4,        <<FIRST BUCKET POINTER>>              <<00807>>01064000
       NBUCKETS = 95;    <<NUMBER OF BUCKETS>>                 <<00807>>01066000
LOGICAL ARRAY WBUCKET(0:BUCKETSIZE-1);  <<HOLDS ONE BUCKET>>   <<00807>>01068000
DOUBLE HITS,MISSES;      <<LOCAL CACHE HIT AND MISS COUNTERS>> <<00807>>01070000
<<VARIABLES AND DEFINITIONS FOR CONVERSION OF PROGRAM>>        <<01196>>01072000
<<LOADED WITH EXTENDED CST FIRMWARE BACK TO CURRENT  >>        <<01196>>01074000
<<FIRMWARE.                                          >>        <<01196>>01076000
LOGICAL LASTLOADLOGICAL;                                       <<01196>>01078000
DEFINE REFTAB'EXTSTT = RTP(4).(0:1)#,                          <<01196>>01080000
       PROGEXTSTT = (1:1)#;                                    <<01196>>01082000
<<                                                   >>        <<01196>>01084000
<<----------------------------------------------------------------------01086000
*                                                                      *01088000
*  PROCEDURE DECLARATIONS                                              *01090000
*                                                                      *01092000
---------------------------------------------------------------------->>01094000
                                                                        01096000
PROCEDURE ADJREFCOUNTS (AMOUNT);                                        01098000
   VALUE AMOUNT;                                                        01100000
   INTEGER AMOUNT;                                                      01102000
   OPTION EXTERNAL;                                                     01104000
INTEGER PROCEDURE ALCSTBLOCK(NUM);                                      01106000
   VALUE NUM;                                                           01108000
    INTEGER NUM;                                                        01110000
   OPTION EXTERNAL;                                                     01112000
PROCEDURE AWAKE (PCBINDEX,OLDWAIT,NEWWAIT);                             01114000
   VALUE PCBINDEX,OLDWAIT,NEWWAIT;                                      01116000
   INTEGER PCBINDEX,OLDWAIT,NEWWAIT;                                    01118000
   OPTION EXTERNAL;                                                     01120000
PROCEDURE BLANKLINE;                                                    01122000
   OPTION FORWARD;                                                      01124000
PROCEDURE CLEARBITMAP (BITMAP);                                         01126000
   ARRAY BITMAP;                                                        01128000
   OPTION FORWARD;                                                      01130000
PROCEDURE CLEARBUFFER (BUFFER);                                         01132000
   ARRAY BUFFER;                                                        01134000
   OPTION FORWARD;                                                      01136000
PROCEDURE CLEARLINE;                                                    01138000
   OPTION FORWARD;                                                      01140000
PROCEDURE DEALCSTBLOCK(IX);                                             01142000
   VALUE IX;                                                            01144000
   INTEGER IX;                                                          01146000
   OPTION EXTERNAL;                                                     01148000
DOUBLE PROCEDURE DIRECFIND (T,LINKAGE'INDEXP,ACCT,             <<38.PV>>01150000
                            GROUP,DUM,BUF);                    <<38.PV>>01152000
   VALUE T,LINKAGE'INDEXP;                                     <<38.PV>>01154000
   INTEGER T;                                                  <<38.PV>>01156000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>01158000
   ARRAY ACCT,GROUP,DUM,BUF;                                            01160000
   OPTION EXTERNAL;                                                     01162000
INTEGER PROCEDURE DLSIZE (SIZE);                                        01164000
   VALUE SIZE;                                                          01166000
   INTEGER SIZE;                                                        01168000
   OPTION EXTERNAL;                                                     01170000
INTEGER PROCEDURE EXCHANGEDB (DSTNR);                                   01172000
   VALUE DSTNR; INTEGER DSTNR;                                          01174000
   OPTION EXTERNAL;                                                     01176000
PROCEDURE EXTNPARMS;                                                    01178000
   OPTION FORWARD;                                                      01180000
PROCEDURE FCHECK (FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);               01182000
   VALUE FILENUM;                                                       01184000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              01186000
   DOUBLE BLKNUM;                                                       01188000
   OPTION VARIABLE,EXTERNAL;                                            01190000
PROCEDURE FCLOSE (FILENUM,DISPOSITION,SECCODE);                         01192000
   VALUE FILENUM,DISPOSITION,SECCODE;                                   01194000
   INTEGER FILENUM,DISPOSITION,SECCODE;                                 01196000
   OPTION EXTERNAL;                                                     01198000
INTRINSIC FCONTROL;                                                     01200000
PROCEDURE FERROR (FNUM);                                                01202000
   VALUE FNUM;                                                          01204000
   INTEGER FNUM;                                                        01206000
   OPTION FORWARD;                                                      01208000
DOUBLE PROCEDURE FGETDISKADR (FNUM,RECNUM);                             01210000
   VALUE FNUM,RECNUM;                                                   01212000
   INTEGER FNUM;                                                        01214000
   DOUBLE RECNUM;                                                       01216000
   OPTION EXTERNAL;                                                     01218000
PROCEDURE FGETINFO (FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,         01220000
      DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,         01222000
      PHYSCOUNT,BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABEL,CREATORID,         01224000
      DISKADR);                                                         01226000
   VALUE FILENUM;                                                       01228000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,         01230000
      USERLABEL;                                                        01232000
   BYTE ARRAY FILENAME,CREATORID;                                       01234000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      01236000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;                 01238000
   OPTION VARIABLE,EXTERNAL;                                            01240000
PROCEDURE FLOCK (FILENUM,FLAG);                                         01242000
   VALUE FILENUM,FLAG;                                                  01244000
   INTEGER FILENUM;                                                     01246000
   LOGICAL FLAG;                                                        01248000
   OPTION EXTERNAL;                                                     01250000
INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS,AOPTIONS,RECSIZE,      01252000
      DEVICE,FORMMSG,RECMODE,BLOCKFACTOR,NUMBUFFERS,FILESIZE,           01254000
      NUMEXTENTS,INITALLOC,FILECODE);                                   01256000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,      01258000
      FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                           01260000
   BYTE ARRAY FILEDESIGNATOR,DEVICE,FORMMSG;                            01262000
   LOGICAL FOPTIONS,AOPTIONS;                                           01264000
   INTEGER RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,NUMEXTENTS,           01266000
      INITALLOC,FILECODE;                                               01268000
   DOUBLE FILESIZE;                                                     01270000
   OPTION VARIABLE,EXTERNAL;                                            01272000
INTEGER PROCEDURE FOPENDA (LDNUM,DISKADR,AOPTIONS,NUMBUF,FILECODE,      01274000
   DNTYPE,DISP,FOPTIONS,PVINFO,COMINFO);                       <<01549>>01276000
   VALUE LDNUM,DISKADR,AOPTIONS,NUMBUF,FILECODE,               <<RV.PV>>01278000
         DNTYPE,DISP,FOPTIONS,PVINFO;                          <<01549>>01280000
   INTEGER LDNUM,AOPTIONS,NUMBUF,FILECODE,DNTYPE,DISP,PVINFO,  <<01549>>01282000
     FOPTIONS;                                                 <<01549>>01284000
   ARRAY COMINFO;                                              <<01549>>01286000
   DOUBLE DISKADR;                                                      01288000
   OPTION VARIABLE,EXTERNAL;                                            01290000
PROCEDURE FCLOSEDA (FILENUM,DISP,SECCODE);                     <<RV.PV>>01292000
    VALUE   FILENUM,DISP,SECCODE;                              <<RV.PV>>01294000
    INTEGER FILENUM,DISP,SECCODE;                              <<RV.PV>>01296000
    OPTION EXTERNAL;                                           <<RV.PV>>01298000
INTRINSIC FPOINT;                                                       01300000
INTEGER PROCEDURE FREAD (FILENUM,TARGET,TCOUNT);                        01302000
   VALUE FILENUM,TCOUNT;                                                01304000
   INTEGER FILENUM,TCOUNT;                                              01306000
   INTEGER ARRAY TARGET;                                                01308000
   OPTION EXTERNAL;                                                     01310000
PROCEDURE FREADDIR (FILENUM,TARGET,TCOUNT,RECNUM);                      01312000
   VALUE FILENUM,TCOUNT,RECNUM;                                         01314000
   INTEGER FILENUM,TCOUNT;                                              01316000
   ARRAY TARGET;                                                        01318000
   DOUBLE RECNUM;                                                       01320000
   OPTION EXTERNAL;                                                     01322000
PROCEDURE FUNLOCK (FILENUM);                                            01324000
   VALUE FILENUM;                                                       01326000
   INTEGER FILENUM;                                                     01328000
   OPTION EXTERNAL;                                                     01330000
PROCEDURE FWRITE (FILENUM,TARGET,TCOUNT,CONTROL);                       01332000
   VALUE FILENUM,TCOUNT,CONTROL;                                        01334000
   INTEGER FILENUM,TCOUNT,CONTROL;                                      01336000
   ARRAY TARGET;                                                        01338000
   OPTION EXTERNAL;                                                     01340000
PROCEDURE FWRITEDIR (FILENUM,TARGET,TCOUNT,RECNUM);                     01342000
   VALUE FILENUM,TCOUNT,RECNUM;                                         01344000
   INTEGER FILENUM,TCOUNT;                                              01346000
   ARRAY TARGET;                                                        01348000
   DOUBLE RECNUM;                                                       01350000
   OPTION EXTERNAL;                                                     01352000
INTEGER PROCEDURE GETENTRY(LIST);                                       01354000
   VALUE LIST;                                                          01356000
   INTEGER LIST;                                                        01358000
   OPTION EXTERNAL;                                                     01360000
PROCEDURE GETENTRYS (BUFFER,NRENTRIES,TYPE);                            01362000
   VALUE NRENTRIES,TYPE;                                                01364000
   INTEGER ARRAY BUFFER;                                                01366000
   INTEGER NRENTRIES,TYPE;                                              01368000
   OPTION EXTERNAL;                                                     01370000
PROCEDURE GETREFTABENT (SEGNR);                                         01372000
   VALUE SEGNR;                                                         01374000
   INTEGER SEGNR;                                                       01376000
   OPTION FORWARD;                                                      01378000
LOGICAL PROCEDURE GETSIR (SIR);                                         01380000
   VALUE SIR;                                                           01382000
   INTEGER SIR;                                                         01384000
   OPTION EXTERNAL;                                                     01386000
INTEGER PROCEDURE LDNTOA( NUM, BASE, BA);                      <<00605>>01388000
   VALUE NUM, BASE;                                            <<00605>>01390000
   DOUBLE NUM;                                                 <<00605>>01392000
   INTEGER BASE;                                               <<00605>>01394000
   BYTE ARRAY BA;                                              <<00605>>01396000
   OPTION FORWARD;                                             <<00605>>01398000
INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                       <<00605>>01400000
   VALUE NUM, BASE;                                            <<00605>>01402000
   INTEGER NUM, BASE;                                          <<00605>>01404000
   BYTE ARRAY BA;                                              <<00605>>01406000
   OPTION FORWARD;                                             <<00605>>01408000
INTEGER PROCEDURE MOUNTVOLSET(FILENUM,SOME'OTHER'PIN);         <<00605>>01410000
    VALUE   FILENUM,SOME'OTHER'PIN;                            <<00211>>01412000
    INTEGER FILENUM,SOME'OTHER'PIN;                            <<00211>>01414000
    OPTION EXTERNAL,VARIABLE;                                  <<00211>>01416000
INTEGER PROCEDURE DISMOUNTVOLSET (PVINFO,SOME'OTHER'PIN);      <<00211>>01418000
    VALUE   PVINFO,SOME'OTHER'PIN;                             <<00211>>01420000
    INTEGER PVINFO,SOME'OTHER'PIN;                             <<00211>>01422000
    OPTION EXTERNAL,VARIABLE;                                  <<00211>>01424000
PROCEDURE GETSLNAMES (FLAG);                                            01426000
   VALUE FLAG;                                                          01428000
   LOGICAL FLAG;                                                        01430000
   OPTION FORWARD;                                                      01432000
PROCEDURE HELP;                                                         01434000
   OPTION EXTERNAL;                                                     01436000
PROCEDURE LCREATE (LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY);               01438000
   VALUE LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY;                          01440000
   INTEGER LENGTH,TYPE,FORMAT,PMODE,LIBRARY;                            01442000
   DOUBLE KEY;                                                          01444000
   OPTION EXTERNAL;                                                     01446000
PROCEDURE LDELETE;                                                      01448000
   OPTION EXTERNAL;                                                     01450000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                  <<00807>>01452000
   VALUE      MEMSIZE,VDSIZE;                                  <<00807>>01454000
   INTEGER    MEMSIZE,VDSIZE;                                  <<00807>>01456000
   OPTION     EXTERNAL;                                        <<00807>>01458000
PROCEDURE INITLOADCACHE;                                       <<00807>>01460000
   OPTION EXTERNAL;                                            <<00807>>01462000
INTEGER PROCEDURE LINELENGTH;                                           01464000
   OPTION FORWARD;                                                      01466000
PROCEDURE LOADBIT (KEY,BIT,DSTNR);                                      01468000
   VALUE KEY,BIT,DSTNR;                                                 01470000
   DOUBLE KEY;                                                          01472000
   LOGICAL BIT;                                                         01474000
   INTEGER DSTNR;                                                       01476000
   OPTION EXTERNAL;                                                     01478000
PROCEDURE LOADEXTERNALS;                                                01480000
   OPTION FORWARD;                                                      01482000
PROCEDURE LOADPROGRAM;                                                  01484000
   OPTION FORWARD;                                                      01486000
PROCEDURE LOADSEGMENT (FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD,CSTMAP,  01488000
                       CAPABILITY,PRIVMODE);                   <<00.02>>01490000
   VALUE FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD,              <<00.02>>01492000
         CAPABILITY,PRIVMODE;                                  <<00.02>>01494000
   INTEGER FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD;                     01496000
   LOGICAL CAPABILITY,PRIVMODE;                                <<00.02>>01498000
   BYTE ARRAY CSTMAP;                                                   01500000
   OPTION FORWARD;                                                      01502000
LOGICAL PROCEDURE LSEARCH (KEY,PMODE,TYPE);                             01504000
   VALUE KEY,PMODE,TYPE;                                                01506000
   DOUBLE KEY;                                                          01508000
   INTEGER PMODE,TYPE;                                                  01510000
   OPTION EXTERNAL;                                                     01512000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       01514000
   VALUE NRWORDS; INTEGER NRWORDS;                                      01516000
   OPTION FORWARD;                                                      01518000
PROCEDURE NTOA (NUM,BASE,BUF);                                          01520000
   VALUE NUM,BASE;                                                      01522000
   INTEGER NUM,BASE;                                                    01524000
   BYTE ARRAY BUF;                                                      01526000
   OPTION FORWARD;                                                      01528000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                   <<00605>>01530000
   INTEGER ARRAY FORMALP,ACTUALP,PARMS;                        <<00605>>01532000
   OPTION FORWARD;                                                      01534000
INTEGER PROCEDURE PARMLEN (PARMS);                                      01536000
   INTEGER ARRAY PARMS;                                                 01538000
   OPTION FORWARD;                                                      01540000
INTEGER PROCEDURE PHYSICALCST (PIN,SEGMENTNR);                 <<00659>>01542000
   VALUE PIN,SEGMENTNR;                                        <<00659>>01544000
   INTEGER PIN,SEGMENTNR;                                      <<00659>>01546000
   OPTION EXTERNAL;                                            <<00659>>01548000
PROCEDURE PRINTLINE;                                                    01550000
   OPTION FORWARD;                                                      01552000
PROCEDURE PRINTLINE';                                                   01554000
   OPTION FORWARD;                                                      01556000
PROCEDURE PUTCST(EN,MASK,DEV,DISKADR,SYSFLAG);                 <<03772>>01558000
   VALUE EN,MASK,DEV,DISKADR,SYSFLAG;                          <<03772>>01560000
   INTEGER EN,MASK,DEV;                                                 01562000
   DOUBLE DISKADR;                                                      01564000
   LOGICAL SYSFLAG;                                            <<03772>>01566000
   OPTION EXTERNAL;                                                     01568000
PROCEDURE PUTCSTBLOCK(EIX,LSEGNUM,MASK,DEV,DISKADR,SYSFLAG);   <<03772>>01570000
   VALUE EIX,LSEGNUM,MASK,DEV,DISKADR,SYSFLAG;                 <<03772>>01572000
   INTEGER EIX,LSEGNUM,MASK,DEV;                                        01574000
   DOUBLE DISKADR;                                                      01576000
   LOGICAL SYSFLAG;                                            <<03772>>01578000
   OPTION EXTERNAL;                                                     01580000
PROCEDURE RELCODESEG (CSTNR);                                           01582000
   VALUE CSTNR;                                                         01584000
   INTEGER CSTNR;                                                       01586000
   OPTION EXTERNAL;                                                     01588000
PROCEDURE RELSIR (SIR,FLAG);                                            01590000
   VALUE SIR,FLAG;                                                      01592000
   INTEGER SIR,FLAG;                                                    01594000
   OPTION EXTERNAL;                                                     01596000
PROCEDURE RETURNENTRY (TYPE,ENTRYNR);                                   01598000
   VALUE TYPE,ENTRYNR;                                                  01600000
   INTEGER TYPE,ENTRYNR;                                                01602000
   OPTION EXTERNAL;                                                     01604000
LOGICAL PROCEDURE SAMENAME (NAME1,NAME2);                               01606000
   INTEGER ARRAY NAME1,NAME2;                                           01608000
   OPTION FORWARD;                                                      01610000
PROCEDURE SATISFYPROC;                                                  01612000
   OPTION FORWARD;                                                      01614000
PROCEDURE SATISFYPROG;                                                  01616000
   OPTION FORWARD;                                                      01618000
PROCEDURE SATISFY;                                                      01620000
   OPTION FORWARD;                                                      01622000
PROCEDURE SAVEREFTABBUF;                                                01624000
   OPTION FORWARD;                                                      01626000
LOGICAL PROCEDURE SEARCHSL (NAME);                                      01628000
   INTEGER ARRAY NAME;                                                  01630000
   OPTION FORWARD;                                                      01632000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  01634000
   VALUE BITNUMBER;                                                     01636000
   INTEGER ARRAY BITARRAY;                                              01638000
   INTEGER BITNUMBER;                                                   01640000
   OPTION FORWARD;                                                      01642000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         01644000
   VALUE BITNUMBER;                                                     01646000
   INTEGER ARRAY BITARRAY;                                              01648000
   INTEGER BITNUMBER;                                                   01650000
   OPTION FORWARD;                                                      01652000
PROCEDURE UNIMPEDE(P);                                                  01654000
   VALUE P;                                                             01656000
   INTEGER P;                                                           01658000
   OPTION EXTERNAL;                                                     01660000
PROCEDURE UPDATESEGTAB;                                                 01662000
   OPTION FORWARD;                                                      01664000
PROCEDURE VALIDCAP (FLAG);                                              01666000
   VALUE FLAG;                                                          01668000
   LOGICAL FLAG;                                                        01670000
   OPTION FORWARD;                                                      01672000
                                                                        01674000
<<----------------------------------------------------------------------01676000
*                                                                      *01678000
*  UTILITY PROCEDURES                                                  *01680000
*                                                                      *01682000
---------------------------------------------------------------------->>01684000
                                                                        01686000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         01688000
   <<TESTS BIT NUMBER BITNUMBER IN THE BIT ARRAY BITARRAY>>             01690000
   VALUE BITNUMBER;                                                     01692000
   INTEGER ARRAY BITARRAY;                                              01694000
   INTEGER BITNUMBER;                                                   01696000
   OPTION UNCALLABLE;                                                   01698000
   BEGIN                                                                01700000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                                   01702000
   TOS := PS0;                                                          01704000
   XREG := BITNUMBER.(12:4);                                            01706000
   ASSEMBLE(CSL 1,X);                                                   01708000
   TESTBIT := TOS                                                       01710000
   END;                                                                 01712000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  01714000
   <<SETS BIT NUMBER BITNUMBER IN THE BIT ARRAY BITARRAY>>              01716000
   VALUE BITNUMBER;                                                     01718000
   INTEGER ARRAY BITARRAY;                                              01720000
   INTEGER BITNUMBER;                                                   01722000
   OPTION UNCALLABLE;                                                   01724000
   BEGIN                                                                01726000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                                   01728000
   TOS := PS0;                                                          01730000
   XREG := BITNUMBER;                                                   01732000
   ASSEMBLE(TSBC 0,X);                                                  01734000
   PS1 := TOS                                                           01736000
   END;                                                                 01738000
PROCEDURE RESETBIT (BITARRAY,BITNUMBER);                       <<RV.PV>>01740000
   <<RESETS BIT NUMBER BITNUMBER IN THE BIT ARRAY BITARRAY>>   <<RV.PV>>01742000
   VALUE BITNUMBER;                                            <<RV.PV>>01744000
   INTEGER ARRAY BITARRAY;                                     <<RV.PV>>01746000
   INTEGER BITNUMBER;                                          <<RV.PV>>01748000
   OPTION UNCALLABLE;                                          <<RV.PV>>01750000
   BEGIN                                                       <<RV.PV>>01752000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                          <<RV.PV>>01754000
   TOS := PS0;                                                 <<RV.PV>>01756000
   XREG := BITNUMBER;                                          <<RV.PV>>01758000
   ASSEMBLE(TRBC 0,X);                                         <<RV.PV>>01760000
   PS1 := TOS                                                  <<RV.PV>>01762000
   END;                                                        <<RV.PV>>01764000
PROCEDURE CLEARBITMAP (BITMAP);                                         01766000
   <<CLEARS A 16 WORD BIT MAP>>                                         01768000
   ARRAY BITMAP;                                                        01770000
   OPTION UNCALLABLE;                                                   01772000
   BEGIN                                                                01774000
   TOS := @BITMAP; PS0 := 0;                                            01776000
   ASSEMBLE(DUP,INCB); TOS := 15; ASSEMBLE(MOVE 3)                      01778000
   END;                                                                 01780000
PROCEDURE CLEARBUFFER (BUFFER);                                         01782000
   <<CLEARS A 128 WORD BUFFER>>                                         01784000
   ARRAY BUFFER;                                                        01786000
   OPTION UNCALLABLE;                                                   01788000
   BEGIN                                                                01790000
   TOS := @BUFFER; PS0 := 0;                                            01792000
   ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3)                     01794000
   END;                                                                 01796000
LOGICAL PROCEDURE SAMENAME (NAME1,NAME2);                               01798000
   <<COMPARES TWO NAMES (THE FIRST BYTE BEING THE NUMBER OF CHARACTERS) 01800000
     AND RETURNS TRUE IF THEY ARE THE SAME; OTHERWISE RETURNS FALSE>>   01802000
   INTEGER ARRAY NAME1,NAME2;                                           01804000
   OPTION UNCALLABLE;                                                   01806000
   BEGIN                                                                01808000
   INTEGER RESULT = SAMENAME;                                           01810000
   TOS := @NAME1&LSL(1);                                                01812000
   TOS := @NAME2&LSL(1);                                                01814000
   ASSEMBLE(INCA,INCB);                                                 01816000
   TOS := NAME1.(4:4);                                                  01818000
   IF NAME2.(4:4) = S0 AND * = *,(TOS) THEN RESULT := RESULT+1          01820000
   END;                                                                 01822000
PROCEDURE  CLOSE(F);                                                    01824000
   INTEGER F;                                                           01826000
<< CLOSES THE FILE IF IT EXISTS, ZEROS THE FILE NUMBER >>               01828000
   BEGIN                                                                01830000
   IF  F <> 0  THEN                                                     01832000
      BEGIN                                                             01834000
      IF TESTBIT (FDA,F) THEN                                  <<RV.PV>>01836000
      BEGIN                                                    <<RV.PV>>01838000
          RESETBIT (FDA,F);                                    <<RV.PV>>01840000
          FCLOSEDA (F,0,0);                                    <<RV.PV>>01842000
      END ELSE                                                 <<RV.PV>>01844000
      FCLOSE(F,0,0);                                                    01846000
      F := 0;                                                           01848000
      END;                                                              01850000
   END;                                                                 01852000
PROCEDURE FERROR (FNUM);                                                01854000
   <<DETERMINES THE ERROR NUMBER FOR THE EOF OR I/O ERROR JUST          01856000
     DETECTED>>                                                         01858000
   VALUE FNUM;                                                          01860000
   INTEGER FNUM;                                                        01862000
   OPTION UNCALLABLE;                                                   01864000
   BEGIN                                                                01866000
   TOS := FNUM;                                                         01868000
   ASSEMBLE(DUP,DUP);                                                   01870000
   XREG := 0;                                                           01872000
   IF TOS = SSLFNUM THEN GO L1;                                         01874000
   XREG := 1;                                                           01876000
   IF TOS = PSLFNUM THEN GO L1;                                         01878000
   XREG := 2;                                                           01880000
   IF TOS = GSLFNUM THEN GO L1;                                         01882000
   XREG := 3;                                                           01884000
   L1:                                                                  01886000
   MERROR := ERR60+XREG;  <<ERROR NR.>>                                 01888000
   FCHECK(FNUM,MFERROR)  <<FILE SYS. ERROR NR.>>                        01890000
   END;                                                                 01892000
PROCEDURE PRINTBITMAP( MAP);                                   <<00605>>01894000
   ARRAY MAP;                                                  <<00605>>01896000
   OPTION UNCALLABLE;                                          <<00605>>01898000
BEGIN                                                          <<00605>>01900000
   INTEGER COL, I;                                             <<00605>>01902000
   LOGICAL FIRSTPARM := TRUE;                                  <<00605>>01904000
                                                               <<00605>>01906000
   COL := (-LINELENGTH)+1;                                     <<00605>>01908000
   FOR *I := 0 UNTIL %77 DO                                    <<00605>>01910000
      BEGIN                                                    <<00605>>01912000
      IF COL > 66 THEN                                         <<00605>>01914000
         BEGIN                                                 <<00605>>01916000
         PRINTLINE';                                           <<00605>>01918000
         IF <> THEN GO ABORT;                                  <<00605>>01920000
         COL := 0;                                             <<00605>>01922000
         END;                                                  <<00605>>01924000
      IF TESTBIT( MAP, I) THEN                                 <<00605>>01926000
         BEGIN                                                 <<00605>>01928000
         IF COL <> 0 AND NOT FIRSTPARM THEN                    <<00605>>01930000
            BEGIN                                              <<00605>>01932000
            BLINE(COL) := ",";                                 <<00605>>01934000
            COL:=COL+1;                                        <<00605>>01936000
            END;                                               <<00605>>01938000
         FIRSTPARM := FALSE;                                   <<00605>>01940000
         COL := COL+LNTOA(I+1,10,BLINE(COL));                  <<00605>>01942000
         END;                                                  <<00605>>01944000
      END;                                                     <<00605>>01946000
   IF COL <> 0 THEN                                            <<00605>>01948000
      BEGIN                                                    <<00605>>01950000
      PRINTLINE';                                              <<00605>>01952000
      IF <> THEN GO ABORT;                                     <<00605>>01954000
      END;                                                     <<00605>>01956000
   CLEARLINE;                                                  <<00605>>01958000
                                                               <<00605>>01960000
   CONDCODE := CCE;                                            <<00605>>01962000
   RETURN;                                                     <<00605>>01964000
                                                               <<00605>>01966000
ABORT:                                                         <<00605>>01968000
   CONDCODE := CCL;                                            <<00605>>01970000
END;                                                           <<00605>>01972000
PROCEDURE CLEARLINE;                                                    01974000
   <<CLEARS THE LIST BUFFER>>                                           01976000
   OPTION UNCALLABLE;                                                   01978000
   BEGIN                                                                01980000
   TOS := @LINE; PS0 := "  ";                                           01982000
   ASSEMBLE(DUP,INCB); TOS := 35; ASSEMBLE(MOVE 3)                      01984000
   END;                                                                 01986000
INTEGER PROCEDURE LINELENGTH;                                           01988000
   <<RETURNS THE NEGATIVE NUMBER OF CHARACTERS IN THE LIST BUFFER>>     01990000
   OPTION UNCALLABLE;                                                   01992000
   BEGIN                                                                01994000
   TOS := @BLINE(71);  <<POINTER TO LAST CHAR.>>                        01996000
   IF BPS0 = " " THEN                                                   01998000
      BEGIN                                                             02000000
      ASSEMBLE(DUP,DECB);                                               02002000
      TOS := -71;                                                       02004000
      ASSEMBLE(CMPB 2)                                                  02006000
      END;                                                              02008000
   LINELENGTH := -(TOS-@BLINE+1);  <<NEG. NR. CHAR'S>>                  02010000
   END;                                                                 02012000
PROCEDURE PRINTLINE;                                                    02014000
   <<PRINTS THE CONTENTS OF THE LIST BUFFER ON THE LIST FILE.           02016000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE                   02018000
     TO INDICATE AN ERROR>>                                             02020000
   OPTION UNCALLABLE;                                                   02022000
   BEGIN                                                                02024000
   ENTRY BLANKLINE,PRINTLINE';                                          02026000
                                                                        02028000
   BLANKLINE:                                                           02030000
   IF MLMAP THEN  <<LISTING WANTED?>>                                   02032000
      BEGIN                                                             02034000
      PRINTLINE':                                                       02036000
      FWRITE(LISTFNUM,LINE,LINELENGTH,0);                               02038000
      IF <> THEN  <<ERROR?>>                                            02040000
         BEGIN                                                          02042000
         TOS := ERR64; GO ABORT                                         02044000
         END;                                                           02046000
      LISTFLAG := TRUE;                                                 02048000
      END;                                                              02050000
   TOS := CCE;  <<OK CONDITION CODE>>                                   02052000
   GO GETOUT;                                                           02054000
                                                                        02056000
   ABORT:                                                               02058000
   MERROR := TOS;  <<ERROR NR.>>                                        02060000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                02062000
                                                                        02064000
   GETOUT:                                                              02066000
   CLEARLINE;                                                           02068000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            02070000
   END;                                                                 02072000
PROCEDURE NTOA (NUM,BASE,BUF);                                          02074000
   <<CONVERTS THE SPECIFIED NUMBER INTO AN ASCII STRING THAT IS RIGHT   02076000
     JUSTIFIED IN THE SPECIFIED BUFFER>>                                02078000
   VALUE NUM,BASE;                                                      02080000
   INTEGER NUM,BASE;                                                    02082000
   BYTE ARRAY BUF;                                                      02084000
   OPTION UNCALLABLE;                                                   02086000
   BEGIN                                                                02088000
   BUF(0) := "0";                                                       02090000
   WHILE NUM <> 0 DO                                                    02092000
      BEGIN                                                             02094000
      TOS := 0; TOS := NUM; TOS := BASE;                                02096000
      ASSEMBLE(LDIV);                                                   02098000
      BUF(XREG) := TOS+%60;                                             02100000
      NUM := TOS;                                                       02102000
      XREG := XREG-1                                                    02104000
      END                                                               02106000
   END;                                                                 02108000
   INTEGER PROCEDURE LDNTOA(NUM, BASE, BA);                    <<00605>>02110000
      VALUE NUM, BASE;                                         <<00605>>02112000
      DOUBLE NUM;                                              <<00605>>02114000
      INTEGER BASE;                                            <<00605>>02116000
      BYTE ARRAY BA;                                           <<00605>>02118000
      OPTION UNCALLABLE;                                       <<00605>>02120000
   BEGIN                                                       <<00605>>02122000
      BYTE ARRAY BUF(0:11)=Q;                                  <<00605>>02124000
                                                               <<00605>>02126000
      XREG := 12;                                              <<00605>>02128000
      DO BEGIN                                                 <<00605>>02130000
         ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;             <<00605>>02132000
                  LDD NUM; DELB; LOAD BASE; LDIV;              <<00605>>02134000
                  ADDI %60);                                   <<00605>>02136000
         BUF(XREG:=XREG-1) := TOS;                             <<00605>>02138000
         NUM := TOS;                                           <<00605>>02140000
         END UNTIL NUM=0D;                                     <<00605>>02142000
      MOVE BA := BUF(XREG),(LDNTOA:=12-XREG);                  <<00605>>02144000
   END;                                                        <<00605>>02146000
   INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                    <<00605>>02148000
      VALUE NUM, BASE;                                         <<00605>>02150000
      INTEGER NUM, BASE;                                       <<00605>>02152000
      BYTE ARRAY BA;                                           <<00605>>02154000
      OPTION UNCALLABLE;                                       <<00605>>02156000
      LNTOA := LDNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);           <<00605>>02158000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       02160000
   <<CHECKS THE AMOUNT OF AVAILABLE DL TO SEE IF THERE IS ROOM FOR      02162000
     THE SPECIFIED NUMBER OF WORDS.  IF NOT, THE DL AREA IS EXPANDED    02164000
     BY THE NECESSARY AMOUNT.  NOTE THAT THIS PROCEDURE USES THE        02166000
     CONDITION CODE TO INDICATE AN ERROR>>                              02168000
   VALUE NRWORDS;                                                       02170000
   INTEGER NRWORDS;                                                     02172000
   OPTION UNCALLABLE;                                                   02174000
   BEGIN                                                                02176000
   INTEGER NWAVAIL = Q+1;                                               02178000
   TOS := @DLAREA1-@DLAVAIL;  <<NR. WORDS AVAILABLE>>                   02180000
   IF NRWORDS > NWAVAIL THEN  <<NOT ENOUGH ROOM?>>                      02182000
      BEGIN                                                             02184000
                                                                        02186000
      <<* * * EXPAND DL AREA * * *>>                                    02188000
                                                                        02190000
      TOS := 0;  <<FOR RESULT OF DLSIZE>>                               02192000
      TOS := @DLAREA2;                                                  02194000
      TOS := DLINCREMENT;  <<INIT. INCREMENT>>                          02196000
      WHILE NRWORDS > S0+NWAVAIL DO TOS := TOS+DLINCREMENT;             02198000
      TOS := TOS-TOS;  <<NEW DL LIMIT>>                                 02200000
      TOS := DLSIZE(*);  <<EXPAND DL AREA>>                             02202000
                                                                        02204000
      <<* * * MOVE TABLES AND FIX POINTERS IN AREA 2 * * *>>            02206000
                                                                        02208000
      MOVE PS0 := DLAREA2,(@DLAVAIL-@DLAREA2);  <<MOVE TABLES>>         02210000
      TOS := TOS-@DLAREA2;  <<POINTER FIX TERM>>                        02212000
      @SAVEUXP := @SAVEUXP+S0;                                          02214000
      @UXP := @UXP+S0;                                                  02216000
      @UXP1 := @UXP1+S0;                                                02218000
      @UXP2 := @UXP2+S0;                                                02220000
      @DLAREA2 := @DLAREA2+S0;                                          02222000
      @DLAVAIL := TOS+@DLAVAIL;                                         02224000
      END;                                                              02226000
   IF NRWORDS > @DLAREA1-@DLAVAIL THEN  <<STILL NO ROOM?>>              02228000
      BEGIN                                                             02230000
      TOS := ERR71; GO ABORT                                            02232000
      END;                                                              02234000
   TOS := CCE;  <<OK CONDITION CODE>>                                   02236000
   GO GETOUT;                                                           02238000
                                                                        02240000
   ABORT:                                                               02242000
   MERROR := TOS;  <<ERROR NR.>>                                        02244000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                02246000
                                                                        02248000
   GETOUT:                                                              02250000
   CONDCODE := TOS                                                      02252000
   END;                                                                 02254000
INTEGER PROCEDURE PARMLEN (PARMS);                                      02256000
   <<RETURNS THE NUMBER OF WORDS IN THE SPECIFIED PARAMETER INFO BLOCK>>02258000
   INTEGER ARRAY PARMS;                                                 02260000
   OPTION UNCALLABLE;                                                   02262000
   BEGIN                                                                02264000
   INTEGER P = Q+1;                                                     02266000
   TOS := PARMS.(0:2);  <<LEVEL OF CHECKING>>                           02268000
   PARMLEN := IF = THEN 1 ELSE IF P = 3 THEN PARMS.(2:6)+2 ELSE 2       02270000
   END;                                                                 02272000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                   <<00605>>02274000
   <<CHECKS FOR COMPATABILITY BETWEEN THE ACTUAL PARAMETER INFO BLOCK   02276000
     AND THE FORMAL PARAMETER INFO BLOCK>>                              02278000
   INTEGER ARRAY FORMALP,ACTUALP,PARMS;                        <<00605>>02280000
   OPTION UNCALLABLE;                                                   02282000
   BEGIN                                                                02284000
   INTEGER P = Q+1;  <<LEVEL OF CHECKING>>                              02286000
   INTEGER POINTER PARMMAP = Q+2; <<BAD PARMS BIT MAP>>        <<00605>>02288000
                                                                        02290000
   <<* * * LEVEL 0 - NO CHECKING * * *>>                                02292000
                                                                        02294000
   PARMS := 0;                                                 <<00605>>02296000
   MOVE PARMS(1) := PARMS,(4);                                 <<00605>>02298000
   TOS := FORMALP.(0:2); TOS := ACTUALP.(0:2);                          02300000
   ASSEMBLE(DDUP,CMP);                                                  02302000
   IF > THEN ASSEMBLE(XCH);                                             02304000
   ASSEMBLE(DEL,TEST);                                                  02306000
   IF = THEN GO MATCH;                                                  02308000
   TOS := @PARMS(1);  <<INITIALIZE PARMMAP>>                   <<00605>>02310000
                                                                        02312000
   <<* * * LEVEL 1 - PROCEDURE TYPE * * *>>                             02314000
                                                                        02316000
   TOS := FORMALP(1);                                                   02318000
   IF = THEN GO L1;                                                     02320000
   TOS := ACTUALP(XREG);                                                02322000
   IF = THEN GO L1;                                                     02324000
   IF TOS <> TOS OR                                            <<00605>>02326000
      FORMALP.(8:8) <> ACTUALP.(8:8) THEN                      <<00605>>02328000
      BEGIN                                                    <<00605>>02330000
      PARMS := 1;                                              <<00605>>02332000
      RETURN;                                                  <<00605>>02334000
      END;                                                     <<00605>>02336000
   L1: IF P = 1 THEN GO MATCH;                                          02338000
                                                                        02340000
   <<* * * LEVEL 2 - NUMBER OF PARAMETERS * * *>>                       02342000
                                                                        02344000
   TOS := FORMALP.(2:6);                                                02346000
   TOS := ACTUALP.(2:6);                                                02348000
   ASSEMBLE(DDUP,CMP);                                                  02350000
   IF <> THEN                                                  <<00605>>02352000
      BEGIN                                                    <<00605>>02354000
      PARMS := 2;                                              <<00605>>02356000
      RETURN;                                                  <<00605>>02358000
      END;                                                     <<00605>>02360000
   IF P = 2 THEN GO MATCH;                                              02362000
                                                                        02364000
   <<* * * LEVEL 3 - PARAMETER TYPES * * *>>                            02366000
                                                                        02368000
   ASSEMBLE(DEL,TEST);                                                  02370000
   IF = THEN GO MATCH;  <<CHECK FOR NO PARM'S>>                         02372000
   AGAIN:                                                               02374000
   XREG := XREG+1;                                                      02376000
   TOS := FORMALP(XREG);                                                02378000
   IF = THEN GO DEL1;                                                   02380000
   TOS := ACTUALP(XREG);                                                02382000
   IF = THEN GO DEL2;                                                   02384000
                                                                        02386000
   <<CHECK MODE>>                                                       02388000
                                                                        02390000
   TOS := FORMALP(XREG).(0:4);                                          02392000
   TOS := ACTUALP(XREG).(0:4);                                          02394000
   ASSEMBLE(DDUP,CMP);                                                  02396000
   IF <> THEN                                                           02398000
      IF S0 <> 4 AND S1 <> 4 THEN                              <<00605>>02400000
         BEGIN                                                 <<00605>>02402000
         PARMS := 3;                                           <<00605>>02404000
         SETBIT( PARMMAP, XREG-2);                             <<00605>>02406000
         END;                                                  <<00605>>02408000
                                                                        02410000
   <<CHECK STRUCTURE>>                                                  02412000
                                                                        02414000
   TOS := FORMALP(XREG).(4:6);                                          02416000
   TOS := ACTUALP(XREG).(4:6);                                          02418000
   ASSEMBLE(DDUP,CMP);                                                  02420000
   IF <> THEN                                                           02422000
      IF S1 <> 0 OR S0 <> 1 AND S0 <> 2 THEN                   <<00605>>02424000
         BEGIN                                                 <<00605>>02426000
         PARMS := 3;                                           <<00605>>02428000
         SETBIT( PARMMAP, XREG-2);                             <<00605>>02430000
         END;                                                  <<00605>>02432000
                                                                        02434000
   <<CHECK TYPE>>                                                       02436000
                                                                        02438000
   TOS := FORMALP(XREG).(10:6);                                         02440000
   TOS := ACTUALP(XREG).(10:6);                                         02442000
   ASSEMBLE(DDUP,CMP);                                                  02444000
   IF <> THEN                                                           02446000
      IF S0 <> 11 AND S1 <> 11 THEN                            <<00605>>02448000
         BEGIN                                                 <<00605>>02450000
         PARMS := 3;                                           <<00605>>02452000
         SETBIT( PARMMAP, XREG-2);                             <<00605>>02454000
         END;                                                  <<00605>>02456000
                                                                        02458000
   ASSEMBLE(SUBS 6);                                                    02460000
   DEL2: DEL;                                                           02462000
   DEL1 : DEL;                                                          02464000
   ASSEMBLE(DABZ MATCH);                                                02466000
   GO AGAIN;                                                            02468000
                                                                        02470000
   MATCH:                                                      <<00605>>02472000
   END;                                                        <<00605>>02474000
                                                               <<00807>>02476000
LOGICAL PROCEDURE SCANCACHE (NAME,BUCKET);                     <<00807>>02478000
  <<SCAN BUCKET IN LOAD CACHE FOR SL DIRECTORY ENTRY>>         <<00807>>02480000
  <<FOR SEGMENT NAME.  IF SUCCESSFUL, MOVE ENTRY TO >>         <<00807>>02482000
  <<FRONT OF BUCKET AND RETURN TRUE, ELSE FALSE.    >>         <<00807>>02484000
  VALUE BUCKET;                                                <<00807>>02486000
  INTEGER BUCKET;        <<HASH BUCKET NUMBER>>                <<00807>>02488000
  INTEGER ARRAY NAME;    <<SEGMENT NAME>>                      <<00807>>02490000
  OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                       <<00807>>02492000
  BEGIN                                                        <<00807>>02494000
    INTEGER BUCKETP,LENGTH;                                    <<00807>>02496000
    LOGICAL ARRAY WORKAREA(0:BUCKETSIZE-1)=Q;                  <<00807>>02498000
    IF SLNR=0 AND LOADCACHESEG<>0 THEN                         <<00807>>02500000
      BEGIN  <<SYSTEM SL AND A CACHE EXISTS>>                  <<00807>>02502000
                                                               <<00807>>02504000
        <<MOVE CACHE BUCKET TO STACK>>                         <<00807>>02506000
                                                               <<00807>>02508000
        TOS:=@WBUCKET;                   <<TARGET>>            <<00807>>02510000
        TOS:=LOADCACHESEG;               <<SOURCE SEGMENT>>    <<00807>>02512000
        TOS:=BUCKET*BUCKETSIZE+BUCKET0;  <<SOURCE>>            <<00807>>02514000
        TOS:=BUCKETSIZE;                 <<LENGTH>>            <<00807>>02516000
        ASSEMBLE(MFDS 4);                <<MOVE>>              <<00807>>02518000
                                                               <<00807>>02520000
        <<SCAN FOR ENTRY IN BUCKET>>                           <<00807>>02522000
                                                               <<00807>>02524000
        BUCKETP:=0;                                            <<00807>>02526000
        WHILE BUCKETP+(LENGTH:=WBUCKET(BUCKETP))<=BUCKETSIZE   <<00807>>02528000
                        AND BUCKETP<BUCKETSIZE                 <<00807>>02530000
          DO IF SAMENAME(NAME,WBUCKET(BUCKETP+1))              <<00807>>02532000
            THEN                                               <<00807>>02534000
              BEGIN   <<ENTRY IS IN CACHE BUCKET>>             <<00807>>02536000
                IF BUCKETP<>0 THEN  <<NOT AT FRONT OF BUCKET>> <<00807>>02538000
                  BEGIN    <<MUST MOVE TO FRONT>>              <<00807>>02540000
                    MOVE WORKAREA:=WBUCKET(BUCKETP),(LENGTH);  <<00807>>02542000
                    MOVE WBUCKET(BUCKETP+LENGTH-1):=           <<00807>>02544000
                         WBUCKET(BUCKETP-1),(-BUCKETP);        <<00807>>02546000
                    MOVE WBUCKET:=WORKAREA,(LENGTH);           <<00807>>02548000
                                                               <<00807>>02550000
                    <<MOVE TO CACHE>>                          <<00807>>02552000
                                                               <<00807>>02554000
                    TOS:=LOADCACHESEG;      <<TARGET SEGMENT>> <<00807>>02556000
                    TOS:=BUCKET*BUCKETSIZE+BUCKET0;  <<TARGET>><<00807>>02558000
                    TOS:=@WBUCKET;             <<SOURCE>>      <<00807>>02560000
                    TOS:=BUCKETSIZE;           <<LENGTH>>      <<00807>>02562000
                    ASSEMBLE(MTDS 4);          <<MOVE>>        <<00807>>02564000
                  END;                                         <<00807>>02566000
                                                               <<00807>>02568000
                <<SET UP POINTERS>>                            <<00807>>02570000
                                                               <<00807>>02572000
                @SLP:=@WBUCKET+1;                              <<00807>>02574000
                @SLP1:=@SLP+SLP.(4:3)+1;                       <<00807>>02576000
                SCANCACHE:=TRUE;                               <<00807>>02578000
                RETURN;                                        <<00807>>02580000
              END                                              <<00807>>02582000
            ELSE BUCKETP:=BUCKETP+LENGTH;                      <<00807>>02584000
      END;                                                     <<00807>>02586000
  END;                                                         <<00807>>02588000
                                                               <<00807>>02590000
PROCEDURE ADDTOCACHE (DIRENTRY,LENGTH,BUCKET);                 <<00807>>02592000
  <<ADDS DIRECTORY ENTRY OF GIVEN LENGTH TO CACHE BUCKET>>     <<00807>>02594000
  VALUE LENGTH,BUCKET;                                         <<00807>>02596000
  INTEGER POINTER DIRENTRY;   <<DIRECTORY DIRENTRY POINTER>>   <<00807>>02598000
  INTEGER LENGTH;          <<LENGTH OF DIRECTORY ENTRY>>       <<00807>>02600000
  INTEGER BUCKET;          <<HASH BUCKET>>                     <<00807>>02602000
  OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                       <<00807>>02604000
  BEGIN                                                        <<00807>>02606000
    INTEGER BUCKETSTART,BUCKETEND,LENGTH1;                     <<00807>>02608000
    IF LOADCACHESEG<>0 AND LENGTH<BUCKETSIZE THEN              <<00807>>02610000
      BEGIN  <<CACHE EXISTS AND ENTRY FITS IN BUCKET>>         <<00807>>02612000
                                                               <<00807>>02614000
        <<MAKE ROOM FOR ENTRY AT FRONT OF BUCKET>>             <<00807>>02616000
                                                               <<00807>>02618000
        LENGTH1:=LENGTH+1;                                     <<00807>>02620000
        BUCKETSTART:=BUCKET*BUCKETSIZE+BUCKET0;                <<00807>>02622000
        BUCKETEND:=BUCKETSTART+BUCKETSIZE-1;                   <<00807>>02624000
        TOS:=LOADCACHESEG;           <<TARGET SEGMENT>>        <<00807>>02626000
        TOS:=BUCKETEND;              <<TARGET>>                <<00807>>02628000
        TOS:=LOADCACHESEG;           <<SOURCE SEGMENT>>        <<00807>>02630000
        TOS:=BUCKETEND-LENGTH1;      <<SOURCE>>                <<00807>>02632000
        TOS:=LENGTH1-BUCKETSIZE;     <<LENGTH>>                <<00807>>02634000
        ASSEMBLE(MDS 4);        <<MOVE - SAVE TARGET SEGMENT>> <<00807>>02636000
                                                               <<00807>>02638000
        <<MOVE IN NEW ENTRY>>                                  <<00807>>02640000
                                                               <<00807>>02642000
        TOS:=BUCKETSTART;      <<TARGET>>                      <<00807>>02644000
        TOS:=@LENGTH1;         <<SOURCE>>                      <<00807>>02646000
        TOS:=1;                <<LENGTH>>                      <<00807>>02648000
        ASSEMBLE(MTDS 2);      <<MOVE - SAVE TARGET>>          <<00807>>02650000
        TOS:=@DIRENTRY;        <<SOURCE>>                      <<00807>>02652000
        TOS:=LENGTH;           <<LENGTH>>                      <<00807>>02654000
        ASSEMBLE(MTDS 4);      <<MOVE>>                        <<00807>>02656000
      END;                                                     <<00807>>02658000
  END;                                                         <<00807>>02660000
LOGICAL PROCEDURE SEARCHSL (NAME);                                      02662000
   <<SEARCHES THE CURRENT SL FILE FOR THE SPECIFIED ENTRY POINT.  NOTE  02664000
     THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN         02666000
     ERROR>>                                                            02668000
   INTEGER ARRAY NAME;                                                  02670000
   OPTION UNCALLABLE;                                                   02672000
   BEGIN                                                                02674000
   INTEGER RESULT = SEARCHSL;                                           02676000
   INTEGER BUCKET = Q+1;                                       <<00807>>02678000
   INTEGER LENGTH = Q+2;                                       <<00807>>02680000
   BYTE POINTER BNAME = Q+3;  <<IDENTIFIER>>                   <<00807>>02682000
   DOUBLE DRECD = Q+4;  <<CURRENT REC. NR.>>                   <<00807>>02684000
   INTEGER RECD = DRECD+1;                                     <<00807>>02686000
                                                                        02688000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           02690000
                                                                        02692000
   ASSEMBLE(ADDS 2);    <<SAVE SPACE FOR BUCKET AND LENGTH>>   <<00807>>02694000
   TOS := @NAME&LSL(1);                                                 02696000
   TOS := NAME.(4:12);  <<NC AND FIRST CHAR.>>                          02698000
   XREG := NAME.(4:4)-1;  <<NC-1>>                                      02700000
   TOS := BNAME(XREG)&CSL(8);  <<SEC. TO LAST CHAR.>>                   02702000
   XREG := XREG+1;                                                      02704000
   TOS := BNAME(XREG);  <<LAST CHAR.>>                                  02706000
   ASSEMBLE(ADD,DECX);                                                  02708000
   IF = THEN TOS := TOS.(4:12);                                         02710000
   TOS := NBUCKETS;                                            <<00807>>02712000
   ASSEMBLE(LDIV,ZROB);                                        <<00807>>02714000
   BUCKET:=TOS;                                                <<00807>>02716000
   IF SCANCACHE(NAME,BUCKET)                                   <<00807>>02718000
     THEN                                                      <<00807>>02720000
       BEGIN  <<FOUND DIRECTORY ENTRY IN CACHE>>               <<00807>>02722000
         HITS:=HITS+1D;  <<INCREMENT HIT COUNTER>>             <<00807>>02724000
         RESULT:=RESULT+1;                                     <<00807>>02726000
         GO AOK;                                               <<00807>>02728000
       END                                                     <<00807>>02730000
     ELSE                                                      <<00807>>02732000
       BEGIN    <<MUST READ SL DIRECTORY>>                     <<00807>>02734000
         TOS := SLREC0(BUCKET+FHI);  <<FIRST REC. IN LIST>>    <<00807>>02736000
         WHILE <> DO                                           <<00807>>02738000
           BEGIN                                               <<00807>>02740000
            FREADDIR(SLFNUM(SLNR),SLDIR,128,DRECD);            <<00807>>02742000
            IF <> THEN GO IOERROR;  <<ERROR?>>                 <<00807>>02744000
            @SLP := @SLDIR(2);  <<INIT. ENTRY POINTER>>        <<00807>>02746000
            WHILE @SLP < @SLDIR(SLDIR(1)) DO                   <<00807>>02748000
               BEGIN                                           <<00807>>02750000
               @SLP1 := @SLP+SLP.(4:3)+1; <<SECONDARY POINTER>><<00807>>02752000
               IF SAMENAME(NAME,SLNAME) THEN  <<NAME'S MATCH?>><<00807>>02754000
                  BEGIN                                        <<00807>>02756000
                  IF SLNR=0 THEN   <<SYSTEM SL>>               <<00807>>02758000
                    BEGIN                                      <<00807>>02760000
                      MISSES:=MISSES+1D;  <<INC MISS COUNTER>> <<00807>>02762000
                      LENGTH:=@SLP1-@SLP+PARMLEN(SLPARMS)+1;   <<00807>>02764000
                      ADDTOCACHE(SLP,LENGTH,BUCKET);           <<00807>>02766000
                    END;                                       <<00807>>02768000
                  RESULT := RESULT+1;                          <<00807>>02770000
                  GO AOK                                       <<00807>>02772000
                  END;                                         <<00807>>02774000
               @SLP := @SLP1+PARMLEN(SLPARMS)+1  <<NEXT ENTRY>><<00807>>02776000
               END;                                            <<00807>>02778000
            RECD := SLDIR  <<NEXT RECORD IN LIST>>             <<00807>>02780000
           END;                                                <<00807>>02782000
       END;                                                    <<00807>>02784000
   AOK:                                                                 02786000
   TOS := CCE;  <<OK CONDITION CODE>>                                   02788000
   GO GETOUT;                                                           02790000
                                                                        02792000
   IOERROR:                                                             02794000
   FERROR(SLFNUM(XREG));                                                02796000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                02798000
                                                                        02800000
   GETOUT:                                                              02802000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            02804000
   END;                                                                 02806000
PROCEDURE GETREFTABENT (SEGNR);                                         02808000
   <<LOADS THE RECORD (IF NECESSARY) CONTAINING THE SPECIFIED REFERENCE 02810000
     TABLE ENTRY AND SETS THE ENTRY POINTER TO IT.  NOTE THAT THIS      02812000
     PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>>           02814000
   VALUE SEGNR;                                                         02816000
   INTEGER SEGNR;                                                       02818000
   OPTION UNCALLABLE;                                                   02820000
   BEGIN                                                                02822000
   TOS := SEGNR; TOS := 4;                                              02824000
   ASSEMBLE(DIV);                                                       02826000
   @RTP := (TOS&LSL(5))+@RTBUF;  <<SET ENTRY POINTER>>                  02828000
   TOS := TOS+SLREC1(SLNR);  <<BUFFER POINTER>>                         02830000
   TOS := PS0;  <<REC. NR.>>                                            02832000
   IF S0 <> RTRECD THEN  <<DIFFERENT RECORD?>>                          02834000
      BEGIN                                                             02836000
      SAVEREFTABBUF;                                                    02838000
      IF < THEN GO NFG;  <<ERROR?>>                                     02840000
      RTRECD := TOS;                                                    02842000
      FREADDIR(SLFNUM(XREG),RTBUF,128,DRTRECD);                         02844000
      IF <> THEN GO IOERROR  <<ERROR?>>                                 02846000
      END;                                                              02848000
   TOS := CCE;  <<OK CONDITION CODE>>                                   02850000
   GO GETOUT;                                                           02852000
                                                                        02854000
   IOERROR:                                                             02856000
   FERROR(SLFNUM(XREG));                                                02858000
                                                                        02860000
   NFG:                                                                 02862000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                02864000
                                                                        02866000
   GETOUT:                                                              02868000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            02870000
   END;                                                                 02872000
PROCEDURE SAVEREFTABBUF;                                                02874000
   <<SAVES THE CONTENTS OF THE REFERENCE TABLE BUFFER IF IT HAS BEEN    02876000
     MODIFIED.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO     02878000
     INDICATE AN ERROR>>                                                02880000
   OPTION UNCALLABLE;                                                   02882000
   BEGIN                                                                02884000
   TOS := RTMODIFIED;  <<MODIFIED FLAG>>                                02886000
   IF <> THEN  <<MODIFIED?>>                                            02888000
      BEGIN                                                             02890000
      FWRITEDIR(SLFNUM(SLNR),RTBUF,128,DRTRECD);                        02892000
      IF <> THEN GO IOERROR  <<ERROR?>>                                 02894000
      END;                                                              02896000
   RTMODIFIED := 0;  <<CLEAR MODIFIED FLAG>>                            02898000
   TOS := CCE;  <<OK CONDITION CODE>>                                   02900000
   GO GETOUT;                                                           02902000
                                                                        02904000
   IOERROR:                                                             02906000
   FERROR(SLFNUM(XREG));                                                02908000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                02910000
                                                                        02912000
   GETOUT:                                                              02914000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            02916000
   END;                                                                 02918000
PROCEDURE GETSLNAMES (FLAG);                                            02920000
   <<INITIALIZES THE SL FILE NAME ARRAYS WITH THE PROPER SET OF FILE    02922000
     NAMES.  IF THE FLAG IS TRUE, THEN THE FILE NAMES ARE DETERMINED    02924000
     FROM THE DOMAIN OF THE PROGRAM FILE; OTHERWISE THEY ARE DETERMINED 02926000
     BY THE LOG-ON DOMAIN.  NOTE THAT THIS PROCEDURE USES THE           02928000
     CONDITION CODE TO INDICATE AN ERROR>>                              02930000
   VALUE FLAG;                                                          02932000
   LOGICAL FLAG;                                                        02934000
   OPTION UNCALLABLE;                                                   02936000
   BEGIN                                                                02938000
   BYTE ARRAY B0 (0:2)=PB := "SL.";                                     02940000
   BYTE ARRAY B1 (0:3)=PB := "PUB.";                                    02942000
   BYTE ARRAY B2 (0:3)=PB := "SYS ";                                    02944000
   BYTE ARRAY GROUP (0:8);  <<GROUP NAME>>                              02946000
   BYTE ARRAY ACCT (0:8);  <<ACCOUNT NAME>>                             02948000
   INTEGER LIBNO;                                              <<00.02>>02950000
   ARRAY BUF (0:40);                                           <<13.PV>>02952000
                                                                        02954000
SUBROUTINE GETNAMES(LINEPTR);                                  <<00.02>>02956000
VALUE LINEPTR;                                                 <<00.02>>02958000
BYTE POINTER LINEPTR;                                          <<00.02>>02960000
BEGIN                                                          <<00.02>>02962000
   TOS := @GROUP&LSR(1);                                       <<00.02>>02964000
   PS0 := "  ";                                                <<00.02>>02966000
   ASMB(DUP,INCB);                                             <<00.02>>02968000
   TOS := 9;                                                   <<00.02>>02970000
   ASMB(MOVE 3); << BLANK BUFFER >>                            <<00.02>>02972000
   TOS := @LINEPTR;                                            <<00.02>>02974000
   TOS := @ACCT;                                               <<00.02>>02976000
   TOS := @GROUP;                                              <<00.02>>02978000
   ASMB(CAB); << LINE PTR TO TOS >>                            <<00.02>>02980000
   SCAN * UNTIL ".",1; << SKIP FILE NAME >>                    <<00.02>>02982000
   TOS := TOS + 1; << SKIP "." >>                              <<00.02>>02984000
   MOVE * := * WHILE AN,0; << GET GROUP NAME >>                <<00.02>>02986000
   DELB; << DEL GROUP NAME POINTER >>                          <<00.02>>02988000
   TOS := TOS + 1; << SKIP "." >>                              <<00.02>>02990000
   MOVE * := * WHILE AN; << GET ACCOUNT NAME >>                <<00.02>>02992000
END;                                                           <<00.02>>02994000
                                                               <<00.02>>02996000
                                                               <<00.02>>02998000
   <<* * * PARTIALLY INITIALIZE FILE NAMES * * *>>                      03000000
                                                                        03002000
   MOVE SSLFNAME := B0,(3),2;                                           03004000
   MOVE * := B1,(4),2;                                                  03006000
   MOVE * := B2,(4);                                                    03008000
   MOVE PSLFNAME := B0,(3),2;                                           03010000
   MOVE * := B1,(4),2;                                                  03012000
   MOVE GSLFNAME := B0,(3),2;                                           03014000
                                                                        03016000
   <<* * * COMPLETE FILE NAME INITIALIZATION * * *>>                    03018000
                                                                        03020000
   IF FLAG THEN  <<SAVED FILE?>>                                        03022000
      BEGIN                                                             03024000
      SCAN BLINE UNTIL ".",1;  <<SKIP OVER LOCAL NAME>>                 03026000
      TOS := TOS+1;  <<SKIP OVER ".">>                                  03028000
      MOVE * := * WHILE AN,0;  <<INSERT GROUP NAME>>                    03030000
      MOVE * := *,(1),1;  <<INSERT ".">>                                03032000
      XREG := S0;  <<SAVE POINTER TO ACCT. NAME>>                       03034000
      MOVE * := * WHILE AN,1;  <<INSERT ACCT. NAME>>                    03036000
      BPS0 := " ";  <<INSERT TRAILING BLANK>>                           03038000
      ASMB(XAX); << GET ACCT POINTER >>                        <<00.02>>03040000
      MOVE * := * WHILE AN,1;  <<INSERT ACCOUNT NAME>>                  03042000
      BPS0 := " ";  <<INSERT TRAILING BLANK>>                           03044000
      GETNAMES(BLINE);                                         <<00.02>>03046000
      SCAN GROUP UNTIL "  ",1;                                 <<00.02>>03048000
      BPS0 := "."; << SET AT END OF GROUP STRING >>            <<00.02>>03050000
      DEL;                                                     <<00.02>>03052000
      END                                                               03054000
   ELSE  <<NON-SAVED FILE>>                                             03056000
      BEGIN                                                             03058000
      GROUP(8) := " "; ACCT(8) := " ";                                  03060000
      MOVE  GROUP := MGROUP,(8);                                        03062000
      SCAN GROUP UNTIL "  ",1;                                 <<04677>>03064000
      BPS0 := ".";                                             <<04677>>03066000
      DEL;                                                     <<04677>>03068000
      MOVE  ACCT := MACCT,(8);                                          03070000
      MOVE * := GROUP WHILE AN,1;  <<INSERT GROUP NAME>>                03072000
      BPS0 := ".";  <<INSERT ".">>                                      03074000
      ASSEMBLE (INCA);  <<SKIP OVER ".">>                               03076000
      MOVE * := ACCT WHILE AN,0;  <<INSERT ACCOUNT NAME>>               03078000
      MOVE * := *,(1);  <<INSERT TRAILING BLANK>>                       03080000
      MOVE * := ACCT WHILE AN,0;  <<INSERT ACCOUNT NAME>>               03082000
      MOVE * := *,(1)  <<INSERT TRAILING BLANK>>                        03084000
      END;                                                              03086000
<<   * * *  CHECK FOR VALID LIBRARAY SEARCH  * * *  >>                  03088000
   TOS := MLIBSEARCH;             <<LIBRARY SEARCH LEVEL>>              03090000
   IF GROUP = B1,(4) THEN         <<PUBLIC GROUP?>>                     03092000
    IF ACCT = B2,(4) THEN         <<SYSTEM ACCOUNT?>>                   03094000
     IF TOS <> 0 THEN             <<LIB NEQ TO SYS?>>                   03096000
     BEGIN                                                              03098000
         TOS := ERR20;                                                  03100000
         GO ABORT;                                                      03102000
     END                                                                03104000
     ELSE                                                               03106000
    ELSE                                                                03108000
     IF TOS = 2 THEN MLIBSEARCH := 1 <<DEFAULT TO PUB SEARCH>>          03110000
     ELSE                                                               03112000
   ELSE                                                                 03114000
    DEL';                                                               03116000
   SSLCAP := 1; << SYSTEM SL ALWAYS HAS PM CAPABILITY >>       <<00.02>>03118000
   PSLCAP := GSLCAP := 0; << FIND OUT PUB AND GROUP CAP >>     <<00.02>>03120000
   LIBNO := MLIBSEARCH;                                        <<00.02>>03122000
   WHILE > DO                                                  <<00.02>>03124000
   BEGIN << DETERMINE GROUP CAPABILITY >>                      <<00.02>>03126000
      TOS := SLFNAME(LIBNO);                                   <<00.02>>03128000
      GETNAMES(*);                                             <<00.02>>03130000
      DIRECFIND (8,0D,ACCT,GROUP,BUF,BUF);<< GET GROUP ENTRY >><<38.PV>>03132000
      IF = THEN SLCAP(LIBNO) := BUF(23).(9:1); << PM BIT >>    <<00.02>>03134000
      LIBNO := LIBNO - 1;                                      <<00.02>>03136000
   END;                                                        <<00.02>>03138000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03140000
   GO GETOUT;                                                           03142000
                                                                        03144000
   ABORT:                                                               03146000
   MERROR := TOS;  <<INSERT ERROR NR.>>                                 03148000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03150000
                                                                        03152000
   GETOUT:                                                              03154000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            03156000
   END;                                                                 03158000
PROCEDURE VALIDCAP (FLAG);                                              03160000
   <<CHECKS THE PROGRAM FILE CAPABILITY TO SEE IF IT IS A SUBSET OF THE 03162000
     GROUP OR USER'S CAPABILITY.  NOTE THAT THIS PROCEDURE USES THE     03164000
     CONDITION CODE TO INDICATE AN ERROR>>                              03166000
   VALUE FLAG;                                                          03168000
   LOGICAL FLAG;                                                        03170000
   OPTION UNCALLABLE;                                                   03172000
   BEGIN                                                                03174000
   ARRAY BUF (0:40) = Q;                                       <<13.PV>>03176000
   ARRAY GROUP (*) = BUF;                                               03178000
   ARRAY ACCT (*) = BUF(4);                                             03180000
   TOS := PCAPABILITY;                                                  03182000
   TOS.(7:2) := 0;  <<CLEAR "IA" AND "BA">>                             03184000
   IF TOS <> 0 THEN  <<NON-STANDARD CAPABILITIES?>>                     03186000
      BEGIN                                                             03188000
      TOS := @GROUP; PS0 := "  ";                                       03190000
      ASSEMBLE(DUP,INCB); TOS := 7; ASSEMBLE(MOVE 3);                   03192000
      IF FLAG THEN  <<SAVED FILE?>>                                     03194000
         BEGIN                                                          03196000
         TOS := @ACCT&LSL(1);                                           03198000
         TOS := @GROUP&LSL(1);                                          03200000
         SCAN BLINE UNTIL ".",1;  <<SKIP OVER LOCAL NAME>>              03202000
         TOS := TOS+1;                                                  03204000
         MOVE * := * WHILE AN,0;  <<INSERT GROUP NAME>>                 03206000
         ASSEMBLE(DELB,INCA);                                           03208000
         MOVE * := * WHILE AN;  <<INSERT ACCOUNT NAME>>                 03210000
         DIRECFIND (8,0D,ACCT,GROUP,BUF,BUF);<<GROUP ENTRY>>   <<38.PV>>03212000
         IF < THEN  <<ERROR?>>                                          03214000
            BEGIN                                                       03216000
            TOS := ERR74; GO ABORT                                      03218000
            END;                                                        03220000
         TOS := BUF(23)  <<GROUP'S RESOURCE CAPABILITIES>>              03222000
         END                                                            03224000
      ELSE  <<NON-SAVED FILE>>                                          03226000
         BEGIN                                                          03228000
         TOS := USERCAP2  <<USER'S RESOURCE CAPABILITIES>>              03230000
         END;                                                           03232000
      USERCAP := S0.(9:1); << PM BIT >>                        <<00.02>>03234000
      TOS := PCAPABILITY;                                               03236000
      ASSEMBLE(DUP,CAB; AND,CMP);                                       03238000
      IF <> THEN  <<NOT SUBSET?>>                                       03240000
         BEGIN                                                          03242000
         TOS := ERR39; GO ABORT                                         03244000
         END                                                            03246000
      END;                                                              03248000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03250000
   GO GETOUT;                                                           03252000
                                                                        03254000
   ABORT:                                                               03256000
   MERROR := TOS;  <<ERROR NR.>>                                        03258000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03260000
                                                                        03262000
   GETOUT:                                                              03264000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            03266000
   END;                                                                 03268000
PROCEDURE EXTNPARMS;                                                    03270000
   <<CALCULATES THE UNSATISFIED EXTERNAL ENTRY PARAMETERS>>             03272000
   OPTION UNCALLABLE;                                                   03274000
   BEGIN                                                                03276000
   UXNC := UXP.(4:4);                                                   03278000
   @UXP1 := @UXP+UXP.(4:3)+1;                                           03280000
   @UXP2 := @UXP1+UXNR+1;                                               03282000
   UXNW := @UXP2-@UXP+PARMLEN(UXPARMS)                                  03284000
   END;                                                                 03286000
PROCEDURE SATISFYPROG;                                                  03288000
   <<SATISFIES THE EXTERNALS OF THE PROGRAM FILE AND CONSTRUCTS THE     03290000
     SATISFIED EXTERNAL TABLE.  NOTE THAT THIS PROCEDURE USES THE       03292000
     CONDITION CODE TO INDICATE AN ERROR>>                              03294000
   OPTION UNCALLABLE;                                                   03296000
   BEGIN                                                                03298000
                                                                        03300000
   <<* * * OPEN PROGRAM FILE * * *>>                                    03302000
                                                                        03304000
   PROGKEY := MPROGKEY;  <<PROG. FILE KEY>>                             03306000
   TOS := 0;  <<FOR RESULT OF FOPENDA>>                                 03308000
   TOS := 0;                                                            03310000
   TOS := MPROGKEY;                                                     03312000
   S2 := BS1;  <<LOGICAL DEVICE NR.>>                                   03314000
   BS1 := 0;  <<CLEAR LOG. DEV. NR.>>                                   03316000
   PROGFNUM := FOPENDA (*,*,%(2)111110111,,,,,,MPVINFO);       <<01549>>03318000
   IF < THEN  <<ERROR?>>                                                03320000
      BEGIN                                                             03322000
      FCHECK(0,MFERROR);  <<FILE SYS. ERROR NR'S>>                      03324000
      TOS := ERR53; GO ABORT                                            03326000
      END;                                                              03328000
   SETBIT (FDA,PROGFNUM);  <<INDICATE OPENED VIA FOPENDA>>     <<RV.PV>>03330000
   FLOCK(PROGFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                      03332000
                                                                        03334000
   <<* * * READ RECORDS 0 AND 1 * * *>>                                 03336000
                                                                        03338000
   FREADDIR(PROGFNUM,BUF1,P256,0D);  <<READ REC'S 0,1>>                 03340000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   03342000
   NPA := BUF1(1);  <<NR. SEGMENTS>>                                    03344000
   IF NOT (1 <= NPA <= 63) THEN  <<ILLEGAL NR. SEGMENTS?>>              03346000
      BEGIN                                                             03348000
      TOS := ERR37; GO ABORT                                            03350000
      END;                                                              03352000
   TOS := ABSOLUTE(MAXCODESEG);   << GET MAX # CODE SEGMENTS >>         03354000
   IF TOS < NPA THEN  <<TOO MANY SEGMENTS?>>                            03356000
      BEGIN                                                             03358000
      TOS := ERR38; GO ABORT                                            03360000
      END;                                                              03362000
   TOS := (NPA+57)&LSR(1)+NPA;  <<NR. WORDS NEEDED>>                    03364000
   MAKEROOMINDL(S0);                                                    03366000
   IF < THEN GO NFG;  <<ERROR?>>                                        03368000
   @PROGREC0 := @DLAREA1-S0;                                            03370000
   @DLAREA1 := @DLAREA1-S0;                                             03372000
   MOVE PROGREC0 := BUF1,(S0);  <<MOVE REC'S 0,1>>                      03374000
                                                                        03376000
   <<* * * GET FILE CHARACTERISTICS * * *>>                             03378000
                                                                        03380000
   BLANKLINE;                                                           03382000
   IF < THEN GO NFG;  <<ERROR?>>                                        03384000
   TOS := 0;  <<FOR FOPTIONS>>                                          03386000
   TOS := PROGFNUM;                                                     03388000
   MOVE BLINE := "PROGRAM FILE ",2;                                     03390000
   FGETINFO(*,*,S2);                                                    03392000
   VALIDCAP(S0);  <<CHECK CAPABILITY>>                                  03394000
   IF < THEN GO NFG;  <<ERROR?>>                                        03396000
   GETSLNAMES(*);                                                       03398000
   IF < THEN GO NFG;  <<ERROR?>>                                        03400000
   PRINTLINE;                                                           03402000
   IF < THEN GO NFG;  <<ERROR?>>                                        03404000
   BLANKLINE;                                                           03406000
   IF < THEN GO NFG;  <<ERROR?>>                                        03408000
                                                                        03410000
   <<* * * FORMAT EXTERNAL LIST * * *>>                                 03412000
                                                                        03414000
   TOS := (PENTRYRECD-PEXTERNALRECD)&LSL(7);  <<NR. WORDS IN LIST>>     03416000
   MAKEROOMINDL(S0);                                                    03418000
   IF < THEN GO NFG;  <<ERROR?>>                                        03420000
   FREADDIR(PROGFNUM,DLAREA2,S0,DOUBLE(LOGICAL(PEXTERNALRECD)));        03422000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   03424000
   @UXP := @DLAREA2;  <<INIT. ENTRY POINTER>>                           03426000
   WHILE UXP <> 0 DO                                                    03428000
      BEGIN                                                             03430000
      EXTNPARMS;                                                        03432000
      UXUTYPE := 3;                                                     03434000
      @UXP := @UXP+UXNW  <<NEXT ENTRY>>                                 03436000
      END;                                                              03438000
   @DLAVAIL := @UXP;  <<INIT. DL AVAILABLE POINTER>>                    03440000
                                                                        03442000
   <<* * * SATISFY EXTERNALS OF PROGRAM * * *>>                         03444000
                                                                        03446000
   SATISFY;                                                             03448000
   IF < THEN GO NFG;  <<ERROR?>>                                        03450000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03452000
   GO GETOUT;                                                           03454000
                                                                        03456000
   IOERROR:                                                             03458000
   FERROR(PROGFNUM);                                                    03460000
   GO NFG;                                                              03462000
                                                                        03464000
   ABORT:                                                               03466000
   MERROR := TOS;  <<ERROR NR.>>                                        03468000
                                                                        03470000
   NFG:                                                                 03472000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03474000
                                                                        03476000
   GETOUT:                                                              03478000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            03480000
   END;                                                                 03482000
PROCEDURE SATISFYPROC;                                                  03484000
   <<FINDS THE SPECIFIED PROCEDURE AND SATISFYIES ALL IT'S EXTERNALS.   03486000
     NOTE THAT THIS PROCEDURE USES THE CONDTION CODE TO INDICATE AN     03488000
     ERROR>>                                                            03490000
   OPTION UNCALLABLE;                                                   03492000
   BEGIN                                                                03494000
                                                                        03496000
   <<* * * PRIME EXTERNAL TABLE WITH PROCEDURE ENTRY * * *>>            03498000
                                                                        03500000
   MAKEROOMINDL(10);                                                    03502000
   IF < THEN GO NFG;  <<ERROR?>>                                        03504000
   MOVE DLAREA2 := MPROCNAME,(8);                                       03506000
   TOS := @DLAREA2+DLAREA2.(4:3)+1;                                     03508000
   TOS := %040000; TOS := 0;  <<TYPE AND PARM. INFO>>                   03510000
   DPS2 := TOS;                                                         03512000
   @DLAVAIL := TOS+2;  <<RESET DL AVAILABLE POINTER>>                   03514000
                                                                        03516000
   <<* * * FIND PROCEDURE AND SATISFY IT'S EXTERNALS * * *>>            03518000
                                                                        03520000
   GETSLNAMES(FALSE);  <<GET SL FILE NAMES>>                            03522000
   SATISFY;                                                             03524000
   IF < THEN GO NFG;  <<ERROR?>>                                        03526000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03528000
   GO GETOUT;                                                           03530000
                                                                        03532000
   NFG:                                                                 03534000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03536000
                                                                        03538000
   GETOUT:                                                              03540000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            03542000
   END;                                                                 03544000
PROCEDURE SATISFY;                                                      03546000
   <<STEPS THRU THE SL FILES AND TRIES TO SATISFY THE EXTERNALS IN      03548000
     THE UNSATISFIED EXTERNAL TABLE, THEREBY CONSTRUCTING THE SATISFIED 03550000
     EXTERNAL TABLE.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE  03552000
     TO INDICATE AN ERROR>>                                             03554000
   OPTION UNCALLABLE;                                                   03556000
   BEGIN                                                                03558000
   BYTE ARRAY B3 (0:2)=PB := "SPG";                                     03560000
   BYTE ARRAY B4(0:12)=PB := "INCOMPATIBLE ";                  <<00605>>03562000
   BYTE ARRAY B5(0:12)=PB := "FUNCTION FOR ";                  <<00605>>03564000
   BYTE ARRAY B6(0:24)=PB := "NUMBER OF PARAMETERS FOR ";      <<00605>>03566000
   BYTE ARRAY B7(0:14)=PB := "PARAMETERS FOR ";                <<00605>>03568000
   BYTE ARRAY B8(0:13)=PB := " PARAMETER(S) ";                 <<00605>>03570000
   INTEGER SAVEDB,SAVESIR;                                     <<00659>>03572000
   INTEGER BINDINGERROR := 0;   <<BINDING ERROR FLAG>>         <<00605>>03574000
   LOGICAL ARRAY SEGS (0:15)=Q; <<SEGMENTS REFERENCED BIT MAP>><<00605>>03576000
   INTEGER ARRAY PARMS(0:4)=Q;  <<PARMCHECK ARRAY>>            <<00605>>03578000
                                                                        03580000
   SUBROUTINE TYPESTRING (BUF,TYPE);                                    03582000
      VALUE TYPE;                                                       03584000
      BYTE ARRAY BUF;                                                   03586000
      INTEGER TYPE;                                                     03588000
      BEGIN                                                             03590000
      TOS := DS2;                                                       03592000
      IF TOS = 3 THEN                                                   03594000
         MOVE * := "PROG"                                               03596000
      ELSE                                                              03598000
         BEGIN                                                          03600000
         MOVE * := B3(S2),(1),2;                                        03602000
         MOVE * := "SL"                                                 03604000
         END                                                            03606000
      END;                                                              03608000
                                                                        03610000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           03612000
                                                                        03614000
   <<* * * INITIALIZE HIT/MISS COUNTERS * * *>>                <<00807>>03616000
                                                               <<00807>>03618000
   IF LOADCACHESEG<>0 THEN                                     <<00807>>03620000
     BEGIN                                                     <<00807>>03622000
       TOS:=@HITS;             <<TARGET>>                      <<00807>>03624000
       TOS:=LOADCACHESEG;      <<SOURCE SEGMENT>>              <<00807>>03626000
       TOS:=CACHEHITS;         <<SOURCE>>                      <<00807>>03628000
       TOS:=4;                 <<LENGTH>>                      <<00807>>03630000
       ASSEMBLE(MFDS 4);       <<MOVE>>                        <<00807>>03632000
     END;                                                      <<00807>>03634000
                                                               <<00807>>03636000
   <<* * * SEARCH SL FILES * * *>>                                      03638000
                                                                        03640000
   FOR SLNR := MLIBSEARCH STEP -1 UNTIL 0                      <<SB.04>>03642000
   DO BEGIN                                                    <<SB.04>>03644000
      TOS := SLSEGS(SLNR);                                     <<SB.04>>03646000
      CLEARBITMAP(*);                                          <<SB.04>>03648000
      SLPVINFO (XREG) := 0;  <<CLEAR RESIDUE>>                 <<00211>>03650000
      END;                                                     <<SB.04>>03652000
   @SXTABLE := @DLAREA1;  <<INIT. SATIS. EXTN. TABLE>>                  03654000
   SLNR := MLIBSEARCH;  <<SL COUNTER>>                                  03656000
   WHILE >= AND @DLAVAIL <> @DLAREA2 DO                                 03658000
      BEGIN                                                             03660000
      CLEARBITMAP(SEGS);                                                03662000
                                                                        03664000
      << DISMOUNT UN-USED  SL (PREVIOUSLY REFERENCED SL)>>     <<00784>>03666000
      IF SLNR < MLIBSEARCH THEN <<NOT 1ST TIME THROUGH LOOP>>  <<00784>>03668000
       IF SLPVINFO (SLNR+1) <> 0 THEN <<SL'S HVS WAS MOUNTED>> <<00784>>03670000
       BEGIN <<DISMOUNT SL>>                                   <<00784>>03672000
           DISMOUNTVOLSET (SLPVINFO (XREG),MPIN);              <<00784>>03674000
           SLPVINFO (XREG) := 0; <<REMOVE TRACE OF MOUNT>>     <<00784>>03676000
       END;                                                    <<00784>>03678000
      <<* * * OPEN SL FILE * * *>>                                      03680000
                                                                        03682000
      XREG := SLNR;                                                     03684000
      IF  <>  THEN  <<PUBLIC OR GROUP SL>>                              03686000
         BEGIN                                                          03688000
         TOS := 0;  <<FOR RESULT OF FOPEN>>                             03690000
         IF XREG = 1 AND PSLFNAME = SSLFNAME,(11) THEN                  03692000
            GO ENDLOOP;  <<IGNORE PUBLIC SL?>>                          03694000
         TOS := SLFNAME(XREG);  <<SL FILE NAME>>                        03696000
         SLFNUM(XREG) := FOPEN(*,%(2)10000000001,%(2)111110110);        03698000
         IF < THEN  <<ERROR?>>                                          03700000
            BEGIN                                                       03702000
            TOS := 0; FCHECK(0,S0);                                     03704000
            IF S0=51 OR S0=52 THEN GO ENDLOOP; << NON-EXIST SL? >>      03706000
            MFERROR := TOS;  <<FILE SYS. ERROR NR'S>>                   03708000
            TOS := ERR50+SLNR;  <<ERROR NR.>>                           03710000
            GO ABORT                                                    03712000
            END;                                                        03714000
         ASSEMBLE(ADDS 4);                                              03716000
         FGETINFO(SLFNUM(XREG),,,,,,S1,,S0,,,,,,,,,,,DS3);              03718000
         IF TOS <> SLFILECODE THEN  <<TYPE SL?>>                        03720000
            BEGIN                                                       03722000
            INVALIDSL:                                                  03724000
            TOS := ERR28+XREG;                                          03726000
            GO ABORT                                                    03728000
            END;                                                        03730000
         BS2 := TOS;  <<INSERT LOG. DEV. NR.>>                          03732000
         SLKEY(XREG) := TOS;  <<SL FILE KEY>>                           03734000
         SLPVINFO (XREG) := MOUNTVOLSET (SLFNUM (XREG),MPIN);  <<00211>>03736000
         IF < THEN                                             <<00784>>03738000
         BEGIN <<MOUNT FAILURE>>                               <<00784>>03740000
             SLPVINFO (XREG) := 0;<<RETURNED PV ERR. CLEAR IT>><<00784>>03742000
             TOS := ERR94 + XREG;                              <<00784>>03744000
             GO ABORT;                                         <<00784>>03746000
         END;                                                  <<00784>>03748000
         END;                                                           03750000
      FLOCK(SLFNUM(XREG),TRUE);  <<GET FILE EXCLUSIVELY>>               03752000
                                                                        03754000
      <<* * * ALLOCATE DL BUFFERS * * *>>                               03756000
                                                                        03758000
      MAKEROOMINDL(128);                                                03760000
      IF < THEN GO NFG;                                                 03762000
      FREADDIR(SLFNUM(XREG),BUF1,P256,0D);  <<READ REC'S 0,1>>          03764000
      IF <> THEN GO IOERROR;  <<ERROR?>>                                03766000
      IF SLID <> SLFILEID THEN GO INVALIDSL;  <<OLD VERSION?>>          03768000
      TOS := @DLAREA1-128;                                              03770000
      ASSEMBLE(DUP,DUP);                                                03772000
      MOVE * := SXTABLE,(NWSXTABLE),2;  <<MOVE SATIS. EXTN. TABLE>>     03774000
      SLREC1(XREG) := S0;                                               03776000
      MOVE * := BUF2,(128);  <<MOVE RECORD 1>>                          03778000
      @DLAREA1 := TOS;  <<RESET DL AREA 1 POINTER>>                     03780000
      @SXTABLE := TOS;  <<RESET SATIS. EXTN. TABLE POINTER>>            03782000
                                                                        03784000
      <<* * * TRY TO SATISFY EXTERNALS * * * >>                         03786000
                                                                        03788000
      @UXP := @DLAREA2;  <<INIT. UNSATIS. EXTN. POINTER>>               03790000
      DO BEGIN                                                          03792000
         EXTNPARMS;                                                     03794000
         TOS := SEARCHSL(UXNAME);                                       03796000
         IF < THEN GO NFG;  <<ERROR?>>                                  03798000
         IF TOS THEN  <<SATISFIABLE?>>                                  03800000
            BEGIN                                                       03802000
            @SAVEUXP := @UXP;  <<SAVE ENTRY POINTER>>                   03804000
            DO BEGIN                                                    03806000
               EXTNPARMS;                                               03808000
               IF SAMENAME(UXNAME,SLNAME) THEN  <<NAME'S MATCH?>>       03810000
                  BEGIN                                                 03812000
                  PARMCHECK(SLPARMS,UXPARMS,PARMS);            <<00605>>03814000
                  IF PARMS = 0 THEN <<PARM'S MATCH?>>          <<00605>>03816000
                     BEGIN                                              03818000
                                                                        03820000
                     <<* * * LIST EXTERNALS AND ENTRY POINT * * *>>     03822000
                                                                        03824000
                     TOS := @BLINE; TOS := @UXNAME&LSL(1)+1;            03826000
                     MOVE * := *,(UXNC);                                03828000
                     TYPESTRING(BLINE(16),UXUTYPE);                     03830000
                     NTOA(UXPARMS.(0:2),8,BLINE(21));  <<P LEVEL>>      03832000
                     TYPESTRING(BLINE(31),SLNR);                        03834000
                     NTOA(SLPARMS.(0:2),8,BLINE(36));  <<P LEVEL>>      03836000
                     NTOA(SLSTTNR,8,BLINE(40));  <<STT NR. OF SL PROC>> 03838000
                     NTOA(SLSEGNR,8,BLINE(44));  <<SEG. NR. OF SL PROC>>03840000
                     XREG := UXNR;  <<NR. REFERENCES>>                  03842000
                     WHILE <> DO                                        03844000
                        BEGIN                                           03846000
                        TOS := UXP1(XREG).(0:8);                        03848000
                        TOS := 8;                                       03850000
                        TOS := @BLINE+25;                               03852000
                        NTOA(*,*,*);  <<STT NR. OF EXTERNAL>>           03854000
                        TOS := UXP1(XREG).(8:8);                        03856000
                        TOS := 8;                                       03858000
                        TOS := @BLINE+29;                               03860000
                        NTOA(*,*,*);  <<SEG. NR. OF EXTERNAL>>          03862000
                        PRINTLINE;                                      03864000
                        IF < THEN GO NFG;  <<ERROR?>>                   03866000
                        XREG := XREG-1                                  03868000
                        END;                                            03870000
                                                                        03872000
                     <<* * * CREATE SATISFIED EXTERNAL ENTRY * * *>>    03874000
                                                                        03876000
                     UXSTYPE := SLNR;  <<SATISFIER TYPE>>               03878000
                     TOS := UXNR+2;  <<NR. WORDS IN ENTRY>>             03880000
                     MAKEROOMINDL(S0);                                  03882000
                     IF < THEN GO NFG;  <<ERROR?>>                      03884000
                     @DLAREA1 := @DLAREA1-S0;                           03886000
                     @SXTABLE := @DLAREA1;  <<INIT. ENTRY POINTER>>     03888000
                     UXP1(-1) := SLPLABEL;  <<ENTRY POINT P-LABEL>>     03890000
                     MOVE SXTABLE := UXP1(-1),(S0);                     03892000
                     NWSXTABLE := TOS+NWSXTABLE;                        03894000
                     IF MCOMMAND=3 AND SLNR=0 AND SLP.(3:1)=1  <<00659>>03896000
                       THEN BEGIN                              <<00659>>03898000
                              TOS:=ERR85; GO ABORT;            <<00659>>03900000
                            END;                               <<00659>>03902000
                     IF SLNR<>0 OR SLP.(3:1)=0 THEN            <<00574>>03904000
                       BEGIN  <<MUST CHECK INDIRECT REFS>>     <<00574>>03906000
                         TOS := SLSEGS(SLNR);                  <<00574>>03908000
                         SETBIT(*,SLSEGNR); <<REFERENCED BIT>> <<00574>>03910000
                       END;                                    <<00574>>03912000
                     END                                                03914000
                  ELSE  <<PARM'S MISMATCH>>                             03916000
                     BEGIN                                              03918000
                     MOVE BLINE := B4,(13),2;                  <<00605>>03920000
                     CASE PARMS OF                             <<00605>>03922000
                        BEGIN                                  <<00605>>03924000
                        ;                                      <<00605>>03926000
                        MOVE * := B5,(13),2;                   <<00605>>03928000
                        MOVE * := B6,(25),2;                   <<00605>>03930000
                        MOVE * := B7,(15),2;                   <<00605>>03932000
                        END;                                   <<00605>>03934000
                     TOS := @UXNAME&LSL(1)+1;                           03936000
                     MOVE * := *,(UXNC),2;                     <<00605>>03938000
                     IF PARMS = 3 THEN <<ONE OF THE PARMS?>>   <<00605>>03940000
                        BEGIN                                  <<00605>>03942000
                        MOVE * := B8,(14);                     <<00605>>03944000
                        PRINTBITMAP(PARMS(1));                 <<00605>>03946000
                        IF < THEN GO NFG; <<ERROR?>>           <<00605>>03948000
                        END                                    <<00605>>03950000
                     ELSE                                      <<00605>>03952000
                        BEGIN                                  <<00605>>03954000
                        DEL;  <<MOVE DEST>>                    <<00605>>03956000
                        PRINTLINE';                            <<00605>>03958000
                        IF < THEN GO NFG; <<ERROR?>>           <<00605>>03960000
                        END;                                   <<00605>>03962000
                     BINDINGERROR := BINDINGERROR+1  <<SET FLAG>>       03964000
                     END;                                               03966000
                  MOVE UXP := UXP(UXNW),(@DLAVAIL-@UXP(XREG)),2;        03968000
                  @DLAVAIL := TOS  <<RESET AVAILABLE POINTER>>          03970000
                  END                                                   03972000
               ELSE  <<DIFFERENT NAME>>                                 03974000
                  @UXP := @UXP+UXNW  <<NEXT ENTRY>>                     03976000
               END UNTIL @UXP = @DLAVAIL;                               03978000
            @UXP := @SAVEUXP  <<NEXT ENTRY>>                            03980000
            END                                                         03982000
         ELSE  <<UNSATISFIABLE>>                                        03984000
            @UXP := @UXP+UXNW  <<NEXT ENTRY>>                           03986000
         END UNTIL @UXP = @DLAVAIL;                                     03988000
                                                                        03990000
      <<* * * GET INDIRECTLY REFERENCED SEGMENTS * * *>>                03992000
                                                                        03994000
      DRTRECD := 0D;  <<INIT. REC. NR.>>                                03996000
      TOS := 255;  <<SEG. NR.>>                                         03998000
      DO BEGIN                                                          04000000
         TOS := 0;  <<FOR TESTBIT RESULT>>                              04002000
         TOS := SLSEGS(SLNR);                                           04004000
         TOS := S2;  <<SEG NR.>>                                        04006000
         IF TESTBIT(*,*) THEN  <<SEGMENT REFERENCED?>>                  04008000
            BEGIN                                                       04010000
            GETREFTABENT(S0);                                           04012000
            IF < THEN GO NFG;  <<ERROR?>>                               04014000
            IF MCOMMAND = 3 THEN  <<ALLOCATE PROCEDURE?>>               04016000
               BEGIN                                                    04018000
               SAVEDB:=EXCHANGEDB(SEGTABDST);                  <<00659>>04020000
               SAVESIR:=GETSIR(SEGTABSIR);                     <<00659>>04022000
               TOS:=XFORM(PHYSICALCST(0,S0+%20000));           <<00659>>04024000
               RELSIR(SEGTABSIR,SAVESIR);                      <<00659>>04026000
               EXCHANGEDB(SAVEDB);                             <<00659>>04028000
               IF TOS.(10:1)=1 THEN  <<ALREADY ALLOCATED>>     <<00659>>04030000
                  BEGIN                                                 04032000
                  TOS := ERR84; GO ABORT                                04034000
                  END;                                                  04036000
               END;                                                     04038000
            TOS := @SLREFEDSEGS;                                        04040000
            XREG := 15;                                                 04042000
            DO BEGIN                                                    04044000
               SEGS(XREG) := SEGS(XREG) LOR LPS0(XREG);                 04046000
               XREG := XREG-1                                           04048000
               END UNTIL <;                                             04050000
            DEL                                                         04052000
            END;                                                        04054000
         TOS := TOS-1                                                   04056000
         END UNTIL <;                                                   04058000
      DEL;                                                              04060000
                                                                        04062000
      <<* * * GET EXTERNALS OF SEGMENTS * * *>>                         04064000
                                                                        04066000
      TOS := 255;  <<SEG. NR.>>                                         04068000
      DO BEGIN                                                          04070000
         IF TESTBIT(SEGS,S0) THEN  <<SEGMENT REFERENCED?>>              04072000
            BEGIN                                                       04074000
            GETREFTABENT(S0);                                           04076000
            IF < THEN GO NFG;  <<ERROR?>>                               04078000
            IF NOT SLSATISFIEDSEG THEN  <<UNSATISFIED EXTERNALS?>>      04080000
               BEGIN                                                    04082000
               TOS := SLFNUM(SLNR);                                     04084000
               TOS := (SLNRRECS-SLSLD.(2:7)-1)&LSL(7);                  04086000
               TOS := P256-SLSLD.(9:7);  <<NR. WORDS OF SPACING>>       04088000
               ASSEMBLE(DDUP,ADD);                                      04090000
               MAKEROOMINDL(*);                                         04092000
               IF < THEN GO NFG;  <<ERROR?>>                            04094000
               TOS := TOS+@DLAVAIL;  <<BUFFER ADR.>>                    04096000
               ASSEMBLE(XCH,ZERO);                                      04098000
               TOS := SLSLD.(2:7)+SLSA+1;  <<REC. NR.>>                 04100000
               FREADDIR(*,*,*,*);                                       04102000
               IF <> THEN GO IOERROR;  <<ERROR?>>                       04104000
               TOS := @DLAVAIL;  <<TARGET POINTER>>                     04106000
               TOS := @DLAVAIL+P256;  <<SOURCE POINTER>>                04108000
               TOS := PS0;  <<FIRST WORD OF NAME>>                      04110000
               DO BEGIN                                                 04112000
                  IF < THEN  <<SATISFIED?>>                             04114000
                     BEGIN                                              04116000
                     TOS := TOS+TOS.(4:3)+2;                            04118000
                     ASSEMBLE(DDUP,ZROB);                               04120000
                     TOS := TOS+PARMLEN(*)                              04122000
                     END                                                04124000
                  ELSE  <<UNSATISFIED>>                                 04126000
                     BEGIN                                              04128000
                     TOS := TOS.(4:3)+1;                                04130000
                     ASSEMBLE(MOVE 1);  <<MOVE NAME>>                   04132000
                     PS1 := SLNR&LSL(12)+1;  <<TYPE NR. AND NR. REF.>>  04134000
                     ASSEMBLE(INCB,DDUP; ZROB,INCA);                    04136000
                     TOS := PARMLEN(*)+1;                               04138000
                     ASSEMBLE(MOVE 1)  <<P-LABEL AND PARM. INFO>>       04140000
                     END;                                               04142000
                  TOS := PS0;  <<NEXT FIRST WORD OF NAME>>              04144000
                  END UNTIL =;                                          04146000
               DDEL;                                                    04148000
               @DLAVAIL := TOS                                          04150000
               END                                                      04152000
            END;                                                        04154000
         TOS := TOS-1                                                   04156000
         END UNTIL <;                                                   04158000
      SAVEREFTABBUF;  <<SAVE BUFFER>>                                   04160000
      IF < THEN GO NFG;  <<ERROR?>>                                     04162000
                                                                        04164000
      ENDLOOP:                                                          04166000
      DEL;                                                              04168000
      TOS := SLSEGS(SLNR);                                              04170000
      MOVE * := SEGS,(16);  <<ALL SEGMENTS REFERENCED>>                 04172000
      SLNR := SLNR-1                                                    04174000
      END;                                                              04176000
                                                                        04178000
   <<* * * LIST UNSATISFIED EXTERNALS * * *>>                           04180000
                                                                        04182000
   IF @DLAVAIL <> @DLAREA2 THEN  <<REMAINING ENTRIES?>>                 04184000
      BEGIN                                                             04186000
      @UXP := @DLAREA2;  <<INIT. ENTRY POINTER>>                        04188000
      DO BEGIN                                                          04190000
         EXTNPARMS;                                                     04192000
         IF UXUTYPE = 4 THEN  <<UNKNOWN PROCEDURE?>>                    04194000
            BEGIN                                                       04196000
            TOS := ERR41; GO ABORT                                      04198000
            END;                                                        04200000
         MOVE BLINE := "UNRESOLVED ",2;                                 04202000
         TOS := UXUTYPE;  <<EXTERNAL TYPE>>                             04204000
         ASSEMBLE(DDUP);                                                04206000
         TYPESTRING(*,*);                                               04208000
         TOS := IF TOS = 3 THEN TOS+5 ELSE TOS+4;                       04210000
         MOVE * := "EXTERNAL ",2;                                       04212000
         TOS := @UXNAME&LSL(1)+1;                                       04214000
         MOVE * := *,(UXNC);                                            04216000
         PRINTLINE';                                                    04218000
         IF < THEN GO NFG;  <<ERROR?>>                                  04220000
         @UXP := @UXP+UXNW  <<NEXT ENTRY>>                              04222000
         END UNTIL @UXP = @DLAVAIL;                                     04224000
      BINDINGERROR := BINDINGERROR+1  <<SET FLAG>>                      04226000
      END;                                                              04228000
   TOS := BINDINGERROR;                                                 04230000
   IF <> THEN  <<BINDING ERROR?>>                                       04232000
      BEGIN                                                             04234000
      TOS := ERR27; GO ABORT                                            04236000
      END;                                                              04238000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04240000
   GO GETOUT;                                                           04242000
                                                                        04244000
   IOERROR:                                                             04246000
   FERROR(SLFNUM(SLNR));                                                04248000
   GO NFG;                                                              04250000
                                                                        04252000
   ABORT:                                                               04254000
   MERROR := TOS;  <<STORE ERROR NR.>>                                  04256000
                                                                        04258000
   NFG:                                                                 04260000
   SLNR := MLIBSEARCH;                                         <<00784>>04262000
   WHILE >= DO                                                 <<00784>>04264000
   BEGIN                                                       <<00784>>04266000
       IF SLPVINFO (SLNR) <> 0 THEN                            <<00784>>04268000
        DISMOUNTVOLSET (SLPVINFO (SLNR),MPIN);                 <<00784>>04270000
       SLNR := SLNR - 1;                                       <<00784>>04272000
   END;                                                        <<00784>>04274000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04276000
                                                                        04278000
   GETOUT:                                                              04280000
                                                               <<00807>>04282000
   <<* * * STORE HIT/MISS COUNTERS IN CACHE * * *>>            <<00807>>04284000
                                                               <<00807>>04286000
   IF LOADCACHESEG<>0 THEN                                     <<00807>>04288000
     BEGIN                                                     <<00807>>04290000
       TOS:=LOADCACHESEG;       <<TARGET SEGMENT>>             <<00807>>04292000
       TOS:=CACHEHITS;          <<TARGET>>                     <<00807>>04294000
       TOS:=@HITS;              <<SOURCE>>                     <<00807>>04296000
       TOS:=4;                  <<LENGTH>>                     <<00807>>04298000
       ASSEMBLE(MTDS 4);        <<MOVE>>                       <<00807>>04300000
     END;                                                      <<00807>>04302000
                                                               <<00807>>04304000
   @DLAVAIL := @DLAREA2;  <<RESET DL AVAILABLE POINTER>>                04306000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            04308000
   END;                                                                 04310000
PROCEDURE LOADEXTERNALS;                                                04312000
   <<LOADS THE LIBRARY PROCEDURES THAT ARE SPECIFIED BY THE DIRECTLY    04314000
     REFERENCED SEGMENT MAP.  NOTE THAT THIS PROCEDURE USES THE         04316000
     CONDITION CODE TO INDICATE AN ERROR>>                              04318000
   OPTION UNCALLABLE;                                                   04320000
   BEGIN                                                                04322000
   INTEGER ARRAY SLMAP' (*) = Q;                                        04324000
   INTEGER POINTER SSLMAP';                                             04326000
   INTEGER POINTER PSLMAP';                                             04328000
   INTEGER POINTER GSLMAP';                                             04330000
   DOUBLE ARRAY SLKEY' (*) = Q;                                         04332000
   DOUBLE SSLKEY' = SLKEY';                                             04334000
   DOUBLE PSLKEY' = SSLKEY'+2;                                          04336000
   DOUBLE GSLKEY' = PSLKEY'+2;                                          04338000
                                                                        04340000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           04342000
                                                                        04344000
   TOS := SSLKEY;                                                       04346000
   TOS := PSLKEY;                                                       04348000
   TOS := GSLKEY;                                                       04350000
                                                                        04352000
   <<* * * ALLOCATE DL BUFFERS * * *>>                                  04354000
                                                                        04356000
   XREG := MLIBSEARCH;  <<SL COUNTER>>                                  04358000
   MAKEROOMINDL((XREG+1)&LSL(7));  <<ALLOCATE ALL SPACE NOW!>>          04360000
   IF < THEN GO NFG;  <<ERROR?>>                                        04362000
   DO BEGIN                                                             04364000
      TOS := @DLAREA1-128;                                              04366000
      ASSEMBLE(DUP,DUP);                                                04368000
      SLMAP(XREG) := TOS&LSL(1);                                        04370000
      SLMAP'(XREG) := TOS-@DLAREA2;  <<SAVE DL REL. ADR.>>              04372000
      @DLAREA1 := TOS;                                                  04374000
      XREG := XREG-1                                                    04376000
      END UNTIL <;                                                      04378000
                                                                        04380000
   <<* * * DETERMINE WHICH SEGMENTS ARE ALLOCATED * * *>>               04382000
                                                                        04384000
   TOS := MLIBSEARCH;  <<SL COUNTER>>                                   04386000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  04388000
   TOS := @SBUF0&LSL(1);                                                04390000
   DO BEGIN                                                             04392000
      CLEARBUFFER(SBUF0);                                               04394000
      IF LSEARCH(SLKEY'(S1),NORMAL,SLFILE) THEN                         04396000
         BEGIN                                                          04398000
         TOS := LASTCST;                                                04400000
         DO BEGIN                                                       04402000
            IF TESTBIT(ENTP2,S0) THEN BPS1(XFORM(S0).(0:8)) := S0;      04404000
            TOS := TOS-1;                                               04406000
            END UNTIL  <  ;                                             04408000
         DEL                                                            04410000
         END;                                                           04412000
      TOS := SLMAP'(S1); TOS := @SBUF0; TOS := 128;                     04414000
      ASSEMBLE(MVBL 3);                                                 04416000
      S1 := S1-1                                                        04418000
      END UNTIL <;                                                      04420000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                04422000
                                                                        04424000
   <<* * * DETERMINE WHICH SEGMENTS NEED TO BE ALLOCATED * * *>>        04426000
                                                                        04428000
   TOS := MLIBSEARCH;  <<SL COUNTER>>                                   04430000
   DO BEGIN                                                             04432000
      TOS := SLASEGS(S0);                                               04434000
      CLEARBITMAP(*);                                                   04436000
      TOS := 255;  <<SEG. NR.>>                                         04438000
      DO BEGIN                                                          04440000
         TOS := 0;  <<FOR TESTBIT RESULT>>                              04442000
         TOS := SLSEGS(S2);                                             04444000
         TOS := S2;  <<SEG. NR.>>                                       04446000
         IF TESTBIT(*,*) THEN  <<SEGMENT REFERENCED?>>                  04448000
            BEGIN                                                       04450000
            TOS := SLMAP(XREG);                                         04452000
            TOS := BPS0(S1);  <<CST NR.>>                               04454000
            XREG := S3;  <<SL NR.>>                                     04456000
            ASSEMBLE(ZROB,CMP);                                         04458000
            IF = THEN  <<NOT ALLOCATED?>>                               04460000
               BEGIN                                                    04462000
               TOS := SLASEGS(XREG);                                    04464000
               SETBIT(*,S1);                                            04466000
               NSLA(XREG) := NSLA(XREG)+1                               04468000
               END                                                      04470000
            ELSE  <<ALREADY ALLOCATED>>                                 04472000
               NSLR(XREG) := NSLR(XREG)+1                               04474000
            END;                                                        04476000
         TOS := TOS-1                                                   04478000
         END UNTIL <;                                                   04480000
      ASSEMBLE(DEL,DECA)                                                04482000
      END UNTIL <;                                                      04484000
                                                                        04486000
   <<* * * CONSTRUCT CST TABLE * * *>>                                  04488000
                                                                        04490000
   NCSTS := NSSLA+NPSLA+NGSLA+NPA;  <<NR. CST'S NEEDED>>                04492000
   MAKEROOMINDL(NCSTS);                                                 04494000
   IF < THEN GO NFG;  <<ERROR?>>                                        04496000
   TOS := @DLAREA1-NCSTS;                                               04498000
   @CSTNRS := S0;                                                       04500000
   @DLAREA1 := TOS;                                                     04502000
   IF  NCSTS > NPA  THEN                                                04504000
      BEGIN  << GET CST ENTRIES FOR SHARED SEGMENTS >>                  04506000
      GETENTRYS(CSTNRS,NCSTS-NPA,1);  <<GET CST ENTRIES>>               04508000
      IF <> THEN  <<ERROR?>>                                            04510000
         BEGIN                                                          04512000
         TOS := ERR65; GO ABORT                                         04514000
         END;                                                           04516000
      CSTSALLOCATED := CSTSALLOCATED+1;  <<SET FLAG>>                   04518000
      END;                                                              04520000
   IF  NPA <> 0  THEN                                                   04522000
      BEGIN  << ALLOCATE THE CST BLOCK AS WE HAVE A PROGRAM >>          04524000
      CSTBX := ALCSTBLOCK(NPA);                                         04526000
      IF  <  THEN                                                       04528000
         BEGIN                                                          04530000
         TOS := ERR65;                                                  04532000
         GO ABORT;                                                      04534000
         END;                                                           04536000
      CSTBLOCKALLOCATED := CSTBLOCKALLOCATED+1;                         04538000
      END;                                                              04540000
   CLEARBITMAP(FIXEDCSTS);                                              04542000
   @SSLAP := @CSTNRS;                                                   04544000
   @PSLAP := @SSLAP+NSSLA;                                              04546000
   @GSLAP := @PSLAP+NPSLA;                                              04548000
   @PAP := @GSLAP+NGSLA;                                                04550000
   FOR  XREG := 0  UNTIL  NPA-1  DO  PAP(XREG) := XREG+%301;            04552000
                                                                        04554000
   <<* * * LOAD SL SEGMENTS * * *>>                                     04556000
                                                                        04558000
   SLNR := 0;                                                           04560000
   TOS := MLIBSEARCH;  <<SL COUNTER>>                                   04562000
   DO BEGIN                                                             04564000
                                                                        04566000
      <<* * * ASSIGN CST NUMBERS TO SEGMENTS * * *>>                    04568000
                                                                        04570000
      TOS := SLAP(SLNR);  <<CST TABLE POINTER>>                         04572000
      TOS := 255;  <<SEG. NR.>>                                         04574000
      DO BEGIN                                                          04576000
         TOS := 0;  <<FOR TESTBIT RESULT>>                              04578000
         TOS := SLASEGS(SLNR);                                          04580000
         TOS := S2;  <<SEGMENT NR.>>                                    04582000
         IF TESTBIT(*,*) THEN                                           04584000
            BEGIN                                                       04586000
            TOS := SLMAP(XREG);                                         04588000
            BPS0(S1) := PS2;  <<CST NR.>>                               04590000
            PS2.(0:8) := S1;  <<SEG. NR.>>                              04592000
            ASSEMBLE(DEL,INCB)                                          04594000
            END;                                                        04596000
         TOS := TOS-1                                                   04598000
         END UNTIL <;                                                   04600000
      DDEL;                                                             04602000
                                                                        04604000
      <<* * * LOAD SEGMENTS * * *>>                                     04606000
                                                                        04608000
      DRTRECD := 0D;  <<INIT. REC. NR.>>                                04610000
      TOS := SLAP(SLNR);  <<CST TABLE POINTER>>                         04612000
      TOS := NSLA(XREG);  <<SEG. COUNTER>>                              04614000
      WHILE <> DO                                                       04616000
         BEGIN                                                          04618000
         TOS := SLFNUM(XREG);  <<SL FILE NR.>>                          04620000
         TOS := PS2.(0:8);  <<SEG. NR.>>                                04622000
         TOS := SLNR;  <<SEG. TYPE>>                                    04624000
         TOS := PS4.(8:8);  <<CST NR.>>                                 04626000
         GETREFTABENT(S2);                                              04628000
         IF < THEN GO NFG;  <<ERROR?>>                                  04630000
         IF REFTAB'EXTSTT = 1                                  <<01196>>04632000
           THEN LASTLOADLOGICAL:=TRUE                          <<01196>>04634000
           ELSE LASTLOADLOGICAL:=FALSE;                        <<01196>>04636000
         TOS := S1&LSL(6);  <<SEG. TYPE>>                               04638000
         TOS.(10:3) := SLFLAGS.(4:3);  <<SL SEG. FLAGS>>                04640000
         CSTFLAGS(S1) := TOS;  <<SAVE SEG. FLAGS>>                      04642000
         TOS := RTDP;  <<SEG. DESCRIPTOR>>                              04644000
         TOS := SLMAP(SLNR);  <<CST MAP>>                               04646000
         TOS := SLCAP(XREG); << SL GROUP CAPABILITY >>         <<00.02>>04648000
         LOADSEGMENT(*,*,*,*,*,*,*,*,TRUE);                    <<00.02>>04650000
         IF < THEN GO NFG;  <<ERROR?>>                                  04652000
         ASSEMBLE(INCB,DECA)                                            04654000
         END;                                                           04656000
      SLNR := SLNR+1;                                                   04658000
      ASSEMBLE(DDEL,DECA)                                               04660000
      END UNTIL <;                                                      04662000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04664000
   GO GETOUT;                                                           04666000
                                                                        04668000
   ABORT:                                                               04670000
   MERROR := TOS;  <<ERROR NR.>>                                        04672000
                                                                        04674000
   NFG:                                                                 04676000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04678000
                                                                        04680000
   GETOUT:                                                              04682000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            04684000
   END;                                                                 04686000
PROCEDURE LOADSEGMENT (FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD,CSTMAP,  04688000
                       CAPABILITY,PRIVMODE);                   <<00.02>>04690000
   <<LOADS THE SPECIFIED SEGMENT.  NOTE THAT THIS PROCEDURE USES THE    04692000
     CONDITION CODE TO INDICATE AN ERROR>>                              04694000
   VALUE FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD,CAPABILITY,   <<00.02>>04696000
         PRIVMODE;                                             <<00.02>>04698000
   INTEGER FNUM,SEGNR,SEGTYPE,CSTNR,SEGLEN,SEGRECD;                     04700000
LOGICAL CAPABILITY,PRIVMODE;                                   <<00.02>>04702000
   BYTE ARRAY CSTMAP;                                                   04704000
   OPTION UNCALLABLE;                                                   04706000
   BEGIN                                                                04708000
   LABEL ABORT;                                                         04710000
   DOUBLE SEGDESCRIP = SEGLEN;                                          04712000
   INTEGER STTNUMB = Q+1,                                      <<01196>>04714000
           NUMBEXT = Q+2,                                      <<01196>>04716000
           WORK1   = Q+3;                                      <<01196>>04718000
   INTEGER POINTER STT2 = Q+4;                                 <<01196>>04720000
   INTEGER SEGLEN' = Q+5,                                      <<01196>>04722000
           STTRECD = Q+6;                                      <<01196>>04724000
   INTEGER POINTER STT = Q+7;                                  <<01196>>04726000
   BYTE POINTER STTMAP = Q+8;                                  <<01196>>04728000
   INTEGER ARRAY STTBUF(*) = Q+9;                              <<01196>>04730000
                                                                        04732000
   INTEGER SUBROUTINE FINDEXTERNAL (STTNR);                             04734000
      <<SEARCHES THE SATISFIED EXTERNAL LIST FOR THE P-LABEL THAT       04736000
        IS TO BE INSERTED IN THE SPECIFIED SEGMENT AT THE SPECIFIED     04738000
        STT LOCATION>>                                                  04740000
      VALUE STTNR;                                                      04742000
      INTEGER STTNR;                                                    04744000
      BEGIN                                                             04746000
      TOS := @SXTABLE;  <<POINTER TO FIRST ENTRY>>                      04748000
      WHILE @PS0 < @SXTABLE(NWSXTABLE) DO                               04750000
         BEGIN                                                          04752000
         IF PS0(1).(0:4) = SEGTYPE THEN  <<CORRECT TYPE?>>              04754000
            BEGIN                                                       04756000
            TOS := PS0(XREG).(8:8);  <<NR. REFERENCES>>                 04758000
            DO BEGIN                                                    04760000
               TOS := SEGNR;  <<SEG. NR.>>                              04762000
               TOS := S4;  <<STT NR.>>                                  04764000
               TOS.(0:8) := TOS;  <<LABEL LOCATION>>                    04766000
               IF TOS = PS2(S1+1) THEN                                  04768000
                  BEGIN                                                 04770000
                  TOS := PS1;  <<ENTRY POINT P-LABEL>>                  04772000
                  TOS := SLMAP(PS2(1).(4:4));  <<CST MAP POINTER>>      04774000
                  TOS := BPS0(S1.(8:8));  <<NEW CST NR.>>               04776000
                  DELB;                                                 04778000
                  TOS.(8:8) := TOS;  <<INSERT CST NR.>>                 04780000
                  SETBIT0;  <<SET "EXTERNAL" BIT>>                      04782000
                  ASSEMBLE(DELB,DELB);                                  04784000
                  S3 := TOS;  <<P-LABEL>>                               04786000
                  RETURN                                                04788000
                  END;                                                  04790000
               TOS := TOS-1                                             04792000
               END UNTIL =;                                             04794000
            DEL                                                         04796000
            END;                                                        04798000
         TOS := TOS+PS0(1).(8:8)+2  <<NEXT ENTRY>>                      04800000
         END;                                                           04802000
      TOS := ERR28+SEGTYPE;  <<ERROR NR.>>                              04804000
      GO ABORT                                                          04806000
      END;                                                              04808000
                                                                        04810000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           04812000
                                                                        04814000
   TOS:=0D;                <<STTNUMB,NUMBEXT>>                 <<01196>>04816000
   ASSEMBLE(DDUP);         <<WORK1,STT2    >>                  <<01196>>04818000
   TOS := SEGLEN-1;                                                     04820000
   TOS := S0.(2:7)+SEGRECD-2;                                           04822000
   TOS := SEGLEN'.(9:7)+@STTBUF+P256;  <<PL ENTRY POINTER>>             04824000
   TOS := (S0+1)&LSL(1);                                                04826000
   TOS := P512; ASSEMBLE(ADDS 0);  <<STT AND MAP BUFFER>>               04828000
                                                                        04830000
   <<* * * LOAD STT * * *>>                                             04832000
                                                                        04834000
   TOS := FNUM;                                                         04836000
   TOS := @STTBUF;                                                      04838000
   TOS := P384;                                                         04840000
   IF SEGTYPE <> 3 THEN TOS := TOS+128;  <<SL SEGMENT?>>                04842000
   TOS := 0; TOS := STTRECD;                                            04844000
   IF < THEN  <<SPECIAL CASE?>>                                         04846000
      BEGIN                                                             04848000
      S3 := S3+128;  <<ADJ. BUFFER ADR.>>                               04850000
      S2 := S2-128;  <<ADJ. COUNT>>                                     04852000
      TOS := TOS+1  <<ADJ. REC. NR.>>                                   04854000
      END;                                                              04856000
   FREADDIR(*,*,*,*);  <<LOAD STT>>                                     04858000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   04860000
                                                                        04862000
   <<* * * REPAIR STT * * *>>                                           04864000
IF LASTLOADLOGICAL THEN                                        <<01196>>04866000
  BEGIN                <<SEG LAST LOADED WITH CST>>            <<01196>>04868000
                       <<EXTENSION FIRMWARE      >>            <<01196>>04870000
    STTNUMB:=STT.(8:8);   <<# STT'S>>                          <<01196>>04872000
    NUMBEXT:=STTNUMB-STT.(0:8); <<# EXTERNAL STT'S>>           <<01196>>04874000
    @STT2:=@STT-STTNUMB;        <<PTR TO LAST STT>>            <<01196>>04876000
    WHILE (NUMBEXT:=NUMBEXT-1) >= 0 DO                         <<01196>>04878000
      BEGIN                     <<EACH EXTERNAL STT>>          <<01196>>04880000
        WORK1:=STT2;            <<GET ENTRY>>                  <<01196>>04882000
        IF SEGTYPE <> 3 THEN                                   <<01196>>04884000
          BEGIN                 <<LOADING SL SEG>>             <<01196>>04886000
            IF STTMAP(STTNUMB) <> 255 THEN                     <<01196>>04888000
              BEGIN <<SAT. BY INTERNAL SL SEG>>                <<01196>>04890000
                WORK1.(0:1):=1; <<SET BIT 0>>                  <<01196>>04892000
                WORK1.(8:8):=CSTMAP(STTMAP(STTNUMB));          <<01196>>04894000
              END                                              <<01196>>04896000
             ELSE                                              <<01196>>04898000
              BEGIN <<SAT BY EXTERNAL SL SEG>>                 <<01196>>04900000
                WORK1:=FINDEXTERNAL(STTNUMB);                  <<01196>>04902000
              END;                                             <<01196>>04904000
          END                                                  <<01196>>04906000
         ELSE                                                  <<01196>>04908000
          BEGIN                 <<LOADING PROG SEG>>           <<01196>>04910000
            IF WORK1 > 0 AND                                   <<01196>>04912000
               WORK1.(8:8) <= NPA THEN                         <<01196>>04914000
              BEGIN <<SAT. BY INTERNAL PROG SEG>>              <<01196>>04916000
                WORK1.(0:1):=1; <<SET BIT 0>>                  <<01196>>04918000
                WORK1.(8:8):=CSTMAP(WORK1.(8:8));              <<01196>>04920000
              END                                              <<01196>>04922000
             ELSE                                              <<01196>>04924000
              BEGIN <<SAT BY EXTERNAL SL SEG>>                 <<01196>>04926000
                WORK1:=FINDEXTERNAL(STTNUMB);                  <<01196>>04928000
              END;                                             <<01196>>04930000
          END;                                                 <<01196>>04932000
        STT2:=WORK1;  <<REPAIRED STT ENTRY>>                   <<01196>>04934000
        @STT2:=@STT2+1; <<INCREMENT PTR>>                      <<01196>>04936000
        STTNUMB:=STTNUMB-1; <<NEXT STT #>>                     <<01196>>04938000
      END; <<WHILE>>                                           <<01196>>04940000
    STT:=STT.(8:8) + %40000;<<RESET STT HEAD>>                 <<01196>>04942000
  END                                                          <<01196>>04944000
 ELSE                                                          <<01196>>04946000
  BEGIN            <<SEG LAST LOADED WITHOUT >>                <<01196>>04948000
                   <<CST EXTENSION FIRMWARE  >>                <<01196>>04950000
                                                                        04952000
   TOS := STT.(8:8);  <<ENTRY COUNTER>>                                 04954000
   TOS := @STT-S0;  <<POINTER TO LAST ENTRY>>                           04956000
   DO BEGIN                                                             04958000
      TOS := PS0;  <<LOAD STT ENTRY>>                                   04960000
      IF < THEN  <<EXTERNAL ENTRY?>>                                    04962000
         BEGIN                                                          04964000
         XREG := IF SEGTYPE <> 3 THEN STTMAP(S2) ELSE S0.(8:8);         04966000
         TOS := CSTMAP(XREG);  <<NEW CST NR.>>                          04968000
         ASSEMBLE(TEST);                                                04970000
         IF <> THEN  <<INTERNAL LINK>>                                  04972000
            TOS.(8:8) := TOS  <<INSERT CST NR.>>                        04974000
         ELSE  <<EXTERNAL LINK>>                                        04976000
            BEGIN                                                       04978000
            DDEL;                                                       04980000
            TOS := FINDEXTERNAL(S1)  <<P-LABEL>>                        04982000
            END                                                         04984000
         END;                                                           04986000
      PS1 := TOS;  <<STORE STT ENTRY>>                                  04988000
      ASSEMBLE(INCA,DECB)                                               04990000
      END UNTIL =;                                                      04992000
  END;                                                         <<01196>>04994000
                                                                        04996000
   <<* * * STORE STT * * *>>                                            04998000
                                                                        05000000
   TOS := FNUM;                                                         05002000
   TOS := @STTBUF;                                                      05004000
   TOS := P384;                                                         05006000
   IF SEGTYPE <> 3 THEN TOS := TOS+128;  <<SL SEGMENT?>>                05008000
   TOS := 0; TOS := STTRECD;                                            05010000
   IF < THEN  <<SPECIAL CASE?>>                                         05012000
      BEGIN                                                             05014000
      S3 := S3+128;  <<ADJ. BUFFER ADR.>>                               05016000
      S2 := S2-128;  <<ADJ. COUNT>>                                     05018000
      TOS := TOS+1  <<ADJ. REC. NR.>>                                   05020000
      END;                                                              05022000
   FWRITEDIR(*,*,*,*);  <<STORE STT>>                                   05024000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   05026000
                                                                        05028000
IF LASTLOADLOGICAL THEN                                        <<01196>>05030000
  BEGIN                  <<SEG LAST LOADED WITH >>             <<01196>>05032000
                         <<CST EXTENSION FIRMWARE>>            <<01196>>05034000
    IF SEGTYPE <> 3 THEN                                       <<01196>>05036000
      BEGIN              <<LOADING SL SEG>>                    <<01196>>05038000
        REFTAB'EXTSTT:=0;<<CLEAR "CONVERTED" FLAG>>            <<01196>>05040000
        RTMODIFIED:=1;                                         <<01196>>05042000
        SAVEREFTABBUF;   <<SAVE MODIFIED REF TAB>>             <<01196>>05044000
      END                                                      <<01196>>05046000
     ELSE                                                      <<01196>>05048000
      BEGIN              <<LOADING PROG SEG>>                  <<01196>>05050000
        TOS:=@PROGREC0+(NPA+57)&LSR(1); <<PTR TO SEG DESC>>    <<01196>>05052000
        PS0(SEGNR).PROGEXTSTT:=0; <<CLEAR "CONVERTED" FLAG>>   <<01196>>05054000
        ASSEMBLE(DEL);                                         <<01196>>05056000
        FWRITEDIR(PROGFNUM,PROGREC0,128,0D);<<SAVE PROG DIR>>  <<01196>>05058000
      END;                                                     <<01196>>05060000
  END;                                                         <<01196>>05062000
   <<* * * INITIALIZE CST ENTRY * * *>>                                 05064000
                                                                        05066000
   IF  CSTNR > %300  THEN                                               05068000
      BEGIN  << PROGRAM FILE ENTRY >>                                   05070000
      TOS := CSTBX;                                                     05072000
      TOS := CSTNR-%301;                                                05074000
      END                                                               05076000
   ELSE  TOS := CSTNR;                                                  05078000
   TOS := SEGLEN.(2:12);   << LENGTH/4 >>                               05080000
   TOS := PRIVMODE LAND LOGICAL(SEGLEN.(0:1));                 <<00.02>>05082000
   IF LS0 AND NOT CAPABILITY THEN                              <<00.02>>05084000
   BEGIN << PRIV. MODE VIOLATION >>                            <<00.02>>05086000
      TOS := ERR44;                                            <<00.02>>05088000
      GO ABORT;                                                <<00.02>>05090000
   END;                                                        <<00.02>>05092000
   TOS.(1:1) := TOS; << INSERT MODE BIT >>                     <<00.02>>05094000
   TOS := 0;                                                            05096000
   TOS := FGETDISKADR(FNUM,DOUBLE(LOGICAL(SEGRECD)));                   05098000
   TOS := TOS&TASL(8)&DLSR(8); << MOVE LDEV INTO S-2, D. A. IN S-1,S >> 05100000
   TOS:=CSTFLAGS(CSTNR).(12:1); <<SYSTEM BIT>>                 <<03772>>05102000
   IF  CSTNR >%300 THEN PUTCSTBLOCK(*,*,*,*,*,*)               <<03772>>05104000
   ELSE PUTCST(*,*,*,*,*);                                     <<03772>>05106000
   TOS := CCE;  <<OK CONDITION CODE>>                                   05108000
   GO GETOUT;                                                           05110000
                                                                        05112000
   IOERROR:                                                             05114000
   FERROR(FNUM);                                                        05116000
   GO NFG;                                                              05118000
                                                                        05120000
   ABORT:                                                               05122000
   MERROR := TOS;  <<ERROR NR.>>                                        05124000
                                                                        05126000
   NFG:                                                                 05128000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                05130000
                                                                        05132000
   GETOUT:                                                              05134000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            05136000
   END;                                                                 05138000
PROCEDURE LOADPROGRAM;                                                  05140000
   <<REPAIRS THE STT'S OF THE PROGRAM FILE AND LOADS THE SEGMENTS INTO  05142000
     VIRTUAL MEMORY. ALSO UPDATES THE CST RE-MAPPING ARRAY IN RECORD 0  05144000
     AND STORES SAME.  NOTE THAT THIS PROCEDURE USES THE CONDITION CODE 05146000
     TO INDICATE AN ERROR>>                                             05148000
   OPTION UNCALLABLE;                                                   05150000
   BEGIN                                                                05152000
   INTEGER MAXSEGMENT = Q+1;  <<MAX. SEGMENT SIZE>>                     05154000
   BYTE POINTER PROGREMAP = Q+2;  <<CST RE-MAPPING ARRAY>>              05156000
   INTEGER POINTER SEGDESCRIP = Q+3;  <<SEG. DESCRIPTOR ARRAY>>         05158000
   BYTE ARRAY PROGMAP (*) = Q+4;  <<LAST CST TO NEW CST MAP>>           05160000
   INTEGER ARRAY MAP (*) = Q+4;                                         05162000
                                                                        05164000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           05166000
                                                                        05168000
   TOS := ABSOLUTE(MAXCODE);  <<MAXIMUM CODE SEGMENT SIZE>>             05170000
   TOS := @PROGREC0(28)&LSL(1);                                         05172000
   TOS := @PROGREC0+(NPA+57)&LSR(1);                                    05174000
   ASSEMBLE(ADDS 128);                                                  05176000
   CLEARBUFFER(MAP);                                                    05178000
                                                                        05180000
   <<* * * CONSTRUCT LAST CST TO NEW CST MAP * * *>>                    05182000
                                                                        05184000
   BLANKLINE;                                                           05186000
   IF < THEN GO NFG;  <<ERROR?>>                                        05188000
   TOS := @BLINE;                                                       05190000
   TOS := 0;  <<SEG. NR.>>                                              05192000
   TOS := NPA;  <<SEG. COUNTER>>                                        05194000
   DO BEGIN                                                             05196000
      TOS := PAP(S1);  <<NEW CST NR.>>                                  05198000
      ASSEMBLE(DUP,DUP);                                                05200000
      XREG := PROGREMAP(XREG);  <<OLD CST NR.>>                         05202000
      PROGMAP(XREG) := TOS;  <<NEW CST NR.>>                            05204000
      CSTFLAGS(S0) := %(2)11000000;  <<CST FLAGS>>                      05206000
      PROGREMAP(S3) := TOS;  <<NEW CST NR.>>                            05208000
      PAP(XREG).(0:8) := XREG;  <<SEG. NR.>>                            05210000
      NTOA(*,8,BPS3(2));  <<CST NR.>>                                   05212000
      @BPS2 := @BPS2+4;                                                 05214000
      IF @BPS2-@BLINE = 64 THEN  <<LINE FULL?>>                         05216000
         BEGIN                                                          05218000
         PRINTLINE;                                                     05220000
         IF < THEN GO NFG;  <<ERROR?>>                                  05222000
         @BPS2 := @BLINE  <<RESET POINTER>>                             05224000
         END;                                                           05226000
      ASSEMBLE(INCB,DECA)                                               05228000
      END UNTIL =;                                                      05230000
   DDEL;                                                                05232000
   IF TOS <> @BLINE THEN                                                05234000
      BEGIN                                                             05236000
      PRINTLINE;                                                        05238000
      IF < THEN GO NFG  <<ERROR?>>                                      05240000
      END;                                                              05242000
                                                                        05244000
   <<* * * SAVE RECORD 0 AND GET STARTING CST NUMBER * * *>>            05246000
                                                                        05248000
   FWRITEDIR(PROGFNUM,PROGREC0,128,0D);  <<STORE RECORD 0>>             05250000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   05252000
   MSTARTINGCST := PROGREMAP(PSTARTINGSEG) CAT SEGDESCRIP(XREG) (0:0:1);05254000
                                                                        05256000
   <<* * * LOAD SEGMENTS * * *>>                                        05258000
                                                                        05260000
   TOS := NPA;  <<SEG. COUNTER>>                                        05262000
   TOS := PSEGMENTRECD;  <<FIRST SEG. REC. NR.>>                        05264000
   XREG := 0;  <<SEG. NR.>>                                             05266000
   DO BEGIN                                                             05268000
   TOS:=@PROGREC0+(NPA+57)&LSR(1); <<PTR TO SEG DESC>>         <<01196>>05270000
   IF PS0(XREG).PROGEXTSTT = 1                                 <<01196>>05272000
     THEN LASTLOADLOGICAL:=TRUE                                <<01196>>05274000
     ELSE LASTLOADLOGICAL:=FALSE;                              <<01196>>05276000
   ASSEMBLE(DEL);                                              <<01196>>05278000
      TOS := PROGFNUM;  <<PROG. FILE NR.>>                              05280000
      TOS := XREG;  <<SEGMENT NR.>>                                     05282000
      TOS := 3;  <<SEGMENT TYPE>>                                       05284000
      TOS := PROGREMAP(XREG);  <<CST NR.>>                              05286000
      TOS := SEGDESCRIP(XREG);  <<SEG. LENGTH AND MODE>>                05288000
      IF S0.(2:14) > MAXSEGMENT THEN  <<TOO BIG?>>                      05290000
         BEGIN                                                          05292000
         TOS := ERR33; GO ABORT                                         05294000
         END;                                                           05296000
      TOS := S5;  <<SEGMENT REC. NR.>>                                  05298000
      TOS := @PROGMAP;  <<CST MAP>>                                     05300000
      TOS := USERCAP;                                          <<00.02>>05302000
      TOS := NOT MPMODE;  <<PRIV. MODE?>>                               05304000
      IF LS4.(0:1) AND LS0 AND NOT PPRIVMODE THEN <<NO PRIV?>> <<00.04>>05306000
         BEGIN                                                          05308000
         TOS := ERR39; GO ABORT                                         05310000
         END;                                                           05312000
      LOADSEGMENT(*,*,*,*,*,*,*,*,*);                          <<00.02>>05314000
      IF < THEN GO NFG;  <<ERROR?>>                                     05316000
      TOS := TOS+(SEGDESCRIP(XREG).(2:14)+127)&LSR(7); <<NEXT REC. #>>  05318000
      ASSEMBLE(INCX,DECB)                                               05320000
      END UNTIL =;                                                      05322000
                                                                        05324000
   <<* * * MARK PROGRAM FILE AS LOADED * * *>>                          05326000
                                                                        05328000
   TOS := PROGKEY; ASSEMBLE(DZRO,INCB);                                 05330000
   LOADBIT(*,*,*);  <<SET "LOADED" BIT>>                                05332000
   IF < THEN  <<ERROR?>>                                                05334000
      BEGIN                                                             05336000
      TOS := ERR72; GO ABORT                                            05338000
      END;                                                              05340000
   PROGLOADBIT := PROGLOADBIT+1;  <<SET LOAD BIT FLAG>>                 05342000
   TOS := CCE;  <<OK CONDITION CODE>>                                   05344000
   GO GETOUT;                                                           05346000
                                                                        05348000
   IOERROR:                                                             05350000
   FERROR(PROGFNUM);                                                    05352000
   GO NFG;                                                              05354000
                                                                        05356000
   ABORT:                                                               05358000
   MERROR := TOS;  <<ERROR NR.>>                                        05360000
                                                                        05362000
   NFG:                                                                 05364000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                05366000
                                                                        05368000
   GETOUT:                                                              05370000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            05372000
   END;                                                                 05374000
PROCEDURE UPDATESEGTAB;                                                 05376000
   <<MAKES THE NECESSARY ENTRIES IN THE SEGMENT TABLE FOR THE SET       05378000
     OF LOADED AND REFERENCED SEGMENTS>>                                05380000
   OPTION UNCALLABLE;                                                   05382000
   BEGIN                                                                05384000
   INTEGER FORMAT;                                                      05386000
   INTEGER NWCSTS;                                                      05388000
   INTEGER COMWORD = Q+3;                                               05390000
   DEFINE MCOMMAND' = COMWORD.(0:2)#,                                   05392000
          MLIBSEARCH' = COMWORD.(2:2)#,                                 05394000
          MPMODE' = COMWORD.(4:1)#;                                     05396000
   DOUBLE PROCESSKEY' = Q+4;                                            05398000
   DOUBLE PROGKEY' = Q+6;                                               05400000
   DOUBLE ARRAY SLKEY' (*) = Q+8;                                       05402000
   DOUBLE SSLKEY' = Q+8;                                                05404000
   DOUBLE PSLKEY' = Q+10;                                               05406000
   DOUBLE GLSKEY' = Q+12;                                               05408000
   INTEGER ARRAY NSLA' (*) = Q+14;                                      05410000
   INTEGER NSSLA' = Q+14;                                               05412000
   INTEGER NPSLA' = Q+15;                                               05414000
   INTEGER NGSLA' = Q+16;                                               05416000
   INTEGER PROCCST = Q+17;  <<CST NR. OF LOAD/ALLOCATE PROCEDURE>>      05418000
   INTEGER WSP' = Q+18;                                                 05420000
   INTEGER CSTBX' = Q+19;                                               05422000
   INTEGER NPA' = Q+20;                                                 05424000
   INTEGER                                                     <<00211>>05426000
       PROGPVINFO' = Q+21,                                     <<00211>>05428000
       MPIN' = Q+22;                                           <<00211>>05430000
   INTEGER ARRAY SLPVINFO' (*) = Q+23;                         <<00211>>05432000
   INTEGER                                                     <<00211>>05434000
       SSLPVINFO' = Q+23,                                      <<00211>>05436000
       PSLPVINFO' = Q+24,                                      <<00211>>05438000
       GSLPVINFO' = Q+25;                                      <<00211>>05440000
   INTEGER ARRAY RCSTS (*) = Q+26;  <<CST'S REFERENCED>>       <<00211>>05442000
   INTEGER ARRAY ACSTS (*) = RCSTS(16);  <<CST'S ALLOCATED>>            05444000
   INTEGER ARRAY ECSTS (*) = ACSTS(16);  <<USER ENTRY CST TABLE>>       05446000
   INTEGER ARRAY CSTXFORM (*) = ECSTS(-1);  <<SEG. NR. AND CST FLAGS>>  05448000
   INTEGER ARRAY ACSTS' (*) = SBUF0;                                    05450000
                                                                        05452000
   SUBROUTINE UPDATE (SEGTYPE);                                         05454000
      VALUE SEGTYPE;                                                    05456000
      INTEGER SEGTYPE;                                                  05458000
      BEGIN                                                             05460000
      XREG := 255;  <<CST NR.>>                                         05462000
      DO BEGIN                                                          05464000
         IF TESTBIT (ACSTS',XREG) AND                                   05466000
            CSTXFORM(XREG).(8:2) = SEGTYPE THEN                         05468000
            BEGIN                                                       05470000
            SETBIT(ENTP2,XREG);                                         05472000
            XFORM(XREG) := CSTXFORM(XREG);  <<SEG. NR. AND FLAGS>>      05474000
            REFCOUNT(XREG) := 0;  <<CLEAR REF. COUNT>>                  05476000
            ENTTAB(XREG) := @ENTP-@DIR  <<ENTRY INDEX>>                 05478000
            END;                                                        05480000
         XREG := XREG-1                                                 05482000
         END UNTIL <                                                    05484000
      END;                                                              05486000
                                                                        05488000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           05490000
                                                                        05492000
   TOS := MAILBUF;  <<COMMAND WORD>>                                    05494000
   TOS := 0; TOS := MAILDBUF; BS1 := TOS;                               05496000
   TOS := PROGKEY;                                                      05498000
   TOS := SSLKEY;                                                       05500000
   TOS := PSLKEY;                                                       05502000
   TOS := GSLKEY;                                                       05504000
   TOS := NSSLA;                                                        05506000
   TOS := NPSLA;                                                        05508000
   TOS := NGSLA;                                                        05510000
   TOS := MPLABEL.(8:8);                                                05512000
TOS:=0; <<WAS WSP>>                                            <<01549>>05514000
   TOS := CSTBX;                                                        05516000
   TOS := NPA;                                                          05518000
   TOS := MPVINFO;                                             <<00211>>05520000
   TOS := MPIN;                                                <<00211>>05522000
   TOS := SSLPVINFO;                                           <<00211>>05524000
   TOS := PSLPVINFO;                                           <<00211>>05526000
   TOS := GSLPVINFO;                                           <<00211>>05528000
   TOS := 287; ASSEMBLE(ADDS 0);                                        05530000
   TOS := @RCSTS; PS0 := 0;                                             05532000
   ASSEMBLE(DUP,INCB); TOS := 286; ASSEMBLE(MOVE 3);                    05534000
                                                                        05536000
   <<* * * COMPOSE CST TABLES * * *>>                                   05538000
                                                                        05540000
   TOS := MLIBSEARCH;  <<SL NR.>>                                       05542000
   DO BEGIN                                                             05544000
      TOS := 255;  <<SEG. NR.>>                                         05546000
      DO BEGIN                                                          05548000
         TOS := SLMAP(S1);                                              05550000
         ASSEMBLE(STBX); TOS := BPS0(XREG);  <<CST NR.>>                05552000
         TOS := 0;  <<FOR TESTBIT RESULT>>                              05554000
         TOS := SLSEGS(S4);                                             05556000
         TOS := S4;  <<SEG. NR.>>                                       05558000
         IF TESTBIT(*,*) THEN  <<SEG. REFERENCED?>>                     05560000
            BEGIN                                                       05562000
            SETBIT(RCSTS,S0);                                           05564000
            TOS := 0;  <<FOR TESTBIT RESULT>>                           05566000
            TOS := SLASEGS(XREG);                                       05568000
            TOS := S4;  <<SEG. NR.>>                                    05570000
            IF TESTBIT(*,*) THEN  <<SEG. TO BE ALLOCATED?>>             05572000
               BEGIN                                                    05574000
               SETBIT(ACSTS,S0);                                        05576000
               TOS := S2&LSL(8);  <<SEG. NR.>>                          05578000
               TOS.(8:8) := CSTFLAGS(S1);  <<CST FLAGS>>                05580000
               CSTXFORM(XREG) := TOS                                    05582000
               END                                                      05584000
            END;                                                        05586000
         ASSEMBLE(DDEL,DECA)                                            05588000
         END UNTIL <;                                                   05590000
      ASSEMBLE(DEL,DECA)                                                05592000
      END UNTIL <;                                                      05594000
                                                                        05596000
   <<* * * COMPOSE ENTRY CST TABLE * * *>>                              05598000
                                                                        05600000
   MOVE ECSTS := RCSTS,(12);                                            05602000
   NWCSTS := 12;                                                        05604000
                                                                        05606000
   <<* * * MOVE TABLES TO SEGMENT TABLE * * *>>                         05608000
                                                                        05610000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  05612000
   XREG := 15;                                                          05614000
   DO BEGIN                                                             05616000
      ACSTS'(XREG) := ACSTS(XREG);                                      05618000
      XREG := XREG-1                                                    05620000
      END UNTIL <;                                                      05622000
                                                                        05624000
   <<* * * CREATE AND INITIALIZE USER ENTRY * * *>>                     05626000
                                                                        05628000
   IF LOGICAL(MCOMMAND') THEN  <<PROCEDURE>>                            05630000
      BEGIN                                                             05632000
      LCREATE(NWCSTS+2,EXTENSION,1,NORMAL,0,PROCESSKEY');               05634000
      IF < THEN GO NOROOM;  <<ERROR?>>                                  05636000
      TOS := PROCESSKEY'; TOS := NORMAL; TOS := EXTENSION               05638000
      END                                                               05640000
   ELSE  <<PROGRAM>>                                                    05642000
      BEGIN                                                             05644000
      LCREATE (NWCSTS+8,PROGFILE,1,MPMODE',                    <<00211>>05646000
               MLIBSEARCH',PROGKEY');                          <<00211>>05648000
      IF  <  THEN  GO NOROOM;  <<ERROR?>>                               05650000
      ESHR := 0;                                                        05652000
      ECST := CSTBX';                                                   05654000
      ESEG := NPA';                                                     05656000
      EPVINFO'PROG := PROGPVINFO';                             <<00211>>05658000
      TOS := PROGKEY'; TOS := MPMODE'; TOS := PROGFILE  <<SAVE PARM'S>> 05660000
      END;                                                              05662000
   XREG := 11;                                                          05664000
   DO BEGIN                                                             05666000
      ENTP2(XREG) := ECSTS(XREG);                                       05668000
      XREG := XREG-1                                                    05670000
      END UNTIL <;                                                      05672000
                                                                        05674000
   <<* * * UPDATE TABLES FOR SL SEGMENTS * * *>>                        05676000
                                                                        05678000
   TOS := MLIBSEARCH';  <<SL NR.>>                                      05680000
   DO BEGIN                                                             05682000
      IF NSLA'(S0) <> 0 THEN  <<SL SEG'S LOADED?>>                      05684000
         BEGIN                                                          05686000
         IF NOT LSEARCH(SLKEY'(XREG),NORMAL,SLFILE) THEN                05688000
            BEGIN                                                       05690000
            LCREATE (16,SLFILE,BITMAP,NORMAL,0,SLKEY'(XREG));  <<00211>>05692000
            IF < THEN  <<NO ROOM?>>                                     05694000
               BEGIN                                                    05696000
               DEL;                                                     05698000
               LSEARCH(*,*,*);  <<FIND USER ENTRY>>                     05700000
               LDELETE;                                                 05702000
               GO NOROOM                                                05704000
               END;                                                     05706000
            LOADBIT(SLKEY'(XREG),TRUE,SEGTABDST);                       05708000
            IF < THEN  <<ERROR?>>                                       05710000
               BEGIN                                                    05712000
               DEL;                                                     05714000
               LSEARCH(*,*,*);  <<FIND USER ENTRY>>                     05716000
               LDELETE;                                                 05718000
               TOS := ERR72;                                            05720000
               GO NFG                                                   05722000
               END;                                                     05724000
            NSLA'(XREG) := -1;     << SET LOADED FLAG >>                05726000
            END;                                                        05728000
         EPVINFO'SL := SLPVINFO' (XREG);                       <<00211>>05730000
         UPDATE(S0)  <<UPDATE TABLES>>                                  05732000
         END;                                                  <<00784>>05734000
      TOS := TOS-1                                                      05736000
      END UNTIL <;                                                      05738000
   DEL;                                                                 05740000
                                                                        05742000
   <<* * * UPDATE TABLES FOR USER SEGMENTS * * *>>                      05744000
                                                                        05746000
   LSEARCH(*,*,*);  <<GET USER ENTRY>>                                  05748000
   ADJREFCOUNTS(1);  <<INCREMENT REFERENCE COUNTS>>                     05750000
   IF MCOMMAND' = 3 THEN  <<ALLOCATE PROCEDURE?>>                       05752000
      BEGIN                                                             05754000
      LDELETE;  <<DELETE EXTENSION ENTRY>>                              05756000
      XFORM(PROCCST).(10:1) := 1  <<SET ALLOCATED BIT>>                 05758000
      END;                                                              05760000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                05762000
   TOS := CCE;  <<OK CONDITION CODE>>                                   05764000
   GO GETOUT;                                                           05766000
                                                                        05768000
   NOROOM:                                                              05770000
   TOS := ERR70;                                                        05772000
                                                                        05774000
   NFG:                                                                 05776000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                05778000
   MERROR := TOS;  <<ERROR NR.>>                                        05780000
                                                                        05782000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                05784000
                                                                        05786000
   GETOUT:                                                              05788000
   XREG := MLIBSEARCH;                                                  05790000
   DO  IF  NSLA'(XREG) = -1  THEN                                       05792000
       SLLOADBIT(XREG) := SLLOADBIT(XREG)+1                             05794000
   UNTIL  (XREG:=XREG-1) < 0;                                           05796000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            05798000
   END;                                                                 05800000
                                                                        05802000
TURNOFFTRAPS;                                                           05804000
PUSH(DL);                                                               05806000
DLSZE := TOS;                                                           05808000
MAILBUF(11) := ABSOLUTE(LCT+11); << SET WAITER PCBX INTO MAILBUF >>     05810000
                                                                        05812000
<< OPEN THE SYSTEM SL >>                                                05814000
                                                                        05816000
TOS := 0D;                                                              05818000
TOS := ABSOLUTE(SSLKEYA);                                               05820000
TOS := ABSOLUTE(XREG:=XREG+1);  <<SYSTEM SL KEY>>                       05822000
SSLKEY := DS1;                                                          05824000
S2 := BS1;   <<EXTRACT THE LOGICAL DEVICE>>                             05826000
BS1 := 0;                                                               05828000
SSLFNUM := FOPENDA(*,*,%(2)111110110);                                  05830000
IF  <>  THEN                                                            05832000
   BEGIN                                                                05834000
   FERROR(0);                                                           05836000
   GO RETURNMAIL;                                                       05838000
   END;                                                                 05840000
SETBIT (FDA,SSLFNUM);  <<INDICATE OPENED VIA FOPENDA>>         <<RV.PV>>05842000
                                                                        05844000
                                                                        05846000
<< OPEN THE LOADLIST FILE >>                                            05848000
                                                                        05850000
RETRYLIST:                                                              05852000
LISTFNUM := FOPEN(LISTDESIG,%2001,%304);                                05854000
IF  <  THEN                                                             05856000
   BEGIN  << ERROR, OR MUST BUILD THE FILE >>                           05858000
   FCHECK(LISTFNUM,LISTFNUM);                                           05860000
   IF  <>  OR  LISTFNUM <> 52  THEN                                     05862000
      BEGIN                                                             05864000
LISTERR:                                                                05866000
      TOS := ERR54;                                                     05868000
      GO NFG;                                                           05870000
      END;                                                              05872000
   LISTFNUM := FOPEN(LISTDESIG,%2104,4,36);                             05874000
   IF  <>  THEN  GO LISTERR;                                            05876000
   FCLOSE(LISTFNUM,1,0);                                                05878000
   IF  <>  THEN  GO LISTERR;                                            05880000
   GO RETRYLIST;                                                        05882000
   END;                                                                 05884000
FGETINFO(LISTFNUM,,,,,,,,,,,,,,,,,,,LISTADDR);                          05886000
IF  <>  THEN  GO LISTERR;                                               05888000
                                                                        05890000
<<GET CACHE DATA SEGMENT>>                                     <<00807>>05892000
LOADCACHESEG:=GETDATASEG(BUCKET0+NBUCKETS*BUCKETSIZE,0);       <<00807>>05894000
INITLOADCACHE;                                                 <<00807>>05896000
                                                               <<00807>>05898000
L:   <<  RESTART HERE >>                                                05900000
PUSH( DL );                                                             05902000
@DLAREA2 := S0;                                                         05904000
@DLAVAIL := TOS;                                                        05906000
@DLAREA1 := -SYSDL;                                                     05908000
                                                                        05910000
<<* * * EXTRACT COMMAND FROM LCT * * *>>                                05912000
                                                                        05914000
TOS := @MAILBUF;                                                        05916000
TOS := MAILLENGTH;                                                      05918000
XREG := LCT;                                                            05920000
DO                                                                      05922000
   BEGIN                                                                05924000
   PS1 := ABSOLUTE(XREG);  S1 := S1+1;                                  05926000
   XREG := XREG+1;  TOS := TOS-1;                                       05928000
   END                                                                  05930000
UNTIL  = ;                                                              05932000
DDEL; << MAILBUF PTR AND COUNT >>                                       05934000
                                                                        05936000
<<* * * CLEAR LIST FILE * * *>>                                         05938000
                                                                        05940000
LISTFLAG := FALSE;                                                      05942000
CLEARLINE;                                                              05944000
FCONTROL(LISTFNUM,5,LISTFLAG);                                          05946000
IF  <>  THEN                                                            05948000
   BEGIN                                                                05950000
   TOS := ERR64;                                                        05952000
   GO NFG;                                                              05954000
   END;                                                                 05956000
                                                                        05958000
<<* * * PROCESS COMMAND * * *>>                                         05960000
                                                                        05962000
IF LOGICAL(MCOMMAND) THEN  <<LOAD/ALLOCATE PROCEDURE?>>                 05964000
   BEGIN                                                                05966000
   SATISFYPROC;  <<FIND AND SATISFY PROCEDURE>>                         05968000
   IF < THEN GO RECOVER;  <<ERROR?>>                                    05970000
   SAVESIR:=GETSIR(SEGTABSIR);                                 <<00125>>05972000
   LOADEXTERNALS;  <<LOAD SL SEGMENTS>>                                 05974000
   IF < THEN GO RECOVER;  <<ERROR?>>                                    05976000
   TOS := @SXTABLE+NWSXTABLE-2;                                         05978000
   TOS := DPS0;  <<ENTRY POINT AND SATISFIER>>                          05980000
   TOS := SLMAP(TOS.(4:4));  <<CST MAP POINTER>>                        05982000
   TOS := BPS0(S1.(8:8));  <<CST NR.>>                                  05984000
   DELB;                                                                05986000
   TOS.(8:8) := TOS;  <<INSERT CST NR.>>                                05988000
   SETBIT0;  <<SET "EXTERNAL" BIT>>                                     05990000
   MPLABEL := TOS;  <<PROCEDURE P-LABEL>>                      <<00125>>05992000
   DEL;                                                        <<00125>>05994000
   END                                                                  05996000
ELSE  <<LOAD/ALLOCATE PROGRAM>>                                         05998000
   BEGIN                                                                06000000
   SATISFYPROG;  <<SATISFY EXTERNALS>>                                  06002000
   IF < THEN GO RECOVER;  <<ERROR?>>                                    06004000
   SAVESIR:=GETSIR(SEGTABSIR);                                 <<00125>>06006000
   LOADEXTERNALS;  <<LOAD SL SEGMENTS>>                                 06008000
   IF < THEN GO RECOVER;  <<ERROR?>>                                    06010000
   LOADPROGRAM;  <<LOAD PROG. SEGMENTS>>                                06012000
   IF < THEN GO RECOVER  <<ERROR?>>                                     06014000
   END;                                                                 06016000
UPDATESEGTAB;  <<UPDATE SEGMENT TABLE>>                                 06018000
IF < THEN GO RECOVER;  <<ERROR?>>                                       06020000
GO RETURNMAIL;                                                          06022000
                                                                        06024000
<<* * * ERROR RECOVERY CLEAN-UP * * *>>                                 06026000
                                                                        06028000
NFG:                                                                    06030000
MERROR := TOS;  <<ERROR NR.>>                                           06032000
                                                                        06034000
RECOVER:                                                                06036000
IF SAVESIR=-1 THEN SAVESIR:=GETSIR(SEGTABSIR);                 <<00125>>06038000
IF  LOGICAL(CSTSALLOCATED) THEN                                         06040000
   BEGIN  << RELEASE CSTS >>                                            06042000
   XREG := NCSTS-NPA-1;                                                 06044000
   DO                                                                   06046000
      BEGIN                                                             06048000
      TOS := CSTNRS(XREG).(8:8);  <<CST #>>                             06050000
      IF  TESTBIT(FIXEDCSTS,S0)  THEN                                   06052000
         RELCODESEG(*)                                                  06054000
      ELSE                                                              06056000
         BEGIN                                                          06058000
         ASSEMBLE(LDI 1;XCH);                                           06060000
         RETURNENTRY(*,*);                                              06062000
         END;                                                           06064000
      XREG := XREG-1;                                                   06066000
      END                                                               06068000
   UNTIL  < ;                                                           06070000
   END;                                                                 06072000
IF  LOGICAL(CSTBLOCKALLOCATED)  THEN  DEALCSTBLOCK(CSTBX);              06074000
TOS := PROGLOADBIT;                                                     06076000
IF <> THEN <<"LOADED" BIT SET?>>                                        06078000
   BEGIN                                                                06080000
   TOS := PROGKEY; TOS := 0D;                                           06082000
   LOADBIT(*,*,*)  <<CLEAR "LOADED" BIT>>                               06084000
   END;                                                                 06086000
XREG := 2;  <<SL NR.>>                                                  06088000
DO BEGIN                                                                06090000
   TOS := SLLOADBIT(XREG);                                              06092000
   IF <> THEN  <<"LOADED" BIT SET?>>                                    06094000
      BEGIN                                                             06096000
      TOS := SLKEY(XREG); TOS := 0D;                                    06098000
      LOADBIT(*,*,*)  <<CLEAR "LOADED" BIT>>                            06100000
      END;                                                              06102000
   ASSEMBLE(DEL,DECX)                                                   06104000
   END UNTIL =;                                                         06106000
                                                                        06108000
<<* * * WAKE-UP WAITING PROCESSES * * *>>                               06110000
                                                                        06112000
RETURNMAIL:                                                             06114000
IF NOT LOGICAL(MCOMMAND) THEN  <<PROGRAM LOADED?>>                      06116000
   BEGIN                                                                06118000
   TOS := MAILDBACK;  <<SAVE ERROR NR. AND STARTING CST NR.>>           06120000
   TOS := 0;  <<FOR RESULT OF LSEARCH>>                                 06122000
   TOS := PROGKEY;  <<SAVE PROG. FILE KEY>>                             06124000
   TOS := MPMODE;  <<SAVE PROG. MODE>>                                  06126000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  06128000
   WHILE LSEARCH(DS2,S0,WAITING) DO  <<AWAKEN WAITING PROCESSES>>       06130000
      BEGIN                                                             06132000
      TOS := EWAITINGPIN;  <<SAVE PIN OF CREATOR>>                      06134000
      ETYPE := LOADED;  <<TRANSFORM ENTRY TYPE>>                        06136000
      ENTDP1 := DS6;  <<PARM. AND ERROR NR.>>                           06138000
      UNIMPEDE(TOS*PCBSIZE);                                            06140000
      END;                                                              06142000
   IF LSEARCH(*,*,LOADING) THEN                                <<04676>>06144000
   LDELETE;                                                             06146000
   EXCHANGEDB(0);  << SET DB TO STACK >>                                06148000
   DDEL; << MAILDBACK >>                                                06150000
   END;                                                                 06152000
                                                                        06154000
<<* * * RELEASE RESOURCES * * *>>                                       06156000
                                                                        06158000
IF SAVESIR <> -1 THEN RELSIR(SEGTABSIR,SAVESIR);  <<RELEASE SIR>>       06160000
FUNLOCK(SSLFNUM);                                                       06162000
CLOSE(GSLFNUM);  CLOSE(PSLFNUM);                                        06164000
CLOSE(PROGFNUM);                                                        06166000
SAVESIR := -1;      @DLAREA1 := -SYSDL;   NWSXTABLE := 0;               06168000
WSP := CSTBLOCKALLOCATED := CSTSALLOCATED := 0;                         06170000
NSSLA := NPSLA := NGSLA := NPA := 0;                                    06172000
NSSLR := NPSLR := NGSLR := PROGLOADBIT := 0;                            06174000
DRTRECD := 0D;      RTMODIFIED := 0;                                    06176000
PSLLOADBIT := GSLLOADBIT := 0;                                          06178000
                                                                        06180000
<<* * * INSERT ANSWER IN LCT * * *>>                                    06182000
                                                                        06184000
ABSOLUTE(LCT) := MFERROR;                                               06186000
ABSOLUTE(XREG := XREG+1) := MERROR;                                     06188000
ABSOLUTE(XREG := XREG+1) := LISTFLAG;                                   06190000
ABSOLUTE(XREG := XREG+1) := LISTADDR1.(0:8);  << LDEV >>                06192000
ABSOLUTE(XREG := XREG+1) := LISTADDR1.(8:8);  << ADDR >>                06194000
ABSOLUTE(XREG := XREG+1) := LISTADDR2;                                  06196000
IF  LISTFLAG  THEN  FCONTROL(LISTFNUM,6,LISTFLAG);   << EOF >>          06198000
ABSOLUTE(SYSWAITTODISPMSG).PHASETRANSFLAG:=1;                  <<01549>>06200000
AWAKE( WPROC,%20,%20 );                                                 06202000
MAILDBACK := 0D;                                                        06204000
PUSH(DL);  IF  TOS <> DLSZE  THEN  DLSIZE(DLSZE);                       06206000
GO L;  << PROCESS THE NEXT REQUEST >>                                   06208000
HELP;                                                                   06210000
END.                                                                    06212000
