$CONTROL MAP,CODE,USLINIT                                               00010000
<<LOADER1 -- MODULE 72>>                                                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 LOADER UTILITIES"                              00028000
$ CONTROL SEGMENT=LOADER1                                               00030000
$CONTROL PRIVILEGED                                            <<04861>>00032000
$THIRTY                                                                 00034000
BEGIN                                                                   00036000
                                                                        00038000
<<----------------------------------------------------------------------00040000
*                                                                      *00042000
*                          LOADER INTRINSICS                           *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>>                 <<00.02>>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
       ERR46 = 46,  <<TEMPORARY PROGRAM FILE ILLEGAL>>         <<04816>>00108000
       ERR50 = 50,  <<UNABLE TO OPEN SYSTEM SL FILE>>                   00110000
       ERR51 = 51,  <<UNABLE TO OPEN PUBLIC SL FILE>>                   00112000
       ERR52 = 52,  <<UNABLE TO OPEN GROUP SL FILE>>                    00114000
       ERR53 = 53,  <<UNABLE TO OPEN PROGRAM FILE>>                     00116000
       ERR54 = 54,  <<UNABLE TO OPEN LIST FILE>>                        00118000
       ERR55 = 55,  <<UNABLE TO CLOSE SYSTEM SL FILE>>                  00120000
       ERR56 = 56,  <<UNABLE TO CLOSE PUBLIC SL FILE>>                  00122000
       ERR57 = 57,  <<UNABLE TO CLOSE GROUP SL FILE>>                   00124000
       ERR58 = 58,  <<UNABLE TO CLOSE PROGRAM FILE>>                    00126000
       ERR59 = 59,  <<UNABLE TO CLOSE LIST FILE>>                       00128000
       ERR60 = 60,  <<EOF OR I/O ERROR ON SYSTEM SL FILE>>              00130000
       ERR61 = 61,  <<EOF OR I/O ERROR ON PUBLIC SL FILE>>              00132000
       ERR62 = 62,  <<EOF OR I/O ERROR ON GROUP SL FILE>>               00134000
       ERR63 = 63,  <<EOF OR I/O ERROR ON PROGRAM FILE>>                00136000
       ERR64 = 64,  <<EOF OR I/O ERROR ON LIST FILE>>                   00138000
       ERR65 = 65,  <<UNABLE TO OBTAIN CST ENTRIES>>                    00140000
       ERR66 = 66,  <<UNABLE TO OBTAIN PROCESS DST ENTRY>>              00142000
       ERR67 = 67,  <<UNABLE TO OBTAIN MAIL DATA SEGMENT>>              00144000
       ERR68 = 68,  <<UNABLE TO OBTAIN WORKING SET>>                    00146000
       ERR70 = 70,  <<SEGMENT TABLE OVERFLOW>>                          00148000
       ERR71 = 71,  <<UNABLE TO OBTAIN SUFFICIENT DL STORAGE>>          00150000
       ERR72 = 72,  <<ATTIO ERROR>>                                     00152000
       ERR73 = 73,  <<UNABLE TO OBTAIN VIRTUAL MEMORY>>                 00154000
       ERR74 = 74,  <<DIRECTORY I/O ERROR>>                             00156000
       ERR75 = 75,  <<PRINT I/O ERROR>>                                 00158000
       ERR76 = 76,  <<ILLEGAL DLSIZE>>                                  00160000
       ERR77 = 77,  <<ILLEGAL MAXDATA>>                        <<00236>>00162000
       ERR80 = 80,  <<PROGRAM ALREADY ALLOCATED>>                       00164000
       ERR81 = 81,  <<ILLEGAL PROGRAM ALLOCATION>>                      00166000
       ERR82 = 82,  <<PROGRAM NOT ALLOCATED>>                           00168000
       ERR83 = 83,  <<ILLEGAL PROGRAM DEALLOCATION>>                    00170000
       ERR84 = 84,  <<PROCEDURE ALREADY ALLOCATED>>                     00172000
       ERR85 = 85,  <<ILLEGAL PROCEDURE ALLOCATION>>                    00174000
       ERR86 = 86,  <<PROCEDURE NOT ALLOCATED>>                         00176000
       ERR87 = 87,  <<ILLEGAL PROCEDURE DEALLOCATION>>         <<00211>>00178000
       ERR92 = 92,  <<ALLOCATIONG FROM NON-SYSTEM DOMAIN>>     <<00784>>00180000
       ERR93 = 93,  <<UNABLE TO MOUNT PROG'S HOME VOL. SET>>   <<00784>>00182000
       ERR94 = 94,  <<UNABLE TO MOUNT SYS SL'S H.V.S (FAKE>>   <<00784>>00184000
       ERR95 = 95,  <<UNABLE TO MOUNT PRIVATE SL'S H.V.S>>     <<00784>>00186000
       ERR96 = 96,  <<UNABLE TO MOUNT GROUP SL'S H.V.S>>       <<04862>>00188000
       ERR97 = 97;  <<PROGRAM FILE IS IN REMOTE SYSTEM>>       <<04862>>00190000
                                                                        00192000
<<MISC. DECLARATIONS>>                                                  00194000
                                                                        00196000
DEFINE ABS = ABSOLUTE#,                                                 00198000
       ASMB = ASSEMBLE#,                                                00200000
       PDISABLE = ASMB(PSDB)#,                                 <<SB.02>>00202000
       PENABLE  = ASMB(PSEB)#,                                 <<SB.02>>00204000
       CAB' = ASMB(CAB)#,                                               00206000
       DEL' = ASSEMBLE(DEL)#,                                           00208000
       DELB' = ASSEMBLE(DELB)#,                                         00210000
       DUP' = ASSEMBLE(DUP)#,                                           00212000
       SETBIT0 = ASSEMBLE(TSBC 0)#,                                     00214000
       XCH' = ASSEMBLE(XCH)#;                                           00216000
EQUATE CCG = 0,  <<"GREATER THAN" CONDITION CODE>>                      00218000
       CCL = 1,  <<"LESS THAN" CONDITION CODE>>                         00220000
       CCE = 2;  <<"EQUAL" CONDITION CODE>>                             00222000
INTEGER XREG = X;  <<X REGISTER>>                                       00224000
LOGICAL LXREG = X;                                                      00226000
DOUBLE DDB0 = DB+0;                                                     00228000
BYTE BS1 = S-1;                                                         00230000
BYTE BS2 = S-2;                                                         00232000
INTEGER S0 = S-0;                                                       00234000
INTEGER S1 = S-1;                                                       00236000
INTEGER S2 = S-2;                                                       00238000
INTEGER S3 = S-3;                                                       00240000
INTEGER S4 = S-4;                                                       00242000
INTEGER S5 = S-5;                                                       00244000
INTEGER S6 = S-6;                                                       00246000
INTEGER S7 = S-7;                                                       00248000
INTEGER S8 = S-8;                                                       00250000
INTEGER S9 = S-9;                                                       00252000
INTEGER S10 = S-10;                                                     00254000
INTEGER S11 = S-11;                                                     00256000
LOGICAL LS0 = S-0;                                                      00258000
DOUBLE DS1 = S-1;                                                       00260000
DOUBLE DS2 = S-2;                                                       00262000
DOUBLE DS3 = S-3;                                                       00264000
DOUBLE DS4 = S-4;                                                       00266000
BYTE POINTER BPS0 = S-0;                                                00268000
BYTE POINTER BPS1 = S-1;                                                00270000
BYTE POINTER BPS2 = S-2;                                                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
DOUBLE POINTER DPS0 = S-0;                                              00282000
DOUBLE POINTER DPS1 = S-1;                                              00284000
DOUBLE POINTER DPS2 = S-2;                                              00286000
DOUBLE DQ2 = Q-2;                                                       00288000
INTEGER ARRAY DBAREA (*) = DB+0;                                        00290000
INTEGER STATUS = Q-1;  <<STATUS WORD OF STACK MARKER>>                  00292000
DEFINE CONDCODE = STATUS.(6:2)#;  <<COND. CODE BITS>>                   00294000
DEFINE TURNOFFTRAPS = PUSH(STATUS); TOS.(2:1) := 0; SET(STATUS)#;       00296000
                                                                        00298000
<<SYSTEM PARAMETERS>>                                                   00300000
                                                                        00302000
POINTER  PCB = 3;    << SYSTEM TABLE PTR TO CST >>                      00304000
POINTER  CSTEXT = %51;   << SYS. TABLE PTR TO CST EXTENSION >> <<00.02>>00306000
                                                                        00308000
EQUATE CSTP = 0,                                                        00310000
       DSTB = 2,                                               <<00.02>>00312000
       PCBB = 3,                                                        00314000
       LCT = %1220,   << LOADER COMMUNICATION TABLE >>                  00316000
       MAXDATASEG = %1107,  << MAX DATA SEG SIZE >>                     00318000
       DEFAULTDATASEG = %1110, <<DEFAULT STACK SIZE>>          <<01933>>00320000
       TRACEL = %1162,      << TRACE LABELS >>                          00322000
       SSLKEY = %1126,      << SYSTEM SL KEY >>                         00324000
       LOGFLAG = %1167,     << LOGGING FLAG >>                          00326000
       CPCB = 4,                                                        00328000
       CSTXP = 1,                                                       00330000
       PCBSIZE = 16,                                                    00332000
       LOADSIR = 1,                                                     00334000
       ATTIOREAD = 0,  <<ATTIO READ CODE>>                              00336000
       ATTIOWRITE = 1;  <<ATTIO WRITE CODE>>                            00338000
EQUATE QUEUEINGINFOWORDNUM=%15;                                <<01549>>00340000
DEFINE INTERACTIVEFLAG=(5:1)#;                                 <<01549>>00342000
DEFINE LASTCST = ABSOLUTE(ABSOLUTE(CSTP))#,                             00344000
       USERPIN = ((ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE)#,            00346000
       PCBXP = PUSH(DL); TOS := TOS-PS0(-2)#;                           00348000
                                                                        00350000
<<----------------------------------------------------------------------00352000
*                                                                      *00354000
*  SEGMENT TABLE DATA SEGMENT PARAMETERS                               *00356000
*                                                                      *00358000
---------------------------------------------------------------------->>00360000
                                                                        00362000
<<PSEUDO GLOBAL AREA>>                                                  00364000
                                                                        00366000
EQUATE SEGTABDST = 18,  <<SEGMENT TABLE DST NR.>>                       00368000
       SEGTABSIR = 17;  <<SEGMENT TABLE SIR NR.>>                       00370000
INTEGER SO = DB+0;  <<UTILITY INTEGER>>                                 00372000
INTEGER DIRLEN = DB+1;  <<DIRECTORY LENGTH>>                            00374000
DEFINE DIRBND = (DIRLEN-1)#;  <<TABLE BOUND>>                           00376000
INTEGER ARRAY DIR (@) = DB+2;  <<ENTRY TABLE>>                          00378000
INTEGER ARRAY REFCOUNT (@) = DB+3;  <<REFERENCE COUNT TABLE>>           00380000
DEFINE USEDCST = (REFCOUNT(XREG) <> -1)#,  <<CST IN USE?>>              00382000
       UNUSEDCST = (REFCOUNT(XREG) = -1)#;  <<CST NOT IN USE?>>         00384000
INTEGER ARRAY XFORM (@) = DB+4;  <<CST TO LCST AND FLAG TABLE>>         00386000
LOGICAL ARRAY LXFORM (*) = XFORM;                                       00388000
DEFINE SEGNR = XFORM(XREG).(0:8)#,  <<SEGMENT NR.>>                     00390000
       SEGTYPE = XFORM(XREG).(8:2)#,  <<SET. TYPE>>                     00392000
       SEGALLOC = XFORM(XREG).(10:3)#,   <<ALLOCATED SEGMENT>> <<00699>>00394000
       SLSEG = (XFORM(XREG).(8:2) <> 3)#,  <<SL SEG.?>>                 00396000
       SSLSEG = (XFORM(XREG).(8:2) = 0)#,  <<SYS. SL SEG.?>>            00398000
       PSLSEG = (XFORM(XREG).(8:2) = 1)#,  <<PUB. SL SEG.?>>            00400000
       GSLSEG = (XFORM(XREG).(8:2) = 2)#,  <<GROUP SL SEG.?>>           00402000
       PROGSEG = (XFORM(XREG).(8:2) = 3)#,  <<PROG. SEG.?>>             00404000
       ALLOCATEDSEG = LXFORM(XREG).(10:1)#,  <<ALLOC. SEG.?>>           00406000
       CORESEG = LXFORM(XREG).(11:1)#,  <<CORE RES. SEG.?>>             00408000
       SYSTEMSEG = LXFORM(XREG).(12:1)#;  <<SYSTEM SEG.?>>              00410000
INTEGER ARRAY ENTTAB (@) = DB+5;  <<CST TO ENTRY INDEX TABLE>>          00412000
INTEGER POINTER ENTP2 = DB+6;  <<SECONDARY ENTRY POINTER>>              00414000
BYTE POINTER ENTBP2 = ENTP2;  <<SECONDARY ENTRY POINTER>>               00416000
INTEGER POINTER ENTP = DB+7;  <<ENTRY POINTER>>                         00418000
DOUBLE POINTER ENTDP = ENTP;  <<ENTRY POINTER>>                         00420000
INTEGER POINTER ENTP1 = DB+8;  <<SECONDARY ENTRY POINTER>>              00422000
DOUBLE POINTER ENTDP1 = ENTP1;  <<SECONDARY ENTRY POINTER>>             00424000
INTEGER ARRAY SBUF0 (@) = DB+9;  <<SINGLE RECORD DISC BUFFER>>          00426000
INTEGER ARRAY SBUF1 (@) = DB+10;  <<SINGLE RECORD DISC BUFFER>>         00428000
INTEGER ARRAY SBUF2 (@) = DB+11;  <<SINGLE RECORD DISC BUFFER>>         00430000
INTEGER ARRAY SBUF3 (@) = DB+12;  <<SINGLE RECORD DISC BUFFER>>         00432000
INTEGER ARRAY SBUF4 (@) = DB+13;  <<SINGLE RECORD DISC BUFFER>>         00434000
INTEGER SI = DB+14;  <<UTILITY INTEGER>>                                00436000
INTEGER SJ = DB+15;  <<UTILITY INTEGER>>                                00438000
INTEGER SK = DB+16;  <<UTILITY INTEGER>>                                00440000
INTEGER SL = DB+17;  <<UTILITY INTEGER>>                                00442000
INTEGER SM = DB+18;  <<UTILITY INTEGER>>                                00444000
INTEGER SN = DB+19;  <<UTILITY INTEGER>>                                00446000
INTEGER SP = DB+20;  <<UTILITY INTEGER>>                                00448000
INTEGER SQ = DB+21;  <<UTILITY INTEGER>>                                00450000
INTEGER SR = DB+22;  <<UTILITY INTEGER>>                                00452000
INTEGER SS = DB+23;  <<UTILITY INTEGER>>                                00454000
INTEGER ST = DB+24;  <<UTILITY INTEGER>>                                00456000
                                                                        00458000
<<PROGRAM FILE PARAMETERS>>                                             00460000
                                                                        00462000
EQUATE PROGFILECODE = 1029;  <<PROGRAM FILE CODE>>                      00464000
DEFINE SFLAGS = SBUF0#,  <<FLAG WORD>>                                  00466000
       SFATAL = (LOGICAL(SBUF0.(0:1)))#,  <<FATAL ERROR?>>              00468000
       SWARNING = (LOGICAL(SBUF0.(1:1)))#,  <<NON-FATAL ERROR?>>        00470000
       SZERODB = (LOGICAL(SBUF0.(2:1)))#,  <<ZERO DB AREA?>>            00472000
       SCAPABILITY = SBUF0.(6:10)#,  <<CAPABILITY LIST>>                00474000
       SNRSEGS = SBUF0(1)#,  <<NR. SEGMENTS>>                           00476000
       SGLOBALSIZE = SBUF0(2)#,  <<GLOBAL AREA SIZE>>                   00478000
       SGLOBALRECD = SBUF0(3)#,  <<REC. NR. OF GLOBAL AREA>>            00480000
       SSEGMENTRECD = SBUF0(4)#,  <<REC. NR. OF SEGMENT LIST>>          00482000
       SSTACKSIZE = SBUF0(5)#,  <<STACK SIZE>>                          00484000
       SDLSIZE = SBUF0(6)#,  <<DL SIZE>>                                00486000
       SMAXDATA = SBUF0(7)#,  <<MAX. DATA SEG. SIZE>>                   00488000
       SENTRYRECD = SBUF0(8)#,  <<REC. NR. OF ENTRY POINT LIST>>        00490000
       SSTARTINGSEG = SBUF0(9)#,  <<STARTING SEGMENT NR.>>              00492000
       SSTARTINGADR = SBUF0(10)#,  <<STARTING PB ADDRESS>>              00494000
       SSASTLT = SBUF0(11)#,  <<S.A. OF STLT>>                          00496000
       SSAFLUT = SBUF0(12)#,  <<S.A. OF FLUT>>                          00498000
       SEXTERNALRECD = SBUF0(13)#,  <<REC. NR. OF EXTERNAL LIST>>       00500000
       SSTARTINGSTT = SBUF0(14)#;  <<STARTING STT NR.>>                 00502000
DEFINE SSATRAPCOM = SBUF0 (15)#;  <<S. AA. OF TRAPCOM'>>                00504000
                                                                        00506000
<<ENTRY PARAMETERS>>                                                    00508000
                                                                        00510000
DEFINE ELIB = ENTP.(8:2)#,  << LIBRARY SEARCH >>                        00512000
       EPA = ENTP.(7:1)#,  << SET IF PROGRAM ALLOCATED >>               00514000
       EFMODE = ENTP.(10:1)#,  <<FILE MODE>>                            00516000
       EPMODE = ENTP.(11:1)#,  <<PROGRAM MODE>>                         00518000
       ETYPE = ENTP.(13:3)#,  <<ENTRY TYPE NR.>>                        00520000
       ENWG = ENTP(1)#,  <<NR. WORDS IN GARBAGE ENTRY>>                 00522000
       EPID = ENTP(1)#,  <<PROCESS ID>>                                 00524000
       EEXT = ENTP(1).(0:8)#,  <<EXTENSION NR.>>                        00526000
       EPIN = ENTP(1).(8:8)#,  <<PIN NUMBER>>                           00528000
       EFID1 = ENTP(1)#,  <<FIRST WORD OF FILE ID>>                     00530000
       EFID2 = ENTP(2)#,  <<SECOND WORD OF FILE ID>>                    00532000
       ECST = ENTP(4)#,   <<CST BLOCK INDEX >>                          00534000
       ESHR = ENTP(5)#,   <<PROGRAM FILE REFERENCE COUNT>>              00536000
       ESEG = ENTP(6)#,   <<# OF SEGMENTS IN FILE>>                     00538000
       EPVINFO'SL = ENTP (3)#,  <<PVINFO FOR SL TYPE ENTRY>>   <<00211>>00540000
       EPVINFO'PROG = ENTP (7)#, <<PVINFO FOR PROG TYPE ENTRY>><<00211>>00542000
       EWAITINGPIN = ENTP1#;  <<PIN OF WAITING PROCESS>>                00544000
EQUATE GARBAGE = 0,  <<GARBAGE ENTRY TYPE NR.>>                         00546000
       SLFILE = 1,  <<SL FILE ENTRY TYPE NR.>>                          00548000
       PROGFILE = 2,  <<PROGRAM FILE ENTRY TYPE NR.>>                   00550000
       LOADING = 3,  <<PROGRAM FILE LOADING ENTRY TYPE NR.>>            00552000
       WAITING = 4,  <<PROCESS WAITING ENTRY TYPE NR.>>                 00554000
       LOADED = 5,  <<PROCESS BLOCKED ENTRY TYPE NR.>>                  00556000
       SHARER = 6,  <<SHARER PROCESS ENTRY TYPE NR.>>                   00558000
       EXTENSION = 7;  <<PROCESS EXTENSION ENTRY TYPE NR.>>             00560000
EQUATE BITMAP = 1,  <<CST BIT MAP>>                                     00562000
       ANYMODE = -1,  <<ANY MODE>>                                      00564000
       NORMAL = 0,  <<NORMAL (PRIV.) MODE>>                             00566000
       NOPRIV = 1,  <<NO PRIV. MODE>>                                   00568000
       SLOW = 0,  <<SLOW MODE>>                                         00570000
       FAST = 1,  <<FAST MODE>>                                         00572000
       SSL = 0,  << SYSTEM SL >>                                        00574000
       PSL = 1,  << PUBLIC SL >>                                        00576000
       GSL = 2;  << GROUP SL >>                                         00578000
DEFINE GARBAGEENTRY = (ETYPE = GARBAGE)#,                               00580000
       SLFILEENTRY = (ETYPE = SLFILE)#,                                 00582000
       PROGFILEENTRY = (ETYPE = PROGFILE)#,                             00584000
       LOADINGENTRY = (ETYPE = LOADING)#,                               00586000
       WAITINGENTRY = (ETYPE = WAITING)#,                               00588000
       SHARERENTRY = (ETYPE = SHARER)#,                                 00590000
       EXTENSIONENTRY = (ETYPE = EXTENSION)#;                           00592000
                                                                        00594000
<<----------------------------------------------------------------------00596000
*                                                                      *00598000
*  FILE SYSTEM PARAMETERS                                              *00600000
*                                                                      *00602000
---------------------------------------------------------------------->>00604000
                                                                        00606000
EQUATE FILESYSSIR = 37;  <<FILE SYSTEM SIR>>                            00608000
                                                                        00610000
<<FILE LABEL PARAMETERS>>                                               00612000
                                                                        00614000
DEFINE FLOADBIT = FLABEL(28).(2:1)#;  <<FILE LOADED BIT>>               00616000
                                                               <<00807>>00618000
<<LOAD CACHE DECLARATIONS>>                                    <<00807>>00620000
                                                               <<00807>>00622000
DEFINE LOADCACHESEG=ABSOLUTE(ABSOLUTE(%1377)+%1072)#; <<EDS #>><<00807>>00624000
EQUATE BUCKETSIZE = 42,  <<SIZE OF EACH CACHE BUCKET>>         <<00807>>00626000
       CACHEHITS=0,      <<HIT COUNTER POINTER>>               <<00807>>00628000
       CACHEMISSES=2,    <<MISS COUNTER POINTER>>              <<00807>>00630000
       BUCKET0=4,        <<FIRST BUCKET POINTER>>              <<00807>>00632000
       NBUCKETS = 95;    <<NUMBER OF BUCKETS>>                 <<00807>>00634000
                                                                        00636000
<<----------------------------------------------------------------------00638000
*                                                                      *00640000
*  PROCEDURE DECLARATIONS                                              *00642000
*                                                                      *00644000
---------------------------------------------------------------------->>00646000
                                                                        00648000
PROCEDURE ADJREFCOUNTS (AMOUNT);                                        00650000
   VALUE AMOUNT; INTEGER AMOUNT;                                        00652000
   OPTION FORWARD;                                                      00654000
PROCEDURE ADJSEG (CSTNR);                                               00656000
   VALUE CSTNR;                                                         00658000
   INTEGER CSTNR;                                                       00660000
   OPTION INTERNAL,FORWARD;                                             00662000
INTEGER PROCEDURE ALLOCATEPROC (PROCNAME);                              00664000
   BYTE ARRAY PROCNAME;                                                 00666000
   OPTION FORWARD;                                                      00668000
INTEGER PROCEDURE ALLOCATEPROG (PROGFNAME);                             00670000
   BYTE ARRAY PROGFNAME;                                                00672000
   OPTION FORWARD;                                                      00674000
INTEGER PROCEDURE ALTDSEGSIZE (DSTNR,DELTA);                            00676000
   VALUE DSTNR,DELTA;                                                   00678000
   INTEGER DSTNR,DELTA;                                                 00680000
   OPTION EXTERNAL;                                                     00682000
INTRINSIC  ASCII;                                                       00684000
PROCEDURE CLEARWWS; OPTION EXTERNAL;                           <<04861>>00686000
DOUBLE PROCEDURE ATTACHIO (DEVICE,QMISC,DSTINDEX,BUF,FUNCTION,          00688000
                        COUNT,PARM1,PARM2,FLAGS);                       00690000
   VALUE DEVICE,QMISC,DSTINDEX,FUNCTION,COUNT,PARM1,PARM2,FLAGS;        00692000
   INTEGER DEVICE,QMISC,DSTINDEX,FUNCTION,COUNT,PARM1,PARM2,FLAGS;      00694000
   INTEGER ARRAY BUF;                                                   00696000
   OPTION EXTERNAL;                                                     00698000
PROCEDURE AWAKE (PCBINDEX,OLDWAIT,NEWWAIT);                             00700000
   VALUE PCBINDEX,OLDWAIT,NEWWAIT;                                      00702000
   INTEGER PCBINDEX,OLDWAIT,NEWWAIT;                                    00704000
   OPTION EXTERNAL;                                                     00706000
DOUBLE PROCEDURE CHEK (INTRINSIC,FLAGS,PARMS,CAPMASK,OPTVMASK);         00708000
   VALUE INTRINSIC,FLAGS,PARMS,CAPMASK,OPTVMASK;                        00710000
   LOGICAL INTRINSIC,FLAGS,OPTVMASK;                                    00712000
   DOUBLE PARMS,CAPMASK;                                                00714000
   OPTION VARIABLE,EXTERNAL;                                            00716000
PROCEDURE CLEARBIT (BITARRAY,BITNUMBER);                                00718000
   VALUE BITNUMBER;                                                     00720000
   INTEGER ARRAY BITARRAY;                                              00722000
   INTEGER BITNUMBER;                                                   00724000
   OPTION INTERNAL,FORWARD;                                             00726000
PROCEDURE  DEALCSTBLOCK(EIX);                                           00728000
   VALUE  EIX;                                                          00730000
   INTEGER  EIX;                                                        00732000
   OPTION  EXTERNAL;                                                    00734000
INTEGER PROCEDURE DEALLOCATEPROC (PROCNAME);                            00736000
   BYTE ARRAY PROCNAME;                                                 00738000
   OPTION FORWARD;                                                      00740000
INTEGER PROCEDURE DEALLOCATEPROG (PROGFNAME);                           00742000
   BYTE ARRAY PROGFNAME;                                                00744000
   OPTION FORWARD;                                                      00746000
DOUBLE PROCEDURE ENTRYKEY;                                              00748000
   OPTION INTERNAL,FORWARD;                                             00750000
INTEGER PROCEDURE ENTRYLENGTH;                                          00752000
   OPTION INTERNAL,FORWARD;                                             00754000
PROCEDURE ERROREXIT (DESCRIP,ERROR,PARM);                               00756000
   VALUE DESCRIP,ERROR,PARM;                                            00758000
   INTEGER DESCRIP,ERROR,PARM;                                          00760000
   OPTION EXTERNAL;                                                     00762000
INTEGER PROCEDURE ERRORGET (LEVEL);                                     00764000
   VALUE LEVEL;                                                         00766000
   INTEGER LEVEL;                                                       00768000
   OPTION EXTERNAL;                                                     00770000
PROCEDURE ERRORON;                                                      00772000
   OPTION EXTERNAL;                                                     00774000
PROCEDURE ERRORPUT (ERROR,LEVEL);                                       00776000
   VALUE ERROR,LEVEL;                                                   00778000
   INTEGER ERROR,LEVEL;                                                 00780000
   OPTION EXTERNAL;                                                     00782000
INTEGER PROCEDURE EXCHANGEDB (DSTNR);                                   00784000
   VALUE DSTNR; INTEGER DSTNR;                                          00786000
   OPTION EXTERNAL;                                                     00788000
LOGICAL PROCEDURE  FACCESS(FN);                                         00790000
   VALUE FN;                                                            00792000
   INTEGER FN;                                                          00794000
   OPTION EXTERNAL;                                                     00796000
INTRINSIC FCHECK,FCONTROL;                                              00798000
PROCEDURE FCLOSE (FILENUM,DISPOSITION,SECCODE);                         00800000
   VALUE FILENUM,DISPOSITION,SECCODE;                                   00802000
   INTEGER FILENUM,DISPOSITION,SECCODE;                                 00804000
   OPTION EXTERNAL;                                                     00806000
PROCEDURE FGETINFO (FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,         00808000
      DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,         00810000
      PHYSCOUNT,BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABEL,CREATORID,         00812000
      DISKADR);                                                         00814000
   VALUE FILENUM;                                                       00816000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,         00818000
      USERLABEL;                                                        00820000
   BYTE ARRAY FILENAME,CREATORID;                                       00822000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      00824000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;                 00826000
   OPTION VARIABLE,EXTERNAL;                                            00828000
PROCEDURE  FINDSEG(CSTNR);                                              00830000
   VALUE CSTNR;                                                         00832000
   INTEGER CSTNR;                                                       00834000
   OPTION INTERNAL,FORWARD;                                             00836000
PROCEDURE FINDSLSEG (CSTNR);                                            00838000
   VALUE CSTNR;                                                         00840000
   INTEGER CSTNR;                                                       00842000
   OPTION FORWARD;                                                      00844000
INTEGER PROCEDURE FLABIO(LDEV,SECTOR,FUNC,FLAB);                        00846000
   VALUE LDEV,SECTOR,FUNC,FLAB;                                         00848000
   INTEGER LDEV,FUNC;                                                   00850000
   DOUBLE SECTOR;                                                       00852000
   LOGICAL POINTER FLAB;                                                00854000
   OPTION EXTERNAL;                                                     00856000
PROCEDURE FLOCK (FILENUM,FLAG);                                         00858000
   VALUE FILENUM,FLAG;                                                  00860000
   INTEGER FILENUM;                                                     00862000
   LOGICAL FLAG;                                                        00864000
   OPTION EXTERNAL;                                                     00866000
INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS,AOPTIONS,RECSIZE,      00868000
      DEVICE,FORMMSG,RECMODE,BLOCKFACTOR,NUMBUFFERS,FILESIZE,           00870000
      NUMEXTENTS,INITALLOC,FILECODE);                                   00872000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,      00874000
      FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                           00876000
   BYTE ARRAY FILEDESIGNATOR,DEVICE,FORMMSG;                            00878000
   LOGICAL FOPTIONS,AOPTIONS;                                           00880000
   INTEGER RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,NUMEXTENTS,           00882000
      INITALLOC,FILECODE;                                               00884000
   DOUBLE FILESIZE;                                                     00886000
   OPTION VARIABLE,EXTERNAL;                                            00888000
   INTEGER PROCEDURE DFOPEN                                    <<00824>>00890000
     (FNAME,FOPS,AOPS,RECSIZE,DEV,FORMMSG,NUMLABS,BLKFACT,     <<00824>>00892000
      NUMBUFS,FSIZE,NUMEXTS,INITEXTS,FCODE);                   <<00824>>00894000
     VALUE FOPS,AOPS,RECSIZE,NUMLABS,BLKFACT,NUMBUFS,FSIZE,    <<00824>>00896000
           NUMEXTS,INITEXTS,FCODE;                             <<00824>>00898000
     BYTE ARRAY FNAME,DEV,FORMMSG;                             <<00824>>00900000
     LOGICAL FOPS,AOPS;                                        <<00824>>00902000
     INTEGER RECSIZE,NUMLABS,BLKFACT,NUMBUFS,NUMEXTS,INITEXTS, <<00824>>00904000
             FCODE;                                            <<00824>>00906000
     DOUBLE FSIZE; OPTION VARIABLE,EXTERNAL;                   <<00824>>00908000
INTEGER PROCEDURE FOPENDA (LDNUM,DISKADR,AOPTIONS,NUMBUF,FILECODE,      00910000
   DNTYPE,DISP,FOPTIONS,PVINFO,COMINFO);                       <<01549>>00912000
   VALUE LDNUM,DISKADR,AOPTIONS,NUMBUF,FILECODE,               <<RV.PV>>00914000
         DNTYPE,DISP,FOPTIONS,PVINFO;                          <<01549>>00916000
   INTEGER LDNUM,AOPTIONS,NUMBUF,FILECODE,DNTYPE,DISP,PVINFO,  <<01549>>00918000
      FOPTIONS;                                                <<01549>>00920000
   ARRAY COMINFO;                                              <<01549>>00922000
   DOUBLE DISKADR;                                                      00924000
   OPTION VARIABLE,EXTERNAL;                                            00926000
PROCEDURE FCLOSEDA (FILENUM,DISP,SECCODE);                     <<RV.PV>>00928000
    VALUE   FILENUM,DISP,SECCODE;                              <<RV.PV>>00930000
    INTEGER FILENUM,DISP,SECCODE;                              <<RV.PV>>00932000
    OPTION EXTERNAL;                                           <<RV.PV>>00934000
INTEGER PROCEDURE FGETPVINFO (FILENUM);                        <<00211>>00936000
    VALUE FILENUM;  INTEGER FILENUM;                           <<00211>>00938000
    OPTION EXTERNAL;                                           <<00211>>00940000
PROCEDURE FORMATNAME (DEST,SOURCE);                                     00942000
   BYTE ARRAY DEST,SOURCE;                                              00944000
   OPTION FORWARD;                                                      00946000
INTEGER PROCEDURE FREAD (FILENUM,TARGET,TCOUNT);                        00948000
   VALUE FILENUM,TCOUNT;                                                00950000
   INTEGER FILENUM,TCOUNT;                                              00952000
   INTEGER ARRAY TARGET;                                                00954000
   OPTION EXTERNAL;                                                     00956000
PROCEDURE FREADDIR (FILENUM,TARGET,TCOUNT,RECNUM);                      00958000
   VALUE FILENUM,TCOUNT,RECNUM;                                         00960000
   INTEGER FILENUM,TCOUNT;                                              00962000
   ARRAY TARGET;                                                        00964000
   DOUBLE RECNUM;                                                       00966000
   OPTION EXTERNAL;                                                     00968000
PROCEDURE FUNLOCK (FILENUM);                                            00970000
   VALUE FILENUM;                                                       00972000
   INTEGER FILENUM;                                                     00974000
   OPTION EXTERNAL;                                                     00976000
INTRINSIC FWRITE;                                                       00978000
PROCEDURE FWRITEDIR (FILENUM,TARGET,TCOUNT,RECNUM);                     00980000
   VALUE FILENUM,TCOUNT,RECNUM;                                         00982000
   INTEGER FILENUM,TCOUNT;                                              00984000
   ARRAY TARGET;                                                        00986000
   DOUBLE RECNUM;                                                       00988000
   OPTION EXTERNAL;                                                     00990000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<RN.02>>00992000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<RN.02>>00994000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<RN.02>>00996000
      DST,IOTYPE;                                              <<RN.02>>00998000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<RN.02>>01000000
      DST,IOTYPE;                                              <<RN.02>>01002000
   OPTION VARIABLE,EXTERNAL;                                   <<RN.02>>01004000
INTEGER PROCEDURE GETSTACK (LENGTH,MAXDATA);                            01006000
   VALUE LENGTH,MAXDATA;                                                01008000
   INTEGER LENGTH,MAXDATA;                                              01010000
   OPTION EXTERNAL;                                                     01012000
LOGICAL PROCEDURE GETSIR (SIR);                                         01014000
   VALUE SIR;                                                           01016000
   INTEGER SIR;                                                         01018000
   OPTION EXTERNAL;                                                     01020000
PROCEDURE  HELP;                                                        01022000
   OPTION EXTERNAL;                                                     01024000
PROCEDURE  IMPEDE( PCBPTR );                                            01026000
   VALUE  PCBPTR;                                                       01028000
   INTEGER  PCBPTR;                                                     01030000
   OPTION  EXTERNAL;                                                    01032000
PROCEDURE LCREATE (LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY);               01034000
   VALUE LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY;                          01036000
   INTEGER LENGTH,TYPE,FORMAT,PMODE,LIBRARY;                            01038000
   DOUBLE KEY;                                                          01040000
   OPTION FORWARD;                                                      01042000
PROCEDURE LDELETE;                                                      01044000
   OPTION FORWARD;                                                      01046000
PROCEDURE LOADBIT (KEY,BIT,DSTNR);                                      01048000
   VALUE KEY,BIT,DSTNR;                                                 01050000
   DOUBLE KEY;                                                          01052000
   LOGICAL BIT;                                                         01054000
   INTEGER DSTNR;                                                       01056000
   OPTION FORWARD;                                                      01058000
LOGICAL PROCEDURE LOADEDSLSEG (SLKEY,SEGMENTNR);                        01060000
   VALUE SLKEY,SEGMENTNR;                                               01062000
   DOUBLE SLKEY;                                                        01064000
   INTEGER SEGMENTNR;                                                   01066000
   OPTION FORWARD;                                                      01068000
DOUBLE PROCEDURE LOADER (COMMAND,NUM1,NUM2,STRING,PVINFO);     <<00211>>01070000
   VALUE COMMAND,NUM1,NUM2,PVINFO;                             <<00211>>01072000
   INTEGER COMMAND,NUM1,NUM2,PVINFO;                           <<00211>>01074000
   BYTE ARRAY STRING;                                                   01076000
   OPTION INTERNAL,FORWARD;                                             01078000
INTEGER PROCEDURE LOADPROC (PROCNAME,LIBSEARCH,PLABEL);                 01080000
   VALUE LIBSEARCH;                                                     01082000
   BYTE ARRAY PROCNAME;                                                 01084000
   INTEGER LIBSEARCH,PLABEL;                                            01086000
   OPTION FORWARD;                                                      01088000
INTEGER PROCEDURE LOADPROGRAM (PROGFNUM,PROGKEY,PROCESSKEY,COMMAND,     01090000
   SAVESIR,PVINFO);                                            <<00211>>01092000
   VALUE PROGFNUM,PROGKEY,PROCESSKEY,COMMAND,SAVESIR,PVINFO;   <<00211>>01094000
   INTEGER PROGFNUM,COMMAND,SAVESIR,PVINFO;                    <<00211>>01096000
   DOUBLE PROGKEY,PROCESSKEY;                                           01098000
   OPTION FORWARD;                                                      01100000
PROCEDURE LOG4 (NRPROGSEGS,NRSLSEGS,MAXSTACK,MAXXDATASEG,MAXDISC,TYPE); 01102000
   VALUE NRPROGSEGS,NRSLSEGS,MAXSTACK,MAXXDATASEG,MAXDISC,TYPE;         01104000
   INTEGER NRPROGSEGS,NRSLSEGS,MAXSTACK,MAXXDATASEG,MAXDISC,TYPE;       01106000
   OPTION EXTERNAL;                                                     01108000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,               <<00211>>01110000
                 GEN,PVINFO,SOME'OTHER'PIN);                   <<00211>>01112000
VALUE GEN,SOME'OTHER'PIN;                                      <<00211>>01114000
INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                     <<00211>>01116000
BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                             <<00211>>01118000
OPTION EXTERNAL,VARIABLE;                                      <<00211>>01120000
                                                               <<00211>>01122000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,            <<00211>>01124000
                    PVINFO,SOME'OTHER'PIN);                    <<00211>>01126000
VALUE PVINFO,SOME'OTHER'PIN;                                   <<00211>>01128000
INTEGER REQTYPE,PVINFO,SOME'OTHER'PIN;                         <<00211>>01130000
BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                             <<00211>>01132000
OPTION EXTERNAL,VARIABLE;                                      <<00211>>01134000
DOUBLE PROCEDURE LOGICALCST (CSTNR);                                    01136000
   VALUE CSTNR;                                                         01138000
   INTEGER CSTNR;                                                       01140000
   OPTION UNCALLABLE,FORWARD;                                           01142000
LOGICAL PROCEDURE LSEARCH (KEY,PMODE,TYPE);                             01144000
   VALUE KEY,PMODE,TYPE;                                                01146000
   DOUBLE KEY;                                                          01148000
   INTEGER PMODE,TYPE;                                                  01150000
   OPTION FORWARD;                                                      01152000
PROCEDURE LSTEP (PROC);                                                 01154000
   PROCEDURE PROC;                                                      01156000
   OPTION FORWARD;                                                      01158000
INTEGER PROCEDURE PHYSICALCST (PIN,SEGMENTNR);                          01160000
   VALUE PIN,SEGMENTNR;                                                 01162000
   INTEGER PIN,SEGMENTNR;                                               01164000
   OPTION UNCALLABLE,FORWARD;                                           01166000
PROCEDURE PRINT (MESSAGE,LENGTH,TYPE);                                  01168000
   VALUE LENGTH,TYPE;                                                   01170000
   INTEGER ARRAY MESSAGE;                                               01172000
   INTEGER LENGTH,TYPE;                                                 01174000
   OPTION EXTERNAL;                                                     01176000
PROCEDURE PROCFILE (PIN,FNAME);                                         01178000
   VALUE PIN;                                                           01180000
   INTEGER PIN;                                                         01182000
   BYTE ARRAY FNAME;                                                    01184000
   OPTION UNCALLABLE,FORWARD;                                           01186000
PROCEDURE RELCODESEG (CSTNR);                                           01188000
   VALUE CSTNR;                                                         01190000
   INTEGER CSTNR;                                                       01192000
   OPTION EXTERNAL;                                                     01194000
PROCEDURE RELDATASEG (DSTNR);                                           01196000
   VALUE DSTNR; INTEGER DSTNR;                                          01198000
   OPTION EXTERNAL;                                                     01200000
PROCEDURE RELSIR (SIR,FLAG);                                            01202000
   VALUE SIR,FLAG;                                                      01204000
   INTEGER SIR,FLAG;                                                    01206000
   OPTION EXTERNAL;                                                     01208000
PROCEDURE RETURNENTRY (TYPE,NRENTRIES);                                 01210000
   VALUE TYPE,NRENTRIES;                                                01212000
   INTEGER TYPE,NRENTRIES;                                              01214000
   OPTION EXTERNAL;                                                     01216000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  01218000
   VALUE BITNUMBER;                                                     01220000
   INTEGER ARRAY BITARRAY;                                              01222000
   INTEGER BITNUMBER;                                                   01224000
   OPTION INTERNAL,FORWARD;                                             01226000
PROCEDURE SUDDENDEATH(E);                                      <<08.KM>>01228000
   VALUE E;                                                    <<08.KM>>01230000
   INTEGER E;                                                  <<08.KM>>01232000
   OPTION EXTERNAL;                                            <<08.KM>>01234000
INTEGER PROCEDURE SYSPROC(A);                                           01236000
   VALUE  A;                                                            01238000
   INTEGER  A;                                                          01240000
   OPTION  EXTERNAL;                                                    01242000
PROCEDURE SUMSEGS (CSTNR);                                              01244000
   VALUE CSTNR;                                                         01246000
   INTEGER CSTNR;                                                       01248000
   OPTION FORWARD;                                                      01250000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         01252000
   VALUE BITNUMBER;                                                     01254000
   INTEGER ARRAY BITARRAY;                                              01256000
   INTEGER BITNUMBER;                                                   01258000
   OPTION INTERNAL,FORWARD;                                             01260000
PROCEDURE UNLOAD (PIN);                                                 01262000
   VALUE PIN; INTEGER PIN;                                              01264000
   OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                01266000
PROCEDURE UNLOADPROC (PROCID);                                          01268000
   VALUE PROCID;                                                        01270000
   INTEGER PROCID;                                                      01272000
   OPTION FORWARD;                                                      01274000
INTRINSIC  WHO;                                                         01276000
                                                                        01278000
<<----------------------------------------------------------------------01280000
*                                                                      *01282000
*  UTILITY PROCEDURES                                                  *01284000
*                                                                      *01286000
---------------------------------------------------------------------->>01288000
                                                                        01290000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         01292000
   VALUE BITNUMBER;                                                     01294000
   INTEGER ARRAY BITARRAY;                                              01296000
   INTEGER BITNUMBER;                                                   01298000
   OPTION INTERNAL,UNCALLABLE;                                          01300000
   BEGIN                                                                01302000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                                   01304000
   TOS := PS0;                                                          01306000
   XREG := BITNUMBER.(12:4);                                            01308000
   ASSEMBLE(CSL 1,X);                                                   01310000
   TESTBIT := TOS                                                       01312000
   END;                                                                 01314000
PROCEDURE CLEARBIT (BITARRAY,BITNUMBER);                                01316000
   <<CLEARS THE BIT SPECIFIED BY BITNUMBER IN THE BIT ARRAY             01318000
     SPECIFIED BY BITARRAY>>                                            01320000
   VALUE BITNUMBER;                                                     01322000
   INTEGER ARRAY BITARRAY;                                              01324000
   INTEGER BITNUMBER;                                                   01326000
   OPTION INTERNAL,UNCALLABLE;                                          01328000
   BEGIN                                                                01330000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                                   01332000
   TOS := PS0;                                                          01334000
   XREG := BITNUMBER;                                                   01336000
   ASSEMBLE(TRBC 0,X);                                                  01338000
   PS1 := TOS                                                           01340000
   END;                                                                 01342000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  01344000
   <<SETS THE BIT SPECIFIED BY BITNUMBER IN THE BIT ARRAY               01346000
     SPECIFIED BY BITARRAY>>                                            01348000
   VALUE BITNUMBER;                                                     01350000
   INTEGER ARRAY BITARRAY;                                              01352000
   INTEGER BITNUMBER;                                                   01354000
   OPTION INTERNAL,UNCALLABLE;                                          01356000
   BEGIN                                                                01358000
   TOS := BITNUMBER.(0:12)+@BITARRAY;                                   01360000
   TOS := PS0;                                                          01362000
   XREG := BITNUMBER;                                                   01364000
   ASSEMBLE(TSBC 0,X);                                                  01366000
   PS1 := TOS                                                           01368000
   END;                                                                 01370000
PROCEDURE FORMATNAME (DEST,SOURCE);                                     01372000
   <<MOVES THE IDENTIFIER STRING FROM SOURCE TO DEST AND TRUNCATES IT   01374000
     TO 15 CHARACTERS.  THE SOURCE STRING MUST HAVE NO LEADING BLANKS   01376000
     AND BE TERMINATED WITH A BLANK OR CR; THE DESTINATION STRING HAS   01378000
     THE NUMBER OF CHARACTERS IN THE FIRST BYTE.  NOTE THAT THE SOURCE  01380000
     AND DESTINATION BUFFERS MAY BE THE SAME>>                          01382000
   BYTE ARRAY DEST,SOURCE;                                              01384000
   OPTION INTERNAL,UNCALLABLE;                                          01386000
   BEGIN                                                                01388000
   EQUATE BLANK = %006440;  <<CR - BLANK>>                              01390000
   DOUBLE STRINGS = DEST;                                               01392000
   TOS := STRINGS;                                                      01394000
   MOVE BPS0 := BPS0 WHILE ANS;     <<UPSHIFT CHARS>>          <<02304>>01396000
   SCAN * UNTIL BLANK,1;  <<FIND TERM. CHAR.>>                          01398000
   TOS := S0-@SOURCE;  <<NR. CHAR'S>>                                   01400000
   IF S0 > 15 THEN S0 := 15;  <<TRUNCATE>>                              01402000
   XREG := S0;  <<SAVE NR. CHAR'S>>                                     01404000
   S2 := S2+S0; ASSEMBLE(DECB,NEG); MOVE * := *,(TOS);  <<MOVE STRING>> 01406000
   DEST := XREG  <<NR. CHAR'S>>                                         01408000
   END;                                                                 01410000
INTEGER PROCEDURE ENTRYLENGTH;                                          01412000
   <<CALCULATES THE LENGTH OF THE CURRENT ENTRY>>                       01414000
   OPTION INTERNAL,UNCALLABLE;                                          01416000
   BEGIN                                                                01418000
   ARRAY  ELEN(*) = PB :=  0,  << GARBAGE >>                            01420000
                          16,  << SL >>                        <<00211>>01422000
                          20,  << PROGFILE >>                  <<00211>>01424000
                           3,  << LOADING >>                            01426000
                           5,  << WAITER >>                             01428000
                           5,  << LOADED >>                             01430000
                           4,  << SHARER >>                             01432000
                          14;  << EXTENSION >>                          01434000
   TOS := ELEN(ETYPE);                                                  01436000
   IF  =  THEN  TOS := ENWG;                                            01438000
   IF = THEN SUDDENDEATH(349);                        <<DEBUG>><<08.KM>>01440000
   ENTRYLENGTH := TOS;                                                  01442000
   END;                                                                 01444000
DOUBLE PROCEDURE ENTRYKEY;                                              01446000
   <<RETURNS THE KEY OF THE CURRENT ENTRY>>                             01448000
   OPTION INTERNAL,UNCALLABLE;                                          01450000
   BEGIN                                                                01452000
   IF ETYPE < SHARER                                                    01454000
      THEN BEGIN TOS := EFID1; TOS := EFID2 END                         01456000
      ELSE BEGIN TOS := 0; TOS := EPID END;                             01458000
   ENTRYKEY := TOS                                                      01460000
   END;                                                                 01462000
PROCEDURE LSTEP (PROC);                                                 01464000
   <<STEPS THRU THE CST NUMBERS IN THE CURRENT ENTRY AND CALLS THE      01466000
     GIVEN PROCEDURE FOR EACH CST NUMBER>>                              01468000
   PROCEDURE PROC;                                                      01470000
   OPTION UNCALLABLE;                                                   01472000
   BEGIN                                                                01474000
   XREG := %277;                                                        01476000
   DO BEGIN                                                             01478000
      IF TESTBIT(ENTP2,XREG) THEN                                       01480000
         BEGIN                                                          01482000
         TOS := XREG;  <<CST NR.>>                                      01484000
         PROC(*)  <<APPLY PROCEDURE>>                                   01486000
         END;                                                           01488000
      XREG := XREG-1                                                    01490000
      END UNTIL  =                                                      01492000
   END;                                                                 01494000
LOGICAL PROCEDURE LSEARCH (KEY,PMODE,TYPE);                             01496000
   <<SEARCHES THE DIRECTORY FOR AN ENTRY HAVING THE SPECIFIED KEY,      01498000
     MODE AND TYPE.  IF FOUND, THE VALUE TRUE IS RETURNED AND THE       01500000
     ENTRY POINTERS ARE SET TO THE ENTRY; OTHERWISE THE VALUE FALSE     01502000
     IS RETURNED>>                                                      01504000
   VALUE KEY,PMODE,TYPE;                                                01506000
   DOUBLE KEY;                                                          01508000
   INTEGER PMODE,TYPE;                                                  01510000
   OPTION UNCALLABLE;                                                   01512000
   BEGIN                                                                01514000
   INTEGER RESULT = LSEARCH;                                            01516000
   @ENTP := @DIR;  <<INIT. ENTRY POINTER>>                              01518000
   DO BEGIN                                                             01520000
      IF ETYPE = TYPE AND                                               01522000
         (PMODE = -1 OR PMODE = EPMODE) AND                             01524000
         ENTRYKEY = KEY THEN                                            01526000
         BEGIN                                                          01528000
         @ENTP1 := @ENTP+(IF ETYPE < SHARER THEN 3 ELSE 2);             01530000
         @ENTP2 := @ENTP+ENTRYLENGTH-12;                                01532000
         RESULT := RESULT+1;  <<RETURN TRUE>>                           01534000
         RETURN                                                         01536000
         END;                                                           01538000
      @ENTP := ENTRYLENGTH+@ENTP  <<NEXT ENTRY>>                        01540000
      END UNTIL @ENTP = @DIR(DIRLEN)                                    01542000
   END;                                                                 01544000
PROCEDURE LCREATE (LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY);               01546000
   <<CREATES AN ENTRY HAVING THE SPECIFIED LENGTH, TYPE, FORMAT, MODE   01548000
     AND ID (EXTRACTED FROM KEY).  THE ENTRY IS INSERTED IN THE HASH    01550000
     AND THE ENTRY POINTER (ENTP) IS SET TO THE NEW ENTRY.  NOTE        01552000
     THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN ERROR>> 01554000
   VALUE LENGTH,TYPE,FORMAT,PMODE,LIBRARY,KEY;                          01556000
   INTEGER LENGTH,TYPE,FORMAT,PMODE,LIBRARY;                            01558000
   DOUBLE KEY;                                                          01560000
   OPTION UNCALLABLE;                                                   01562000
   BEGIN                                                                01564000
   INTEGER KEY1 = KEY;                                                  01566000
   INTEGER KEY2 = KEY1+1;                                               01568000
   INTEGER RETRY = Q+1;  <<RETRY FLAG>>                                 01570000
   TOS := -1;  <<INIT. RETRY FLAG>>                                     01572000
                                                                        01574000
   <<* * * FIND SPACE FOR ENTRY * * *>>                                 01576000
                                                                        01578000
   RESTART:                                                             01580000
   @ENTP := @DIR;  <<INIT. ENTRY POINTER>>                              01582000
   NEXT:                                                                01584000
   TOS := ENTRYLENGTH;                                                  01586000
   IF ETYPE = GARBAGE AND (S0 = LENGTH OR S0-1 > LENGTH) THEN           01588000
      BEGIN                                                             01590000
      TOS := TOS-LENGTH;  <<NR. WORDS REMAINING>>                       01592000
      ENWG := S0;  <<UPDATE ENTRY LENGTH>>                              01594000
      @ENTP := TOS+@ENTP;  <<RE-SET ENTRY POINTER>>                     01596000
      GO INITIALIZE                                                     01598000
      END;                                                              01600000
   @ENTP := TOS+@ENTP;  <<NEXT ENTRY>>                                  01602000
   IF @ENTP < @DIR(DIRLEN) THEN GO NEXT;                                01604000
                                                                        01606000
   <<* * * EXPAND SEGMENT TABLE DIRECTORY * * *>>                       01608000
                                                                        01610000
   RETRY := RETRY+1;  <<SET RETRY FLAG>>                                01612000
   IF > THEN GO NFG;  <<NO ROOM?>>                                      01614000
   TOS := ALTDSEGSIZE(SEGTABDST,64);  <<EXPAND SEGMENT TABLE>>          01616000
   IF > THEN  <<NO MORE DISC SPACE?>>                                   01618000
      BEGIN                                                             01620000
      GO NFG                                                            01622000
      END;                                                              01624000
   XREG := TOS-@DIR-1-XREG;  << NR. WORDS ADDED >>                      01626000
   IF <= THEN GO NFG;  <<NO EXPANSION?>>                                01628000
   ASSEMBLE(ZERO,LDXA);  <<GARBAGE ENTRY HEADER>>                       01630000
   ENTDP := TOS;  <<MAKE ADDED SPACE GARBAGE>>                          01632000
   DIRLEN := XREG+DIRLEN;  <<UPDATE DIRECTORY LENGTH>>                  01634000
   GO RESTART;                                                          01636000
                                                                        01638000
   <<* * * INITIALIZE ENTRY * * *>>                                     01640000
                                                                        01642000
   INITIALIZE:                                                          01644000
   TOS := TYPE;                                                         01646000
   TOS.(11:1) := PMODE;                                                 01648000
   TOS.(8:2) := LIBRARY;                                                01650000
   ENTP := TOS;                                                         01652000
   IF TYPE < SHARER THEN                                                01654000
      BEGIN                                                             01656000
      TOS := KEY;                                                       01658000
      EFID2 := TOS; EFID1 := TOS;                                       01660000
      TOS := 3                                                          01662000
      END                                                               01664000
   ELSE                                                                 01666000
      BEGIN                                                             01668000
      EPID := KEY2;                                                     01670000
      TOS := 2                                                          01672000
      END;                                                              01674000
   @ENTP1 := TOS+@ENTP;  <<INIT. SECONDARY POINTER>>                    01676000
   IF  FORMAT = BITMAP  THEN  << BIT MAP? >>                            01678000
      BEGIN                                                             01680000
      TOS := @ENTP2 := @ENTP+LENGTH-12;                                 01682000
      PS0 := 0;                                                         01684000
      ASSEMBLE(DUP,INCB); TOS := 11; ASSEMBLE(MOVE 3)                   01686000
      END;                                                              01688000
   TOS := CCE;  <<OK CONDITION CODE>>                                   01690000
   GO GETOUT;                                                           01692000
                                                                        01694000
   NFG:                                                                 01696000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                01698000
   @ENTP := -1;  <<NO ROOM VALUE>>                                      01700000
                                                                        01702000
   GETOUT:                                                              01704000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            01706000
   END;                                                                 01708000
PROCEDURE LDELETE;                                                      01710000
   <<DELETES THE CURRENT ENTRY BY MAKING GARBAGE OUT OF IT>>            01712000
   OPTION UNCALLABLE;                                                   01714000
   BEGIN                                                                01716000
   INTEGER LENGTH = Q+1;                                                01718000
   TOS := ENTRYLENGTH;  <<ENTRY LENGTH>>                                01720000
                                                                        01722000
   IF @ENTP = @DIR(DIRLEN)  THEN RETURN;                       <<04680>>01724000
   <<* * * TRY TO COMBINE WITH PRECEEDING ENTRY * * *>>                 01726000
                                                                        01728000
   TOS := @ENTP;  <<SAVE CURRENT POINTER>>                              01730000
   @ENTP := @DIR;  <<INIT. ENTRY POINTER>>                              01732000
   NEXT:                                                                01734000
   TOS := ENTRYLENGTH;                                                  01736000
   IF @ENTP+S0 <> @PS1 THEN                                             01738000
      BEGIN                                                             01740000
      @ENTP := TOS+@ENTP;  <<NEXT ENTRY>>                               01742000
      GO NEXT                                                           01744000
      END;                                                              01746000
   IF ETYPE = GARBAGE THEN                                              01748000
      LENGTH := TOS+LENGTH                                              01750000
   ELSE                                                                 01752000
      BEGIN                                                             01754000
      DEL;                                                              01756000
      @ENTP := TOS  <<RESTORE ENTRY POINTER>>                           01758000
      END;                                                              01760000
                                                                        01762000
   <<* * * TRY TO COMBINE WITH FOLLOWING ENTRY * * *>>                  01764000
                                                                        01766000
   TOS := @ENTP+LENGTH;  <<NEXT ENTRY>>                                 01768000
   IF @PS0 < @DIR(DIRLEN) AND PS0.(13:3) = GARBAGE THEN                 01770000
      LENGTH := LENGTH+PS0(1);                                          01772000
                                                                        01774000
   <<* * * INITIALIZE GARBAGE ENTRY * * *>>                             01776000
                                                                        01778000
   TOS := 0; TOS := LENGTH;                                             01780000
   IF = THEN SUDDENDEATH(348);                        <<DEBUG>><<08.KM>>01782000
   ENTDP := TOS                                                         01784000
   END;                                                                 01786000
INTEGER PROCEDURE MOUNTVOLSET (FILENUM,SOME'OTHER'PIN);        <<00211>>01788000
    VALUE FILENUM,SOME'OTHER'PIN;                              <<00211>>01790000
    INTEGER FILENUM,SOME'OTHER'PIN;                            <<00211>>01792000
    OPTION UNCALLABLE,VARIABLE;                                <<00211>>01794000
    BEGIN                                                      <<00211>>01796000
                                                               <<00211>>01798000
        COMMENT                                                <<00211>>01800000
                                                               <<00211>>01802000
            THIS FUNCTION WILL EXPLICITLY PERFORM A MOUNT ON   <<00211>>01804000
            THE HOME VOLUME SET OF THE FILE'S GROUP AND        <<00211>>01806000
            ACCOUNT.                                           <<00211>>01808000
            NO ERROR SHOULD BE RETURNED SINCE AT THIS POINT    <<00211>>01810000
            A SUCCESSFUL MOUNT WOULD HAVE BEEN IMPLICITLY      <<00211>>01812000
            PERFORMED BY THE PREVIOUS FOPEN.                   <<00211>>01814000
                                                               <<00211>>01816000
            THE PROCEDURE WILL RETURN A VALUE AS A FUNCTION.   <<00211>>01818000
            THE NATURE OF THIS VALUE IS DETERMINED ON THE      <<00211>>01820000
            SETTING OF THE CONDITION CODE AS FOLLOWS:          <<00211>>01822000
                                                               <<00211>>01824000
            CCE - OPERATION SUCCEEDED.                         <<00211>>01826000
                  IF THE VALUE IS NON-ZERO A MOUNT WAS         <<00211>>01828000
                  PERFORMED SO THAT THE VALUE REPRESENTS THE   <<00211>>01830000
                  PVINFO WORD RETURNED BY THE MOUNT PROCEDURE. <<00211>>01832000
                  IF THE VALUE IS ZERO NO MOUNT WAS NECESSARY. <<00211>>01834000
                                                               <<00211>>01836000
            CCL - A MOUNT FAILURE CAUSED THE OPERATION TO FAIL <<00211>>01838000
                  IN SOME WAY. THE VALUE RETURNED IS A PV      <<00211>>01840000
                  ERROR NUMBER.                                <<00211>>01842000
                                                               <<00211>>01844000
            CCG - NOT RETURNED.                                <<00211>>01846000
                                                               <<00211>>01848000
        *** NOTE THAT DB MUST BE AT STACK WHEN THIS PROCEDURE  <<00211>>01850000
        *** IS CALLED.                                         <<00211>>01852000
                                                               <<00211>>01854000
        ;                                                      <<00211>>01856000
        EQUATE                                                 <<00211>>01858000
            UNCONDMOUNT = 3,  <<NO BINDING>>                   <<00211>>01860000
            NOHVSET = 28;                                      <<00211>>01862000
                                                               <<00211>>01864000
        LOGICAL                                                <<00211>>01866000
            PMAP = Q-4;                                        <<00211>>01868000
        INTEGER                                                <<00211>>01870000
            PVINFO = MOUNTVOLSET,                              <<00211>>01872000
            RESULT = MOUNTVOLSET,                              <<00211>>01874000
            REQTYPE := UNCONDMOUNT,                            <<00211>>01876000
            PVERR  = REQTYPE;                                  <<00211>>01878000
                                                               <<00211>>01880000
        ARRAY                                                  <<00211>>01882000
            NAMES (0:11),                                      <<00211>>01884000
            VSNAME (*) = NAMES (0),                            <<00211>>01886000
            GNAME (*)  = NAMES (4),                            <<00211>>01888000
            ANAME (*)  = NAMES (8);                            <<00211>>01890000
                                                               <<00211>>01892000
        BYTE ARRAY                                             <<00211>>01894000
            FILENAME (0:27),                                   <<00211>>01896000
            BVSNAME (*) = VSNAME,                              <<00211>>01898000
            BGNAME (*)  = GNAME,                               <<00211>>01900000
            BANAME (*)  = ANAME;                               <<00211>>01902000
                                                               <<00211>>01904000
        IF (PVINFO := FGETPVINFO (FILENUM)) <> 0 THEN          <<00211>>01906000
        BEGIN <<FOPEN CAUSED A LOGICAL MOUNT>>                 <<00211>>01908000
            IF PVINFO = -1 THEN                                <<04862>>01910000
               BEGIN           << IT IS REMOTE PROG >>         <<04862>>01912000
                  CONDCODE := CCL;                             <<04862>>01914000
                  RETURN;                                      <<04862>>01916000
               END;                                            <<04862>>01918000
            FGETINFO (FILENUM,FILENAME);                       <<00211>>01920000
            NAMES := "  ";                                     <<00211>>01922000
            MOVE NAMES (1) := NAMES, (11);                     <<00211>>01924000
            BVSNAME (0) := "*";                                <<00211>>01926000
            SCAN FILENAME UNTIL %020056, 1;  <<SPACE/PERIOD>>  <<00211>>01928000
            TOS := TOS+1;  <<SKIP PAST ".">>                   <<00211>>01930000
            MOVE BGNAME := * WHILE ANS, 0;                     <<00211>>01932000
            DELB;  <<DESTINATION ADDR>>                        <<00211>>01934000
            TOS := TOS+1;  <<SKIP PAST ".">>                   <<00211>>01936000
            MOVE BANAME := * WHILE ANS, 2;                     <<00211>>01938000
            CONDCODE := CCE;  <<ASSUME SUCCESS>>               <<00211>>01940000
            IF PMAP THEN                                       <<00211>>01942000
             MOUNT (BVSNAME,BGNAME,BANAME,                     <<00211>>01944000
                    REQTYPE,-1,PVINFO,SOME'OTHER'PIN)          <<00211>>01946000
            ELSE                                               <<00211>>01948000
             MOUNT (BVSNAME,BGNAME,BANAME,REQTYPE,-1,PVINFO);  <<00211>>01950000
            IF < THEN                                          <<00211>>01952000
            BEGIN <<SOME MOUNT FAILURE>>                       <<00211>>01954000
                RESULT := PVERR;                               <<00211>>01956000
                CONDCODE := CCL;                               <<00211>>01958000
            END;                                               <<00211>>01960000
        END;                                                   <<00211>>01962000
    END <<OF MOUNTVOLSET>>;                                    <<00211>>01964000
INTEGER PROCEDURE DISMOUNTVOLSET (PVINFO,SOME'OTHER'PIN);      <<00211>>01966000
    VALUE   PVINFO,SOME'OTHER'PIN;                             <<00211>>01968000
    INTEGER PVINFO,SOME'OTHER'PIN;                             <<00211>>01970000
    OPTION UNCALLABLE,VARIABLE;                                <<00211>>01972000
    BEGIN                                                      <<00211>>01974000
                                                               <<00211>>01976000
        COMMENT                                                <<00211>>01978000
            THIS PROCEDURE WILL EXPLICITLY MAKE A CALL TO      <<00211>>01980000
            DISMOUNT FOR LOGICALLY DISMOUNTING A VOLUME SET.   <<00211>>01982000
                                                               <<00211>>01984000
            THE PRODECURE RETURNS A PV ERROR NUMBER IS THE     <<00211>>01986000
            DISMOUNT FAILS, OTHERWISE (SUCCESSFUL) A ZERO      <<00211>>01988000
            IS RETURNED. THE SETTING OF THE CONDITION CODE     <<00211>>01990000
            DETERMINES THE NATURE OF THE RETURNED VALUE.       <<00211>>01992000
                                                               <<00211>>01994000
            CCE - OPERATION SUCCEEDED.                         <<00211>>01996000
                  VALUE RETURNED WILL BE ZERO.                 <<00211>>01998000
                                                               <<00211>>02000000
            CCL - OPERATION FAILED.                            <<00211>>02002000
                  VALUE RETURNED WILL BE A PV ERROR NUMBER.    <<00211>>02004000
                                                               <<00211>>02006000
            CCG - NOT RETURNED.                                <<00211>>02008000
                                                               <<00211>>02010000
        *** NOTE THAT DB MUST BE AT STACK WHEN THIS PROCEDURE  <<00211>>02012000
        *** IS CALLED.                                         <<00211>>02014000
                                                               <<00211>>02016000
        ;                                                      <<00211>>02018000
        EQUATE                                                 <<00211>>02020000
            UNCONDDISMOUNT = 3;  <<NO UNBINDING>>              <<00211>>02022000
        LOGICAL                                                <<00211>>02024000
            PMAP = Q-4;                                        <<00211>>02026000
        INTEGER                                                <<00211>>02028000
            REQTYPE := UNCONDDISMOUNT,                         <<00211>>02030000
            PVERR = REQTYPE;                                   <<00211>>02032000
                                                               <<00211>>02034000
        IF PMAP THEN                                           <<00211>>02036000
         DISMOUNT (<<VSNAME>>,<<VSGNAME>>,<<VSANAME>>,         <<00211>>02038000
                   REQTYPE,PVINFO,SOME'OTHER'PIN)              <<00211>>02040000
        ELSE                                                   <<00211>>02042000
         DISMOUNT (<<VSNAME>>,<<VSGNAME>>,<<VSANAME>>,         <<00211>>02044000
                   REQTYPE,PVINFO);                            <<00211>>02046000
        IF <> THEN                                             <<00211>>02048000
        BEGIN                                                  <<00211>>02050000
            DISMOUNTVOLSET := PVERR;                           <<00211>>02052000
            CONDCODE := CCL;                                   <<00211>>02054000
        END;                                                   <<00211>>02056000
    END <<OF DISMOUNTVOLSET>>;                                 <<00211>>02058000
PROCEDURE INITLOADCACHE;                                       <<00807>>02060000
  <<INITIALIZES THE LOAD CACHE.  TO BE CALLED AT LOAD>>        <<00807>>02062000
  <<STARTUP TIME AND BY SEGMENTER WHEN MODIFYING THE >>        <<00807>>02064000
  <<SYSTEM SL.                                       >>        <<00807>>02066000
  OPTION PRIVILEGED,UNCALLABLE;                                <<00807>>02068000
  BEGIN                                                        <<00807>>02070000
    INTEGER BUCKETSIZE';                                       <<00807>>02072000
    LONG ZEROS:=0L0;        <<FOUR WORDS OF ZERO>>             <<00807>>02074000
    IF LOADCACHESEG<>0 THEN                                    <<00807>>02076000
      BEGIN   <<THERE IS A CACHE>>                             <<00807>>02078000
        BUCKETSIZE':=BUCKETSIZE+1;  <<INITIAL VALUE>>          <<00807>>02080000
        TOS:=LOADCACHESEG;          <<TARGET SEGMENT>>         <<00807>>02082000
        TOS:=BUCKET0;               <<TARGET>>                 <<00807>>02084000
        TOS:=@BUCKETSIZE';          <<SOURCE>>                 <<00807>>02086000
        TOS:=1;                     <<LENGTH>>                 <<00807>>02088000
        ASSEMBLE(MTDS 2);           <<MOVE - SAVE TARGET>>     <<00807>>02090000
                                                               <<00807>>02092000
        TOS:=LOADCACHESEG;          <<SOURCE SEGMENT>>         <<00807>>02094000
        TOS:=BUCKET0;               <<SOURCE>>                 <<00807>>02096000
        TOS:=NBUCKETS*BUCKETSIZE-1; <<LENGTH>>                 <<00807>>02098000
        ASSEMBLE(MDS 5);            <<PROPOGATE INITIAL VALUE>><<00807>>02100000
                                                               <<00807>>02102000
        <<ZERO HIT AND MISS COUNTERS>>                         <<00807>>02104000
        TOS:=LOADCACHESEG;          <<TARGET SEGMENT>>         <<00807>>02106000
        TOS:=CACHEHITS;             <<TARGET>>                 <<00807>>02108000
        TOS:=@ZEROS;                <<SOURCE>>                 <<00807>>02110000
        TOS:=4;                     <<LENGTH>>                 <<00807>>02112000
        ASSEMBLE(MTDS 4);           <<MOVE>>                   <<00807>>02114000
      END;                                                     <<00807>>02116000
  END;                                                         <<00807>>02118000
PROCEDURE LOAD (PROGFNAME,ENTRYNAME,CSTINDEX,DELTAP,DSTINDEX,           02120000
   PIN,FLAGS,PCBXSIZE,DLSIZE,STACKSIZE,MAXDATA,GLOBALSIZE,     <<01200>>02122000
   STRING,STRINGLENGTH,CAPABILITY);                            <<01200>>02124000
   <<ASSUMES THAT CRITICAL HAS BEEN SET WHEN CALLED AND THAT DB IS SET  02126000
     TO THE STACK OF THE CALLER>>                                       02128000
   VALUE PIN,FLAGS,PCBXSIZE,STRINGLENGTH;                      <<01200>>02130000
   BYTE ARRAY PROGFNAME,ENTRYNAME,STRING;                      <<01200>>02132000
   INTEGER CSTINDEX,DELTAP,DSTINDEX,PIN,PCBXSIZE,DLSIZE,STACKSIZE,      02134000
      MAXDATA,STRINGLENGTH,GLOBALSIZE;                         <<01200>>02136000
   LOGICAL FLAGS,CAPABILITY;                                            02138000
   OPTION PRIVILEGED,UNCALLABLE;                                        02140000
BEGIN                                                                   02142000
DEFINE PMODE = FLAGS.(12:1)#;                                           02144000
INTEGER P256 := 256;                                                    02146000
INTEGER P512 := 512;                                                    02148000
EQUATE SYSTEMDL = 10,  <<SUBSYSTEM DL AREA SIZE>>                       02150000
       XTRAMAXDATA = 768,     << EXTRA MAXDATA = 512+256 >>    <<01722>>02152000
       STACKOVERFLOW = 128;  <<SYSTEM STACK OVERFLOW AREA SIZE>>        02154000
INTEGER MINSTACKSIZE = P512;  <<MIN. STACK SIZE>>                       02156000
INTEGER SAVESIR := -1;                                                  02158000
DOUBLE DS1 = S-1;                                              <<00193>>02160000
                                                                        02162000
<<PROGRAM FILE PARAMETERS>>                                             02164000
                                                                        02166000
INTEGER PROGFNUM := 0;  <<PROGRAM FILE NR.>>                            02168000
DOUBLE PROGKEY;  <<PROGRAM FILE KEY>>                                   02170000
                                                                        02172000
<<PROCESS PARAMETERS>>                                                  02174000
                                                                        02176000
DOUBLE PROCESSKEY;  <<PROCESS KEY>>                                     02178000
INTEGER ARRAY ENTRYNAME' (0:7) = Q;  <<ENTRY POINT NAME>>               02180000
BYTE ARRAY BENTRYNAME' (*) = ENTRYNAME';                                02182000
INTEGER PLABEL = ENTRYNAME'+0;  <<ENTRY POINT P-LABEL>>                 02184000
BYTE STTINDEX = PLABEL;  <<ENTRY POINT STT NR.>>                        02186000
INTEGER CSTINDEX' = ENTRYNAME'+1;  <<ENTRY POINT CST NR.>>              02188000
INTEGER DELTAP' = ENTRYNAME'+2;  <<ENTRY POINT PB ADR.>>                02190000
LOGICAL ZERODB = ENTRYNAME'+3;  <<ZERO DB AND DL AREA?>>                02192000
INTEGER GLOBALRECD = ENTRYNAME'+4;  <<REC. NR. OF GLOBAL VALUES>>       02194000
INTEGER GLOBALSIZE' = ENTRYNAME'+5;  <<PROCESS GLOBAL SIZE>>            02196000
INTEGER SAFLUT = ENTRYNAME'+6;  <<S.A. OF FLUT>>                        02198000
INTEGER SASTLT = ENTRYNAME'+7;  <<S.A. OF STLT>>                        02200000
INTEGER SATRAPCOM;  <<S.A. OF TRAPCOM'>>                                02202000
INTEGER DLSIZE';  <<PROCESS DL SIZE>>                                   02204000
INTEGER STACKSIZE';  <<PROCESS STACK SIZE>>                             02206000
INTEGER MAXDATA';  <<PROCESS MAX. DATA SEG. SIZE>>                      02208000
INTEGER CAPABILITY';  <<PROCESS CAPABILITY>>                            02210000
INTEGER DSTINDEX' := 0;  <<PROCESS DATA SEG. DST NR.>>                  02212000
INTEGER STCOUNT := 0;   <<#WORDS WORTH OF PASSED STRING>>      <<01246>>02214000
INTEGER LOADWARN := 0;  <<INDICATES ANY SPECIAL ACTIONS TAKEN>><<01200>>02216000
INTEGER ORIG'DLSIZE;  <<LOCAL COPY OF ORIGINAL DLSIZE>>        <<01200>>02218000
INTEGER ORIG'MAXDATA;  <<LOCAL COPY OF ORIGINAL MAXDATA>>      <<01200>>02220000
LOGICAL MODE;                                                           02222000
INTEGER                                                        <<00211>>02224000
    PVINFO,                                                    <<00211>>02226000
    JSMP;                                                      <<00211>>02228000
INTEGER POINTER PXGLOB=S-0;                                             02230000
EQUATE                                                         <<00211>>02232000
    JITWORD = 6,                                               <<00211>>02234000
    JITSMP = 10;                                               <<00211>>02236000
DEFINE IA=LOGICAL(SBUF0.(8:1))#;                                        02238000
DEFINE BA=LOGICAL(SBUF0.(7:1))#;                                        02240000
                                                               <<01200>>02242000
<< WARNINGS ABOUT DEFAULT STACK SPACE PARAMETERS TAKEN >>      <<01200>>02244000
EQUATE                                                         <<01200>>02246000
  DFLT'STACKSIZE  =  -9,          << DEFAULT STACKSIZE WARN >> <<01200>>02248000
  DFLT'DLSIZE     = -10,          << DEFAULT DLSIZE >>         <<01200>>02250000
  DFLT'MAXDATA    = -11,          << DEFAULT MAXDATA >>        <<01200>>02252000
  DLROUNDEDUP     = -12,          << DL UP TO 128 WRD MULT >>  <<01200>>02254000
  CONFIGMAXDATA   = -13,          << MAXDATA @ CONFIG MAX >>   <<01200>>02256000
  MAXDATAUP       = -14;          << MAXDATA @ STACK SPACE >>  <<01200>>02258000
                                                               <<01200>>02260000
                                                               <<01200>>02262000
INTEGER SUBROUTINE WORDADDRESS (BYTEADDRESS);                  <<01200>>02264000
  VALUE BYTEADDRESS;                                           <<01200>>02266000
  BYTE POINTER BYTEADDRESS;                                    <<01200>>02268000
  BEGIN                                                        <<01200>>02270000
    TOS := WORDADDRESS := @BYTEADDRESS & LSR(1);               <<01200>>02272000
    PUSH (Z);                                                  <<01200>>02274000
    IF <<WORDADDRESS>> TOS > TOS <<Z>> THEN                    <<01200>>02276000
      WORDADDRESS.(0:1) := 1;                                  <<01200>>02278000
  END;                                                         <<01200>>02280000
                                                                        02282000
ERRORON;                                                                02284000
CONDCODE := CCE;                                               <<01.02>>02286000
TURNOFFTRAPS;                                                           02288000
PUSH(DL);                                                               02290000
MODE:=PXGLOB(-PXGLOB(-1)+6);                                            02292000
TOS := @JSMP;                                                  <<00211>>02294000
TOS := PS1 (-PS1 (-1) + JITWORD).(6:10);                       <<00211>>02296000
TOS := JITSMP;                                                 <<00211>>02298000
TOS := 1;                                                      <<00211>>02300000
ASSEMBLE (MFDS);                                               <<00211>>02302000
JSMP := JSMP.(8:8);                                            <<00211>>02304000
DEL';                                                                   02306000
FORMATNAME(BENTRYNAME',ENTRYNAME);  <<ENTRY POINT NAME>>                02308000
IF FLAGS.(10:2) = 3 THEN  <<ILLEGAL LIBSEARCH?>>                        02310000
   BEGIN                                                                02312000
   TOS := ERR20; GO GETOUT                                              02314000
   END;                                                                 02316000
STACKSIZE' := STACKSIZE;                                                02318000
DLSIZE' := DLSIZE;                                                      02320000
MAXDATA' := MAXDATA;                                                    02322000
<< LOCAL COPIES OF DLSIZE AND MAXDATA >>                       <<01200>>02324000
ORIG'DLSIZE := DLSIZE;   ORIG'MAXDATA := MAXDATA;              <<01200>>02326000
                                                               <<01200>>02328000
IF STRINGLENGTH > 0 THEN                                       <<01200>>02330000
  BEGIN  << A STRING WAS SPECIFIED - FIGURE # OF WORDS >>      <<01200>>02332000
    IF LOGICAL(STRINGLENGTH) THEN                              <<01200>>02334000
      STCOUNT := STRINGLENGTH & LSR(1) + 1                     <<01200>>02336000
    ELSE                                                       <<01200>>02338000
      BEGIN  << EVEN LENGTH >>                                 <<01200>>02340000
        IF LOGICAL(@STRING) THEN                               <<01200>>02342000
          STCOUNT := STRINGLENGTH & LSR(1) + 2                 <<01200>>02344000
        ELSE                                                   <<01200>>02346000
          STCOUNT := STRINGLENGTH & LSR(1);                    <<01200>>02348000
      END;                                                     <<01200>>02350000
  END;                                                         <<01200>>02352000
                                                               <<01200>>02354000
PROCESSKEY := DOUBLE(LOGICAL(PIN));                                     02356000
                                                                        02358000
<<* * * OPEN PROGRAM FILE * * *>>                                       02360000
                                                                        02362000
PROGFNUM:=DFOPEN(PROGFNAME,%(2)10000000011,%(2)111110111);     <<01191>>02364000
IF < THEN  <<ERROR?>>                                                   02366000
   BEGIN                                                                02368000
   TOS := ERR53; GO GETOUT                                              02370000
   END;                                                                 02372000
FLOCK(PROGFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                         02374000
ASSEMBLE(ADDS 6);                                              <<04493>>02376000
FGETINFO(PROGFNUM,,,,,,S0,,S3,,,,,,,S4,,S5,,DS2);              <<04493>>02378000
BS2 := TOS;  <<INSERT LOGICAL DEVICE NR.>>                              02380000
PROGKEY := TOS;  <<PROG. FILE KEY>>                                     02382000
IF TOS <> PROGFILECODE THEN  <<TYPE PROGRAM?>>                          02384000
   BEGIN                                                                02386000
   TOS := ERR31; GO GETOUT                                              02388000
   END;                                                                 02390000
PVINFO := MOUNTVOLSET (PROGFNUM,PIN);                          <<00776>>02392000
IF < THEN                                                      <<00784>>02394000
BEGIN <<MOUNT FAILED>>                                         <<00784>>02396000
    IF PVINFO = -1 THEN                                        <<04862>>02398000
       BEGIN                                                   <<04862>>02400000
          TOS:=ERR97;                                          <<04862>>02402000
          GO GETOUT;                                           <<04862>>02404000
       END;                                                    <<04862>>02406000
    PVINFO := 0; <<ACTUAL PV ERROR WAS RETURNED. CLEAR IT>>    <<00784>>02408000
    TOS := ERR93;                                              <<00784>>02410000
    GO GETOUT;                                                 <<01618>>02412000
END;                                                           <<00784>>02414000
SAVESIR := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                02416000
EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                     02418000
FREADDIR(PROGFNUM,SBUF0,128,0D);  <<READ RECORD 0>>                     02420000
IF <> THEN GO IOERROR;  <<ERROR?>>                                      02422000
S1 := S1+1+SEXTERNALRECD;<<EXT. S.A.+#FILELABEL+#USERLABEL>>   <<04493>>02424000
IF TOS > TOS THEN   <<CODE NOT IN 1ST EXTENT>>                 <<04493>>02426000
   BEGIN                                                                02428000
   TOS := ERR34; GO ABORT                                               02430000
   END;                                                                 02432000
                                                                        02434000
IF     (IA LOR BA) THEN                                                 02436000
BEGIN                                                                   02438000
IF MODE.(2:2)  THEN <<INTERACTIVE>>                                     02440000
BEGIN                                                                   02442000
   <<SET INTERACTIVE BIT IB PCB>>                              <<01549>>02444000
   ABS(PIN*PCBSIZE+ABS(PCBB)+QUEUEINGINFOWORDNUM)<<JB.IV>>     <<01549>>02446000
      .INTERACTIVEFLAG:=1;                                     <<01549>>02448000
   IF NOT IA THEN                                                       02450000
   BEGIN                                                                02452000
   TOS:=ERR39; GO ABORT;                                                02454000
   END;                                                                 02456000
END                                                                     02458000
ELSE <<BATCH>>                                                          02460000
IF NOT BA THEN                                                          02462000
   BEGIN                                                                02464000
TOS:=ERR39; GO ABORT;                                                   02466000
   END;                                                                 02468000
END;                                                                    02470000
<<* * * LOCATE ENTRY POINT * * *>>                                      02472000
                                                                        02474000
IF BENTRYNAME' <> 0 THEN  <<ENTRY POINT SPECIFIED?>>                    02476000
   BEGIN                                                                02478000
   FREADDIR(PROGFNUM,SBUF4,128,DOUBLE(LOGICAL(SENTRYRECD)));            02480000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   02482000
   TOS := @SBUF4&LSL(1);  <<TARGET ENTRY NAME>>                         02484000
   COMPNAME:                                                            02486000
   IF BPS0 = 0 THEN  <<END OF LIST?>>                                   02488000
      BEGIN                                                             02490000
      TOS := ERR21; GO ABORT                                            02492000
      END;                                                              02494000
   TOS := @BPS0+(INTEGER(BPS0.(12:3))+3)&LSL(1);  <<NEXT TARGET NAME>>  02496000
   IF @BPS0 >= @SBUF4(128)&LSL(1) THEN  <<LOAD NEXT RECORD?>>           02498000
      BEGIN                                                             02500000
      MOVE SBUF3 := SBUF4,(128);                                        02502000
      @BPS1 := @BPS1-P256;  <<ADJ. TARGET POINTER>>                     02504000
      TOS := TOS-P256;  <<ADJ. NEXT TARGET POINTER>>                    02506000
      FREAD(PROGFNUM,SBUF4,128);  <<READ NEXT RECORD>>                  02508000
      IF <> THEN GO IOERROR  <<ERROR?>>                                 02510000
      END;                                                              02512000
   XREG := BENTRYNAME';  <<NR. CHAR'S>>                                 02514000
   IF INTEGER(BPS1.(12:4)) <> XREG THEN  <<NR. CHAR'S MATCH?>>          02516000
      BEGIN                                                             02518000
      NEXTENTRY:                                                        02520000
      DELB;  <<DELETE TARGET POINTER>>                                  02522000
      GO COMPNAME  <<NEXT NAME>>                                        02524000
      END;                                                              02526000
   DO BEGIN                                                             02528000
      IF BENTRYNAME'(XREG) <> BPS1(XREG) THEN GO NEXTENTRY;             02530000
      XREG := XREG-1                                                    02532000
      END UNTIL =;                                                      02534000
   TOS := TOS&LSR(1);  <<CONVERT TO WORD POINTER>>                      02536000
   TOS := DPS0(-1);  <<PB ADR. AND STT NR.>>                            02538000
   ASSEMBLE(DXCH,DDEL)                                                  02540000
   END                                                                  02542000
ELSE  <<USE PRIMARY ENTRY POINT>>                                       02544000
   BEGIN                                                                02546000
   TOS := SSTARTINGADR;  <<PB ADR.>>                                    02548000
   TOS := SSTARTINGSTT  <<STT NR.>>                                     02550000
   END;                                                                 02552000
STTINDEX := TOS;  <<STARTING STT NR.>>                                  02554000
DELTAP' := TOS;  <<STARTING PB ADR.>>                                   02556000
                                                                        02558000
<<* * * DETERMINE DATA SEGMENT PARAMETERS * * *>>                       02560000
                                                                        02562000
TOS := IF DLSIZE' = -1 THEN SDLSIZE ELSE DLSIZE';  <<INIT. DLSIZE>>     02564000
IF < THEN  <<INITIAL DLSIZE EXCEEDS 32K?>>                              02566000
   BEGIN  << INITIAL DL IS BAD >>                              <<01428>>02568000
   IF DLSIZE' = -1 THEN                                        <<01428>>02570000
      BEGIN  << BAD DL FROM PROGRAM FILE >>                    <<01428>>02572000
      TOS := ERR76;   GO ABORT;                                <<01428>>02574000
      END                                                      <<01428>>02576000
   ELSE                                                        <<01428>>02578000
      BEGIN  << BAD DL FROM USER - TRY DEFAULT >>              <<01428>>02580000
      DEL;   << THE BAD DL VALUE >>                            <<01428>>02582000
      TOS := SDLSIZE;   << DL FROM PROGRAM FILE >>             <<01428>>02584000
      IF < THEN                                                <<01428>>02586000
         BEGIN   << BAD DL FROM PROGRAM FILE >>                <<01428>>02588000
         TOS := ERR76;   GO ABORT;                             <<01428>>02590000
         END                                                   <<01428>>02592000
      ELSE                                                     <<01428>>02594000
         LOADWARN := DFLT'DLSIZE;                              <<01428>>02596000
      END;                                                     <<01428>>02598000
   END << INITIAL DLSIZE BAD >>;                               <<01428>>02600000
DLSIZE' := (TOS+SYSTEMDL+PCBXSIZE+127)&LSR(7)&LSL(7)-PCBXSIZE; <<01200>>02602000
IF < THEN                                                      <<01428>>02604000
   BEGIN  << FINAL DL > 32K >>                                 <<01428>>02606000
   TOS := ERR76;   GO ABORT;                                   <<01428>>02608000
   END                                                         <<01428>>02610000
ELSE IF ORIG'DLSIZE <> -1 AND LOADWARN = 0 THEN                <<01428>>02612000
   IF (ORIG'DLSIZE MOD 128) <> 0 THEN                          <<04605>>02614000
      LOADWARN := DLROUNDEDUP;                                 <<04605>>02616000
IF STACKSIZE' = -1 THEN STACKSIZE' := SSTACKSIZE;                       02618000
IF STACKSIZE' < MINSTACKSIZE THEN  <<STACK TOO SMALL?>>                 02620000
   BEGIN                                                                02622000
   << TAKE DEFAULT STACKSIZE FROM PROGRAM FILE >>              <<01428>>02624000
   << NOTE THAT STACKSIZE IN PROGRAM FILE IS ALWAYS >= 512 >>  <<01428>>02626000
   LOADWARN := DFLT'STACKSIZE;                                 <<01428>>02628000
   STACKSIZE' := SSTACKSIZE;                                   <<01428>>02630000
   END;                                                                 02632000
GLOBALSIZE' := SGLOBALSIZE;                                             02634000
IF MAXDATA' = 0 OR MAXDATA' < -1 THEN                          <<01428>>02636000
   BEGIN                                                       <<01428>>02638000
   << TAKE DEFAULT MAXDATA FROM PROGRAM FILE >>                <<01428>>02640000
   LOADWARN := DFLT'MAXDATA;                                   <<01428>>02642000
   MAXDATA' := SMAXDATA;                                       <<01428>>02644000
   END;                                                        <<01428>>02646000
IF MAXDATA' = -1 THEN MAXDATA' := SMAXDATA;                             02648000
SAFLUT := SSAFLUT;  <<SAVE S.A. OF FLUT>>                               02650000
SASTLT := SSASTLT;  <<SAVE S.A. OF STLT>>                               02652000
SATRAPCOM := SSATRAPCOM;  <<SAVE S.A. OF TRAPCOM'>>                     02654000
ZERODB := SZERODB;  <<SAVE ZERODB FLAG>>                                02656000
GLOBALRECD := SGLOBALRECD;  <<SAVE REC. NR. OF INIT. GLOBAL VALUES>>    02658000
CAPABILITY' := SCAPABILITY;  <<SAVE CAPABILITY>>                        02660000
TOS := FACCESS(PROGFNUM);                                               02662000
TOS := TOS&LSR(3);  ASSEMBLE( DUP );                                    02664000
TOS := TOS&LSR(2);  ASSEMBLE( AND,NOT );                                02666000
CAPABILITY'.(10:1) := TOS;                                              02668000
                                                                        02670000
<<* * * LOAD PROGRAM FILE * * *>>                                       02672000
                                                                        02674000
TOS := LOADPROGRAM (PROGFNUM,PROGKEY,PROCESSKEY,                        02676000
                    PIN CAT FLAGS (2:10:6),SAVESIR,PVINFO);    <<00776>>02678000
IF < THEN GO ABORT;  <<ERROR?>>                                         02680000
TOS := PLABEL CAT S0 (8:8:8);  <<INSERT CST NR.>>                       02682000
SETBIT0;  <<SET "EXTERNAL" BIT>>                                        02684000
PLABEL := TOS;  <<ENTRY POINT P-LABEL>>                                 02686000
TOS.(0:1) := LS0.(0:1) LAND NOT PMODE;  <<ADJ. PRIV. MODE BIT>>         02688000
CSTINDEX' := TOS;  <<STARTING CST NR. WITH MODE BIT>>                   02690000
LSEARCH(PROGKEY,PMODE,PROGFILE);                                        02692000
TOS := ECST;                                                            02694000
PCB(PCBSIZE*PIN+12) := TOS;   << SET PBX >>                             02696000
                                                               <<00.02>>02698000
<< * * * CHECK FOR VALID LAUNCH DATA * * * >>                  <<00.02>>02700000
                                                               <<00.02>>02702000
IF CSTINDEX'.(10:6) > ABS(CSTEXT(ECST)+ABS(DSTB)) OR           <<00.02>>02704000
LOGICAL(DELTAP') >= ABS(XREG+CSTINDEX'.(10:6)*4)&LSL(2) THEN   <<00.02>>02706000
BEGIN << BAD ENTRY POINT DATA >>                               <<00.02>>02708000
   TOS := ERR45;                                               <<00.02>>02710000
   GO ABORT;                                                   <<00.02>>02712000
END;                                                           <<00.02>>02714000
                                                                        02716000
<<* * * CHECK FOR PROGRAM BEING TRACED * * *>>                          02718000
                                                                        02720000
IF SASTLT <> -1 THEN  <<TRACED?>>                                       02722000
   BEGIN                                                                02724000
   TOS := ABSOLUTE(TRACEL);    << GET TRACE LABELS >>                   02726000
   TOS := ABSOLUTE(XREG:=XREG+1);                                       02728000
   ASSEMBLE(DTST);                                                      02730000
   IF = THEN  <<TRACE NOT PRESENT?>>                                    02732000
      BEGIN                                                             02734000
      TOS := ERR22; GO ABORT                                            02736000
      END;                                                              02738000
   DELTAP' := TOS.(2:14); << DELTA P >>                                 02740000
   CSTINDEX' := TOS.(8:8); << CST NR. >>                                02742000
   END;                                                                 02744000
                                                                        02746000
<<* * * GET DST ENTRY AND INITIALIZE DATA SEGMENT * * *>>               02748000
                                                                        02750000
                                                               <<01933>>02752000
<<  INSURE ENOUGH STACK TO START THE PROCESS UP >>             <<01933>>02754000
<<  THE STACKSIZE<DEFAULTDATASEG CAN ONLY OCCUR BY USING>>     <<01933>>02756000
<<  PREP INSIDE OF THE SEGMENTER OR CALLING THE SEGMENTER>>    <<01933>>02758000
<<  PROCEDURE DIRECTLY.  THE CI PREP COMMAND WON'T ALLOW>>     <<01933>>02760000
<<  SUCH A SPECIFICATION>>                                     <<01933>>02762000
                                                               <<01933>>02764000
IF STACKSIZE'<ABSOLUTE(DEFAULTDATASEG) THEN                    <<01933>>02766000
   STACKSIZE':=ABSOLUTE(DEFAULTDATASEG);                       <<01933>>02768000
TOS := 0;  <<FOR RESULT OF GETDATASEG>>                                 02770000
TOS:=DOUBLE(LOGICAL(PCBXSIZE))  + DOUBLE(LOGICAL(DLSIZE'))+    <<00193>>02772000
     DOUBLE(LOGICAL(GLOBALSIZE'))+DOUBLE(LOGICAL(STACKSIZE'))+ <<00193>>02774000
     DOUBLE(LOGICAL(STACKOVERFLOW))+DOUBLE(LOGICAL(STCOUNT));  <<01200>>02776000
<< CHECK IF DATA SEGMENT SIZE EXCEEDS 32K WDS >>               <<00193>>02778000
IF DS1 > %77777D THEN                                          <<00193>>02780000
   BEGIN                                                                02782000
   DELB;  << CONVERT SEG SIZE TO SINGLE PRECISON >>            <<00193>>02784000
   TOS := ERR35; GO ABORT                                               02786000
   END;                                                                 02788000
DELB;  << CONVERT SEGMENT SIZE TO SINGLE PRECISION >>          <<00193>>02790000
TOS := (((S0+XTRAMAXDATA+127)&LSR(7))+12)&LSL(7);  <<VM SPACE>><<RV.PV>>02792000
ASSEMBLE(CAB,CAB);                                                      02794000
XREG := ABSOLUTE(MAXDATASEG);     << MAX DATA SEG SIZE >>               02796000
IF LS0 > LXREG THEN  <<DATA SEG. EXCEEDS SYS. MAX.?>>                   02798000
   BEGIN                                                                02800000
   TOS := ERR36; GO ABORT                                               02802000
   END;                                                                 02804000
IF MAXDATA' = -1 THEN MAXDATA' := S0+XTRAMAXDATA               <<RV.PV>>02806000
                 ELSE MAXDATA' := MAXDATA'+XTRAMAXDATA;        <<RV.PV>>02808000
IF MAXDATA' < 0 OR MAXDATA' > XREG THEN                        <<01428>>02810000
   BEGIN  << SET MAXDATA DOWN TO CONFIGURATION MAXIMUM >>      <<01428>>02812000
   << REPORT WARNING ONLY IF SPECIFIED MAXDATA > CONFIG MAX >> <<01428>>02814000
   IF ORIG'MAXDATA > 0 AND MAXDATA' - XTRAMAXDATA > XREG       <<01428>>02816000
      AND (LOADWARN = 0 OR LOADWARN = DLROUNDEDUP) THEN        <<01428>>02818000
      LOADWARN := CONFIGMAXDATA;                               <<01428>>02820000
   MAXDATA' := XREG;     << CONFIGURATION MAXIMUM MAXDATA>>    <<01428>>02822000
   END;                                                        <<01428>>02824000
TOS := MAXDATA';                                               <<RV.PV>>02826000
ASSEMBLE(DDUP,LCMP);                                                    02828000
<< IF STACK SPACE REQUIRED > SPECIFIED MAXDATA >>              <<01428>>02830000
IF > THEN                                                      <<01428>>02832000
   BEGIN  << SET MAXDATA UP TO STACK SPACE REQUIRED >>         <<01428>>02834000
   LOADWARN := MAXDATAUP;                                      <<01428>>02836000
   MAXDATA' := S1;     << TOTAL SPACE REQUIRED TO LOAD >>      <<01428>>02838000
   S0 := MAXDATA';                                             <<01428>>02840000
   END;                                                                 02842000
DSTINDEX' := GETSTACK(*,*);  <<ALLOCATE DATA SEGMENT>>                  02844000
IF = THEN                                                               02846000
   BEGIN                                                                02848000
   EXCHANGEDB(DSTINDEX');  <<SET DB TO DATA SEGMENT>>                   02850000
   TOS := PCBXSIZE+DLSIZE';  <<POINTER TO DB+0>>                        02852000
   DBAREA := 0; ASSEMBLE(DZRO,INCB); TOS := S2;                         02854000
   ASSEMBLE(MOVE 3);  <<ZERO PCBX AND DL AREA>>                         02856000
   DBAREA := S1;  <<INSERT VDS IN PCBX(0)>>                             02858000
   FREADDIR(PROGFNUM,PS0,GLOBALSIZE',DOUBLE(LOGICAL(GLOBALRECD)));      02860000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   02862000
   PS0(-1) := SAFLUT;  <<INSERT S.A. OF FLUT>>                          02864000
   PS0 (-3) := SATRAPCOM;  <<INSERT S.A. OF TRAPCOM'>>                  02866000
   PS0(-6) := SASTLT;  <<INSERT S.A. OF STLT>>                          02868000
   PS0(-8) := PLABEL;  <<INSERT ENTRY POINT P-LABEL>>                   02870000
   DDEL;  <<DELETE VDS AND POINTER>>                                    02872000
   END                                                                  02874000
ELSE  <<NO DST ENTRY OR NO VIRTUAL MEMORY>>                             02876000
   BEGIN                                                                02878000
   IF  >  THEN  TOS :=  ERR66  ELSE                                     02880000
   TOS := ERR73; GO ABORT                                               02882000
   END;                                                                 02884000
                                                                        02886000
<<* * * CLEAN-UP AND RETURN PARAMETERS * * *>>                          02888000
                                                                        02890000
EXCHANGEDB(0);  <<RESET DB TO STACK>>                                   02892000
IF STRINGLENGTH > 0 THEN                                       <<01200>>02894000
   BEGIN  << A STRING WAS SPECIFIED >>                         <<01200>>02896000
   << MOVE STRING TO NEW STACK.  STCOUNT HAS BEEN SET SO  >>   <<01200>>02898000
   << THAT IT IS NOT NECESSARY TO WORD ALIGN THE STRING.  >>   <<01200>>02900000
   TOS := DSTINDEX';                                           <<01200>>02902000
   TOS := PCBXSIZE + DLSIZE' + GLOBALSIZE';                    <<01200>>02904000
   TOS := WORDADDRESS (STRING);                                <<01200>>02906000
   TOS := STCOUNT;                                             <<01200>>02908000
   ASSEMBLE (MTDS 4);                                          <<01200>>02910000
   END;                                                        <<01200>>02912000
                                                               <<01200>>02914000
CAPABILITY := CAPABILITY';                                              02916000
DSTINDEX := DSTINDEX';                                                  02918000
STACKSIZE := STACKSIZE';                                                02920000
DLSIZE := DLSIZE';                                                      02922000
MAXDATA := MAXDATA';                                                    02924000
GLOBALSIZE := GLOBALSIZE';                                              02926000
CSTINDEX := CSTINDEX';                                                  02928000
DELTAP := DELTAP';                                                      02930000
TOS := 0;  <<NO ERROR>>                                                 02932000
GO GETOUT;                                                              02934000
                                                                        02936000
<<* * * ERROR RECOVERY * * *>>                                          02938000
                                                                        02940000
IOERROR:                                                                02942000
TOS := ERR63;                                                           02944000
                                                                        02946000
ABORT:                                                                  02948000
EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                     02950000
IF LSEARCH(PROCESSKEY,PMODE,SHARER) THEN  <<CODE LOADED?>>              02952000
   BEGIN                                                                02954000
   LDELETE;  <<DELETE SHARER ENTRY>>                                    02956000
   LSEARCH(PROGKEY,PMODE,PROGFILE);                                     02958000
   EXCHANGEDB (0);                                             <<01329>>02960000
   << We need to specify another mount during this error >>    <<01329>>02962000
   << condition so that FCLOSE can close the program file>>    <<01329>>02964000
   MOUNTVOLSET (PROGFNUM);                                     <<01329>>02966000
   EXCHANGEDB (SEGTABDST);                                     <<01329>>02968000
   ADJREFCOUNTS(-1)  <<DECREMENT REFERENCE COUNTS>>                     02970000
   END;                                                                 02972000
EXCHANGEDB(0);  <<RESET DB TO STACK>>                                   02974000
IF PVINFO <> 0 THEN DISMOUNTVOLSET (PVINFO,PIN);               <<00776>>02976000
IF DSTINDEX' <> 0 THEN RELDATASEG(DSTINDEX');                           02978000
                                                                        02980000
GETOUT:                                                                 02982000
IF SAVESIR <> -1 THEN RELSIR(SEGTABSIR,SAVESIR);                        02984000
IF PROGFNUM <> 0 THEN  <<CLOSE PROG. FILE?>>                            02986000
   BEGIN                                                                02988000
   TOS := ERRORGET(1);  <<SAVE ERROR NR.>>                              02990000
   FCLOSE(PROGFNUM,0,0);                                                02992000
   ERRORPUT(*,1)  <<RESTORE ERROR NR.>>                                 02994000
   END;                                                                 02996000
IF S0 <> 0 THEN CONDCODE := CCL   << LOAD FAILED >>            <<01200>>02998000
ELSE IF LOADWARN <> 0 THEN                                     <<01200>>03000000
  BEGIN  << A WARNING TO REPORT >>                             <<01200>>03002000
    DEL;   << THE 0 RETURN >>                                  <<01200>>03004000
    CONDCODE := CCG;                                           <<01200>>03006000
    TOS := LOADWARN;                                           <<01200>>03008000
  END;                                                         <<01200>>03010000
TOS := [10/0,6/13]; ASSEMBLE(XCH,ZERO);                                 03012000
ERROREXIT(*,*,*)                                                        03014000
END;                                                                    03016000
INTEGER PROCEDURE LOADPROGRAM (PROGFNUM,PROGKEY,PROCESSKEY,COMMAND,     03018000
                               SAVESIR,PVINFO);                <<00211>>03020000
   <<LOADS THE GIVEN PROGRAM FILE.  THE STARTING CST NUMBER ALONG       03022000
     WITH THE MODE BIT IS RETURNED AS THE RESULT.  ALSO CREATES THE     03024000
     SHARING ENTRY (IF NECESSARY).  NOTE THAT DB MUST BE SET TO THE     03026000
     SEGMENT TABLE WHEN THE PROCEDURE IS CALLED AND IT IS ASSUMED THAT  03028000
     THE CALLER HAS THE SEGMENT TABLE SIR.  NOTE THAT THIS PROCEDURE    03030000
     USES THE CONDITION CODE TO INDICATE AN ERROR (THE ERROR NUMBER IS  03032000
     RETURNED AS THE RESULT OF THE PROCEDURE)>>                         03034000
   VALUE PROGFNUM,PROGKEY,PROCESSKEY,COMMAND,SAVESIR,PVINFO;   <<00211>>03036000
   INTEGER PROGFNUM,COMMAND,SAVESIR,PVINFO;                    <<00211>>03038000
   DOUBLE PROGKEY,PROCESSKEY;                                           03040000
   OPTION INTERNAL,UNCALLABLE;                                          03042000
   BEGIN                                                                03044000
   DEFINE ALLOCATE = LOGICAL(COMMAND.(0:1))#,  <<ALLOCATE?>>            03046000
          LIBRARY = COMMAND.(2:2)#,  << LIBRARY SEARCH >>               03048000
          PMODE = COMMAND.(4:1)#,  <<NORMAL/NOPRIV MODE>>               03050000
          LMAP = LOGICAL(COMMAND.(6:1))#;  <<LMAP WANTED?>>             03052000
   INTEGER PROCESSPIN = PROCESSKEY+1;                                   03054000
   INTEGER LIBSEARCH;                                          <<RN.02>>03056000
                                                                        03058000
   SUBROUTINE LOCK;                                                     03060000
      BEGIN                                                             03062000
      IF NOT ALLOCATE THEN  <<NORMAL LOAD?>>                            03064000
         BEGIN                                                          03066000
         TOS := ERRORGET(1);  <<SAVE ERROR NR.>>                        03068000
         FLOCK(PROGFNUM,TRUE);                                          03070000
         ERRORPUT(*,1)  <<RESTORE ERROR NR.>>                           03072000
         END;                                                           03074000
      GETSIR(SEGTABSIR);                                                03076000
      EXCHANGEDB(SEGTABDST);                                            03078000
      END;                                                              03080000
                                                                        03082000
   SUBROUTINE UNLOCK(DO'PDISABLE);                             <<08.KM>>03084000
                    VALUE DO'PDISABLE; LOGICAL DO'PDISABLE;    <<08.KM>>03086000
      BEGIN                                                             03088000
      EXCHANGEDB(0);                                                    03090000
      IF NOT ALLOCATE THEN FUNLOCK(PROGFNUM);                  <<08.KM>>03092000
      IF DO'PDISABLE THEN PDISABLE;                            <<08.KM>>03094000
      RELSIR(SEGTABSIR,SAVESIR);  <<NOTE: ASSUME SAVESIR IS THE SAME>>  03096000
      END;                                                              03098000
                                                                        03100000
   <<* * * CREATE PROCESS ENTRY * * *>>                                 03102000
                                                                        03104000
   IF NOT ALLOCATE THEN  <<ALLOCATE PROGRAM?>>                          03106000
      BEGIN                                                             03108000
      LCREATE(4,SHARER,0,PMODE,LIBRARY,PROCESSKEY);                     03110000
      IF < THEN  <<ERROR?>>                                             03112000
         BEGIN                                                          03114000
         NOROOM:                                                        03116000
         TOS := ERR70; GO ABORT                                         03118000
         END;                                                           03120000
      ENTDP1 := PROGKEY  <<INSERT PROGRAM FILE ID>>                     03122000
      END;                                                              03124000
                                                                        03126000
   <<* * * CHECK FOR LOADED PROGRAM FILE * * *>>                        03128000
TRYAGAIN:                                                      <<00125>>03130000
                                                                        03132000
   TOS := 0;  <<FOR RESULT OF LSEARCH>>                                 03134000
   TOS := PROGKEY;                                                      03136000
   TOS := PMODE; ASSEMBLE(TCBC 15);  <<OPPOSITE MODE>>                  03138000
   IF LSEARCH(*,*,PROGFILE) THEN  <<LOADED IN OTHER MODE?>>             03140000
      BEGIN                                                             03142000
      TOS := ERR26; GO ABORT                                            03144000
      END;                                                              03146000
   IF LSEARCH(PROGKEY,PMODE,PROGFILE) THEN  <<ALREADY LOADED?>>         03148000
      BEGIN                                                             03150000
      IF  ALLOCATE  THEN  GO INCREMENT;                                 03152000
      TOS := @SBUF0(28)&LSL(1);  <<CST RE-MAPPING ARRAY>>               03154000
      TOS := @SBUF0+(SNRSEGS+57)&LSR(1);  <<SEG. DESCRIP. ARRAY>>       03156000
      TOS := BPS1(SSTARTINGSEG) CAT PS0(XREG) (0:0:1);  <<CST AND MODE>>03158000
      GO INCREMENT                                                      03160000
      END;                                                              03162000
                                                                        03164000
   <<* * * CHECK FOR PROGRAM FILE BEING LOADED * * *>>                  03166000
                                                                        03168000
   TOS := 0;  <<FOR RESULT OF LSEARCH>>                                 03170000
   TOS := PROGKEY;                                                      03172000
   TOS := PMODE; ASSEMBLE(TCBC 15);  <<OPPOSITE MODE>>                  03174000
   IF LSEARCH(*,*,LOADING) THEN  <<LOADING IN OTHER MODE?>>             03176000
      BEGIN                                                             03178000
      TOS := ERR26; GO ABORT                                            03180000
      END;                                                              03182000
   IF LSEARCH(PROGKEY,PMODE,LOADING) THEN  <<BEING LOADED?>>            03184000
      BEGIN                                                             03186000
      LCREATE(5,WAITING,0,PMODE,LIBRARY,PROGKEY);  <<WAITING ENTRY>>    03188000
      IF < THEN GO NOROOM;  <<ERROR?>>                                  03190000
      EWAITINGPIN := USERPIN;  <<PIN OF WAITING PROCESS>>               03192000
      UNLOCK(1);                       <<IMPLIED PDISABLE>>    <<08.KM>>03194000
      IMPEDE(0);                       <<IMPLIED PENABLE>>     <<08.KM>>03196000
                                                                        03198000
      <<SLEEP>>                                                         03200000
                                                                        03202000
      LOCK;                                                             03204000
      LSEARCH(PROGKEY,PMODE,LOADED);  <<FIND WAITING ENTRY>>            03206000
      TOS := ENTDP1;  <<PARAMETER AND ERROR NR.>>                       03208000
      LDELETE;                                                          03210000
      ASSEMBLE(TEST);                                                   03212000
      IF <> THEN  <<ERROR?>>                                            03214000
         BEGIN                                                          03216000
         ASSEMBLE(STBX);                                                03218000
         IF <> THEN ERRORPUT(XREG,1);  <<FILE SYS. ERROR NR'S>>         03220000
         GO ABORT                                                       03222000
         END;                                                           03224000
      DEL;                                                              03226000
      IF LSEARCH(PROGKEY,PMODE,PROGFILE) <<GET PROG. ENTRY>>   <<00125>>03228000
        THEN GO INCREMENT  <<FOUND ENTRY>>                     <<00125>>03230000
        ELSE GO TRYAGAIN;  <<PROGRAM ALREADY TERMINATED>>      <<00125>>03232000
      END;                                                              03234000
                                                                        03236000
   <<* * * ACTIVATE LOAD PROCESS * * *>>                                03238000
                                                                        03240000
   LCREATE(3,LOADING,0,PMODE,LIBRARY,PROGKEY);  <<LOADING ENTRY>>       03242000
   IF < THEN GO NOROOM;  <<ERROR?>>                                     03244000
   UNLOCK(0);                                                  <<08.KM>>03246000
   TOS := 0D;  <<FOR RESULT OF LOADER>>                                 03248000
   TOS := COMMAND;                                                      03250000
   TOS := PROGKEY;                                                      03252000
   TOS := 0;  <<DON'T CARE>>                                            03254000
   TOS := PVINFO;                                              <<00211>>03256000
   TOS := LOADER (*,*,*,*,*);                                  <<00211>>03258000
   LOCK;                                                                03260000
   ASSEMBLE(TEST);                                                      03262000
    IF <> THEN GO ABORT;                                       <<01618>>03264000
   DEL;                                                                 03266000
   GO AOK;                                                              03268000
                                                                        03270000
   <<* * * INCREMENT THE REFERENCE COUNTS * * *>>                       03272000
                                                                        03274000
   INCREMENT:                                                           03276000
   ADJREFCOUNTS(1);  <<INCREMENT REF. COUNTS>>                          03278000
   IF LMAP THEN  <<LMAP REQUESTED?>>                                    03280000
      BEGIN                                                             03282000
      EXCHANGEDB(0);  <<RESET DB TO STACK>>                             03284000
      GENMSG(9,88);   << LMAP NOT AVAILABLE >>                 <<RN.02>>03286000
      EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>               03288000
      IF < THEN  <<PRINT ERROR?>>                                       03290000
         BEGIN                                                          03292000
         PRINTERROR:                                                    03294000
         TOS := ERR75; GO ABORT                                         03296000
         END                                                            03298000
      END;                                                              03300000
   IF  ELIB <> LIBRARY  THEN  << DIFFERENT LIBSEARCH >>                 03302000
      BEGIN                                                             03304000
      LIBSEARCH := ELIB;       << OFFSET TO FIND G, P OR S >>  <<RN.02>>03306000
      EXCHANGEDB(0);      << DB TO STACK >>                             03308000
      GENMSG(9,89+LIBSEARCH);  << PROGRAM LOADED WITH >>       <<RN.02>>03310000
                               << LIB = (S, P OR G)   >>       <<RN.02>>03312000
      TOS := 0;  <<RETURN FOR EXCHANGEDB>>                              03314000
      TOS := SEGTABDST;                                                 03316000
      EXCHANGEDB (*); <<SET DB TO SEGMENT TABLE>>                       03318000
      IF  <  THEN  GO PRINTERROR;                                       03320000
      END;                                                              03322000
                                                                        03324000
   AOK:                                                                 03326000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03328000
   GO GETOUT;                                                           03330000
                                                                        03332000
   ABORT:                                                               03334000
   IF LSEARCH(PROCESSKEY,PMODE,SHARER) THEN LDELETE;                    03336000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03338000
                                                                        03340000
   GETOUT:                                                              03342000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           03344000
   LOADPROGRAM := TOS  <<PARAMETER>>                                    03346000
   END;                                                                 03348000
DOUBLE PROCEDURE LOADER (COMMAND,NUM1,NUM2,STRING,PVINFO);     <<00211>>03350000
   <<LOAD PROCESS COMMUNICATION PROCEDURE.                              03352000
     RETURNS A DOUBLE                                                   03354000
     RESULT:  THE FIRST WORD (S-1) IS A PARAMETER (0 IF ERROR) AND THE  03356000
     SECOND WORD (S-0) IS AN ERROR NUMBER (0 IF NO ERROR)>>             03358000
   VALUE COMMAND,NUM1,NUM2,PVINFO;                             <<00211>>03360000
   INTEGER COMMAND,NUM1,NUM2,PVINFO;                           <<00211>>03362000
   BYTE ARRAY STRING;                                                   03364000
   OPTION INTERNAL,UNCALLABLE;                                          03366000
   BEGIN                                                                03368000
   INTEGER  I, SIRF, TF, TLF, LF;                                       03370000
   INTEGER ARRAY PARMS (*) = COMMAND;                                   03372000
   EQUATE MAILLENGTH = 22;  <<MAIL BUFFER LENGTH>>             <<00211>>03374000
   INTEGER ARRAY MAILBUF (0:71) = Q;  <<MAIL BUFFER>>                   03376000
   INTEGER ARRAY LIST(*) = MAILBUF;                                     03378000
   BYTE ARRAY LISTB(*) = LIST;                                          03380000
                                                                        03382000
   SUBROUTINE  FERROR(F,D);                                             03384000
      VALUE F,D; INTEGER F; LOGICAL D;                                  03386000
   BEGIN  << CALLED ON A FILE ERROR >>                                  03388000
   MOVE  LIST := "FILE ERROR #     ON ";                                03390000
   IF F=0 OR F=LF THEN MOVE LIST(10) := "LOADLIST" ELSE                 03392000
   IF  F=TLF  THEN  MOVE  LIST(10) := "LOADTEMP" ELSE                   03394000
   MOVE  LIST(10) := "LOADPROC";                                        03396000
   FCHECK(F,I);                                                         03398000
   ASCII(I,10,LISTB(12));                                               03400000
   PRINT(LIST,-28,0);                                                   03402000
   IF D THEN                                                            03404000
   BEGIN << CLOSE LOADER PROCESS FILE AND RELSIR >>                     03406000
      FCLOSE(TF,0,0);                                                   03408000
      RELSIR(LOADSIR,SIRF);                                             03410000
   END ELSE FCLOSE(LF,0,0); << CLOSE LIST FILE >>                       03412000
   GO DONE;                                                             03414000
   END;                                                                 03416000
                                                                        03418000
                                                                        03420000
                                                                        03422000
   TF := TLF := LF := -1; << NULL FILE NUMS >>                          03424000
   SIRF := GETSIR(LOADSIR);                                             03426000
                                                                        03428000
   <<* * * INITIALIZE MAIL DATA SEGMENT * * *>>                         03430000
                                                                        03432000
   MOVE MAILBUF := PARMS,(3);  <<COMMAND AND PARM'S>>                   03434000
   IF LOGICAL(COMMAND.(1:1)) THEN FORMATNAME(MAILBUF(3),STRING);        03436000
   WHO( ,MAILBUF(11),,,MAILBUF(13),MAILBUF(17) );                       03438000
   MAILBUF(11) := ABSOLUTE(CPCB)-ABSOLUTE(PCBB);                        03440000
   MAILBUF (21) := PVINFO;                                     <<00211>>03442000
   FOR I := 0 UNTIL MAILLENGTH-1  DO                                    03444000
      ABSOLUTE(LCT+I) := MAILBUF(I);                                    03446000
                                                                        03448000
CLEARWWS;                                                      <<04861>>03450000
AWAKE ( SYSPROC(8), %20, -16 );                                <<04861>>03452000
                                                                        03454000
                                                                        03456000
   <<* * * EXTRACT ANSWER OF LOAD PROCESS * * *>>                       03458000
                                                                        03460000
   TOS := ABSOLUTE(LCT);                                                03462000
   TOS := ABSOLUTE(XREG:=XREG+1);                                       03464000
   IF <> THEN  <<ERROR?>>                                               03466000
      BEGIN                                                             03468000
      ASSEMBLE(STBX);  <<PARAMETER>>                                    03470000
      IF <> THEN ERRORPUT(XREG,1);  <<FILE SYS. ERROR?>>                03472000
      ASSEMBLE(ZERO,XCH)  <<ZERO PARAMETER>>                            03474000
      END;                                                              03476000
   LOADER := TOS;  <<RETURN RESULT>>                                    03478000
   IF  ABSOLUTE(LCT+2)  THEN                                            03480000
      BEGIN  << COPY THE FILE FROM THE LOAD PROCESS >>                  03482000
      TOS := 0;                                                         03484000
      TOS := ABSOLUTE(XREG:=XREG+1);  << LDEV >>                        03486000
      TOS := ABSOLUTE(XREG:=XREG+1);  << ADDR >>                        03488000
      TOS := ABSOLUTE(XREG:=XREG+1);                                    03490000
      TF := FOPENDA(*,*);                                               03492000
      IF  <>  THEN  FERROR(TF,TRUE);                                    03494000
      MOVE LIST := "LOADTEMP ";                                         03496000
      TLF := FOPEN(LIST,%2104,4,36); << OPEN TEMP HOLDING FILE >>       03498000
      IF <> THEN FERROR(TLF,TRUE);                                      03500000
      I := FREAD(TF,LIST,-72);                                          03502000
      IF < THEN FERROR(TF,TRUE);                                        03504000
      WHILE = DO                                                        03506000
      BEGIN << COPY LOADLIST FILE TO TEMP. HOLDING FILE >>              03508000
         FWRITE(TLF,LIST,-I,0);                                         03510000
         IF <> THEN FERROR(TLF,TRUE);                                   03512000
         I := FREAD(TF,LIST,-72);                                       03514000
         IF < THEN FERROR(TF,TRUE);                                     03516000
      END;                                                              03518000
      FCLOSEDA (TF,0,0); <<CLOSE LOADER PRODUCED FILE>>        <<RV.PV>>03520000
      RELSIR(LOADSIR,SIRF);                                             03522000
      FCONTROL(TLF,5,0); << REWIND TEMP FILE >>                         03524000
      IF <> THEN FERROR(TLF,FALSE);                                     03526000
      MOVE  LIST := "LOADLIST  ";                                       03528000
      LF := FOPEN(LIST,%14,%301);                                       03530000
      IF  <>  THEN  FERROR(LF,FALSE);                                   03532000
      I := FREAD(TLF,LIST,-72);                                         03534000
      IF < THEN FERROR(TLF,FALSE);                                      03536000
      WHILE = DO                                                        03538000
      BEGIN  << COPY A LINE >>                                          03540000
         FWRITE(LF,LIST,-I,0);                                          03542000
         IF <> THEN FERROR(LF,FALSE);                                   03544000
         I := FREAD(TLF,LIST,-72);                                      03546000
         IF  <  THEN  FERROR(TLF,FALSE);                                03548000
      END;                                                              03550000
      FCLOSE(LF,0,0);                                                   03552000
DONE:                                                                   03554000
      FCLOSE(TLF,0,0);                                                  03556000
      END ELSE RELSIR(LOADSIR,SIRF);                                    03558000
   END;                                                                 03560000
PROCEDURE ADJREFCOUNTS (AMOUNT);                                        03562000
   <<ADJUSTS THE REFERENCE COUNTS FOR THE CST ENTRIES IN THE CURRENT    03564000
     ENTRY BY THE SPECIFIED AMOUNT.  WILL UNLOAD ANY REFERENCED SEGMENT 03566000
     IF IT'S REFERENCE COUNT GOES TO ZERO AND WILL DELETE THE CURRENT   03568000
     ENTRY IF ITS A PROGRAM FILE ENTRY AND ANY IF IT'S REFERENCED       03570000
     SEGMENTS IS UNLOADED>>                                             03572000
   VALUE AMOUNT;                                                        03574000
   INTEGER AMOUNT;                                                      03576000
   OPTION UNCALLABLE;                                                   03578000
   BEGIN                                                                03580000
   INTEGER AMOUNT' = SI;  <<REFERENCE COUNT INCREMENT>>                 03582000
   LOGICAL SLSEG'LOG'UNLD = ST; <<LOGICAL UNLOAD OF SL SEG>>   <<00776>>03584000
   LOGICAL DELETEFLAG := FALSE;  << DELETE PROGRAM ENTRY? >>            03586000
   INTEGER PVINFO := 0;                                        <<00776>>03588000
   INTEGER SEGTYPE' = SK;  <<SEGMENT TYPE NR.>>                         03590000
   INTEGER POINTER SLSEGS = SO;  <<SL CST BIT MAP>>                     03592000
                                                                        03594000
   SUBROUTINE DISMOUNTVS;                                      <<00776>>03596000
       BEGIN                                                   <<00776>>03598000
           TOS := EXCHANGEDB (0); <<TO STACK>>                 <<00776>>03600000
           DISMOUNTVOLSET (PVINFO);                            <<00776>>03602000
           ASMB (ZERO, XCH);                                   <<00776>>03604000
           EXCHANGEDB (*);                                     <<00776>>03606000
           PVINFO := 0;                                        <<00776>>03608000
       END;                                                    <<00776>>03610000
                                                               <<00776>>03612000
   SUBROUTINE UNLOADFILE;                                               03614000
      <<CLEARS THE "LOADED" BIT IN THE FILE LABEL OF THE         RV.PV  03616000
        CURRENT ENTRY, AND DELETES THE CURRENT ENTRY>>         <<00776>>03618000
      BEGIN                                                             03620000
      TOS := EFID1; TOS := EFID2;  <<FILE KEY>>                         03622000
      LOADBIT(*,FALSE,SEGTABDST);  <<CLEAR LOADED BIT>>                 03624000
      LDELETE  <<DELETE ENTRY>>                                         03626000
      END;                                                              03628000
                                                                        03630000
   IF  ETYPE = PROGFILE  THEN                                           03632000
      BEGIN                                                             03634000
      ESHR := (TOS := ESHR)+AMOUNT;                                     03636000
      TOS := ESHR;     << UPDATE COUNT IN CST BLOCK TOO >>              03638000
      ASSEMBLE( SED 0 );                                                03640000
      XREG := CSTEXT(ECST)+ABSOLUTE(DSTB)+2;                            03642000
      ABSOLUTE(XREG) := TOS;                                            03644000
      ASSEMBLE( SED 1 );                                                03646000
      IF  EPA = 1  OR  TOS*ESHR <> 0  THEN                     <<00776>>03648000
      BEGIN                                                    <<00776>>03650000
         IF AMOUNT < 0 <<UNLOAD>>  AND                         <<00776>>03652000
          (PVINFO := EPVINFO'PROG) <> 0 THEN DISMOUNTVS;       <<00776>>03654000
          RETURN;                                              <<00776>>03656000
      END;                                                     <<00776>>03658000
      IF  ESHR = 0  THEN  DELETEFLAG := TRUE;                           03660000
      END;                                                              03662000
                                                                        03664000
   AMOUNT' := AMOUNT;                                                   03666000
   SEGTYPE' := 2;                                                       03668000
   DO BEGIN                                                             03670000
      @SLSEGS := 0;  <<INIT. SEGMENT BIT MAP POINTER>>                  03672000
      SLSEG'LOG'UNLD := FALSE;                                 <<00776>>03674000
      LSTEP(ADJSEG);                                                    03676000
      IF SLSEG'LOG'UNLD THEN <<LOGICAL UNLOAD OF SEGMENT?>>    <<00776>>03678000
         BEGIN                                                          03680000
         TOS := 0;                                                      03682000
         XREG := 11;                                                    03684000
         DO BEGIN                                                       03686000
            TOS := TOS LOR LOGICAL(SLSEGS(XREG));                       03688000
            XREG := XREG-1                                              03690000
            END UNTIL <;                                                03692000
         TOS := @ENTP; <<SAVE INCOMING ENTRY POINTER>>         <<00776>>03694000
         @ENTP := @SLSEGS-4; <<SL ENTRY POINTER>>              <<00776>>03696000
         PVINFO := EPVINFO'SL;                                 <<00776>>03698000
         ASMB (XCH); <<CST BITMAP WORD ON TOP>>                <<00776>>03700000
         IF TOS = 0 THEN <<DELETE SL ENTRY?>> UNLOADFILE;      <<00776>>03702000
         @ENTP := TOS; <<RESTORE INCOMING ENTRY POINTER>>      <<00776>>03704000
         IF PVINFO <> 0 THEN DISMOUNTVS;                       <<00776>>03706000
         END;                                                           03708000
      SEGTYPE' := SEGTYPE'-1                                            03710000
      END UNTIL <;                                                      03712000
   IF  ETYPE = PROGFILE AND AMOUNT < 0 <<UNLOAD>> THEN         <<00776>>03714000
    PVINFO := EPVINFO'PROG;                                    <<00776>>03716000
   IF  DELETEFLAG  THEN    << UNLOAD PROGRAM FILE? >>                   03718000
      BEGIN                                                             03720000
      DEALCSTBLOCK( ECST );                                             03722000
      UNLOADFILE;                                                       03724000
      END;                                                              03726000
   IF PVINFO <> 0 THEN DISMOUNTVS;                             <<00776>>03728000
   END;                                                                 03730000
PROCEDURE ADJSEG (CSTNR);                                               03732000
   <<SUPPORT PROCEDURE FOR ADJREFCOUNTS PROCEDURE>>                     03734000
   VALUE CSTNR;                                                         03736000
   INTEGER CSTNR;                                                       03738000
   OPTION INTERNAL,UNCALLABLE;                                          03740000
   BEGIN                                                                03742000
   INTEGER AMOUNT = SI;  <<REFERENCE COUNT INCREMENT>>                  03744000
   INTEGER SEGTYPE' = SK;  <<SEGMENT TYPE NR.>>                         03746000
   LOGICAL SLSEG'LOG'UNLD = ST; <<LOGICAL UNLOAD OF SL SEG>>   <<00776>>03748000
   INTEGER POINTER SLSEGS = SO;  <<SL CST BIT MAP>>                     03750000
   XREG := CSTNR;                                                       03752000
   IF SEGTYPE = SEGTYPE' THEN  <<CORRECT SEGMENT TYPE?>>       <<00776>>03754000
   BEGIN                                                       <<00776>>03756000
       REFCOUNT (XREG) := REFCOUNT (XREG)+AMOUNT;              <<00776>>03758000
       IF SLSEG THEN                                           <<00776>>03760000
       BEGIN                                                   <<00776>>03762000
           IF @SLSEGS = 0 THEN @SLSEGS := @DIR+ENTTAB (XREG)+4;<<00776>>03764000
           SLSEG'LOG'UNLD := (AMOUNT < 0);                     <<00776>>03766000
       END;                                                    <<00776>>03768000
       IF REFCOUNT (CSTNR) = 0 THEN <<LAST REFERENCE?>>        <<00776>>03770000
       BEGIN                                                   <<00776>>03772000
           REFCOUNT (XREG) := -1; <<MARK UNREFERENCED>>        <<00776>>03774000
           RELCODESEG (XREG);                                  <<00776>>03776000
           IF SLSEG THEN CLEARBIT (SLSEGS,XREG); <<CST BIT>>   <<00776>>03778000
       END;                                                    <<00776>>03780000
   END;                                                        <<00776>>03782000
   END;                                                                 03784000
PROCEDURE LOADBIT (KEY,BIT,DSTNR);                                      03786000
   <<SETS OR CLEARS (DEPENDING ON THE VALUE OF BIT) THE "LOADED" BIT    03788000
     IN THE FILE LABEL FOR THE FILE OF THE SPECIFIED KEY.  DB MAY BE    03790000
     SET TO THE STACK OR THE SEGMENT TABLE.  NOTE THAT THIS PROCEDURE   03792000
     USES THE CONDITION CODE TO INDICATE AN ERROR>>                     03794000
   VALUE KEY,BIT,DSTNR;                                                 03796000
   DOUBLE KEY;                                                          03798000
   LOGICAL BIT;                                                         03800000
   INTEGER DSTNR;                                                       03802000
   OPTION UNCALLABLE;                                                   03804000
   BEGIN                                                                03806000
   BYTE LOGICALDEVICE = KEY;  <<LOGICAL DEVICE NR.>>                    03808000
   INTEGER                                                              03810000
       SAVESIR;    << SIR VALUE >>                                      03812000
   INTEGER POINTER                                                      03814000
       FLABEL;     << FILE LABEL BUFFER >>                              03816000
   SUBROUTINE READWRITE (CODE);                                         03818000
      <<READS OR WRITES (DEPENDING ON THE VALUE OF CODE) THE FILE       03820000
        LABEL>>                                                         03822000
      VALUE CODE;                                                       03824000
      INTEGER CODE;                                                     03826000
      BEGIN                                                             03828000
          TOS := 0D; << FOR FLABIO RETURN AND LDEV # >>                 03830000
          TOS := KEY&TASL(8)&DLSR(8); << SEP. LDEV AND DISC ADRESS >>   03832000
          TOS := S5; << READ/WRITE CODE >>                              03834000
          TOS := @FLABEL;                                               03836000
          TOS := FLABIO(*,*,*,*);                                       03838000
          IF TOS <> 0 THEN GO NFG;                                      03840000
      END;                                                              03842000
                                                                        03844000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           03846000
                                                                        03848000
   SAVESIR := GETSIR(FILESYSSIR);                                       03850000
   IF DSTNR <> 0 THEN DSTNR := EXCHANGEDB(0); << DB TO STACK >>         03852000
   PUSH(S); << SET FLABEL >>                                            03854000
   @FLABEL := TOS + 1;                                                  03856000
   ASSEMBLE(ADDS 128); << ALLOCATE BUFFER >>                            03858000
                                                                        03860000
   READWRITE(ATTIOREAD);  <<READ FILE LABEL>>                           03862000
   FLOADBIT := BIT;  <<CLEAR/SET "LOADED" BIT>>                         03864000
   READWRITE(ATTIOWRITE);  <<WRITE FILE LABEL>>                         03866000
   TOS := CCE;  <<OK CONDITION CODE>>                                   03868000
   GO GETOUT;                                                           03870000
                                                                        03872000
   NFG:                                                                 03874000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                03876000
                                                                        03878000
   GETOUT:                                                              03880000
   IF DSTNR <> 0 THEN EXCHANGEDB(DSTNR);                                03882000
   RELSIR(FILESYSSIR,SAVESIR);  <<RELEASE FILE SYSTEM SIR>>             03884000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            03886000
   END;                                                                 03888000
PROCEDURE UNLOAD (PIN);                                                 03890000
   <<UNLOADS THE SEGMENTS OF THE SPECIFIED PROCESS (IF NECESSARY).      03892000
     CONDITION CODE CONVENTIONS:                                        03894000
                                                                        03896000
         CCE   REQUEST GRANTED                                          03898000
         CCL   REQUEST DENIED - INVALID PIN                             03900000
                                                                        03902000
     NOTE THAT IT IS ASSUMED THAT DB IS SET TO THE STACK OF THE PROCESS 03904000
     BEING UNLOADED>>                                                   03906000
   VALUE PIN;                                                           03908000
   INTEGER PIN;                                                         03910000
   OPTION PRIVILEGED,UNCALLABLE;                                        03912000
   BEGIN                                                                03914000
   INTEGER NRPROGSEGS = SP;  <<NR. PROG. FILE SEG'S>>                   03916000
   INTEGER NRSLSEGS = SQ;  <<NR. SYS. (NON-MPE) SL SEG'S>>              03918000
   DOUBLE NRSEGS = NRPROGSEGS;                                          03920000
   INTEGER POINTER PCBXFIXEDP = Q+1;                                    03922000
   INTEGER LASTPROCNR = Q+2;                                            03924000
   LOGICAL LOGGING = Q+3;  <<LOGGING ENABLED?>>                         03926000
   INTEGER SAVESIR = Q+4;                                               03928000
                                                                        03930000
   <<* * * INITIALIZE VARIABLES * * *>>                                 03932000
                                                                        03934000
   PCBXP;  <<POINTER TO PCBX FIXED AREA>>                               03936000
   TOS := PS0(22).(8:8);  <<LAST PROC. NR.>>                            03938000
   TOS := 0;  <<FOR LOGGING FLAG>>                                      03940000
   XREG := ABSOLUTE(LOGFLAG);  << LOGGING FLAGS >>                      03942000
   TOS := %(2)10001; ASSEMBLE(DUP,LDXA; AND,CMP);                       03944000
   IF = THEN TOS := TOS+1;  <<LOGGING ON?>>                             03946000
   TOS := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                 03948000
                                                                        03950000
   <<* * * UNLOAD ORIGINAL PROCESS SEGMENTS * * *>>                     03952000
                                                                        03954000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  03956000
   NRSEGS:=0D; <<INITIALIZE LOGGING INFO>>                     <<00541>>03958000
   IF NOT LSEARCH(DOUBLE(LOGICAL(PIN)),ANYMODE,SHARER) THEN    <<01.02>>03960000
      GO UNLOADDYN;                                            <<01.02>>03962000
   TOS := 0;  <<FOR RESULT OF LSEARCH>>                                 03964000
   TOS := ENTDP1;  <<SAVE PROG. FILE KEY>>                              03966000
   TOS := EPMODE;  <<SAVE PROG. MODE>>                                  03968000
   LDELETE;  <<DELETE SHARER ENTRY>>                                    03970000
   IF LSEARCH(*,*,PROGFILE) THEN  <<FOUND PROG. FILE ENTRY>>   <<00541>>03972000
     BEGIN                                                     <<00541>>03974000
       IF LOGGING THEN  <<LOGGING ON?>>                        <<00541>>03976000
          BEGIN                                                <<00541>>03978000
            NRPROGSEGS := ESEG;                                <<00541>>03980000
            LSTEP(SUMSEGS)  <<GET PROG. FILE SEG. TOTALS>>     <<00541>>03982000
          END;                                                 <<00541>>03984000
       ADJREFCOUNTS(-1);  <<DECREMENT REF. COUNTS>>            <<00541>>03986000
     END;                                                      <<00541>>03988000
                                                                        03990000
   <<* * * UNLOAD DYNAMICALLY LOADED PROCEDURES * * *>>                 03992000
UNLOADDYN:                                                     <<01.02>>03994000
                                                                        03996000
   TOS := LASTPROCNR;  <<LAST PROC. NR.>>                               03998000
   WHILE > DO  <<UNLOAD PROCEDURES>>                                    04000000
      BEGIN                                                             04002000
      TOS := 0;  <<FOR RESULT OF LSEARCH>>                              04004000
      TOS := 0;  <<FIRST HALF OF KEY>>                                  04006000
      TOS := PIN CAT S2 (0:8:8);  <<SECOND HALF OF KEY>>                04008000
      IF LSEARCH(*,ANYMODE,EXTENSION) THEN                              04010000
         BEGIN                                                          04012000
         IF LOGGING THEN LSTEP(SUMSEGS);  <<GET LOADPROC SEG. TOTALS>>  04014000
         ADJREFCOUNTS(-1);  <<DECREMENT REF. COUNTS>>                   04016000
         LDELETE  <<DELETE EXT. ENTRY>>                                 04018000
         END;                                                           04020000
      TOS := TOS-1  <<NEXT EXT. NR.>>                                   04022000
      END;                                                              04024000
   TOS := NRSEGS;  <<SEG. TOTALS>>                                      04026000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04028000
   GO GETOUT;                                                           04030000
                                                                        04032000
   ABORT:                                                               04034000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04036000
                                                                        04038000
   GETOUT:                                                              04040000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                04042000
   RELSIR(SEGTABSIR,SAVESIR);                                           04044000
   IF LOGGING AND S0 = CCE THEN  <<EMIT LOG RECORD?>>                   04046000
      BEGIN                                                             04048000
      ASSEMBLE(CAB,CAB);                                                04050000
      LOG4(*,*,PCBXFIXEDP(23),PCBXFIXEDP(26),PCBXFIXEDP(27),4);<<00167>>04052000
      END;                                                              04054000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            04056000
   END;                                                                 04058000
PROCEDURE SUMSEGS (CSTNR);                                              04060000
   <<SUPPORT PROCEDURE FOR UNLOAD>>                                     04062000
   VALUE CSTNR;                                                         04064000
   INTEGER CSTNR;                                                       04066000
   OPTION INTERNAL,UNCALLABLE;                                          04068000
   BEGIN                                                                04070000
   INTEGER NRSLSEGS = SQ;  <<NR. SYS. (NON-MPE) SL SEG'S>>              04072000
   XREG := CSTNR;                                                       04074000
   IF NOT SYSTEMSEG THEN  <<NON-MPE SL FILE SEG.?>>                     04076000
      NRSLSEGS := NRSLSEGS+1                                            04078000
   END;                                                                 04080000
INTEGER PROCEDURE FINDFREEEXTNR(PIN);                          <<04494>>04082000
VALUE PIN;                                                     <<04494>>04084000
INTEGER PIN;                                                   <<04494>>04086000
                                                               <<04494>>04088000
<< THIS PROCEDURE SEARCHES LST FOR UNLOADED EXTENSION      >>  <<04494>>04090000
<< NUMBER WHEN CURRENT EXTENSION NUMBER REACHES 255.       >>  <<04494>>04092000
<< UNLOADPROC DECREASES EXTENSION NUMBER ONLY WHEN THIS    >>  <<04494>>04094000
<< EXTENSION NUMBER TO BE UNLOADED IS THE CURRENT HIGHEST  >>  <<04494>>04096000
<< EXTENSION NUMBER.                                       >>  <<04494>>04098000
                                                               <<04494>>04100000
BEGIN                                                          <<04494>>04102000
   ARRAY FREEEXTMAP(*) = SBUF2;                                <<04494>>04104000
   INTEGER INDEX = SS;                                         <<04494>>04106000
   LOGICAL FOUND;                                              <<04494>>04108000
                                                               <<04494>>04110000
   TOS:=SEGTABSIR;                                             <<04494>>04112000
   TOS:=GETSIR(SEGTABSIR);                                     <<04494>>04114000
   EXCHANGEDB(SEGTABDST);                                      <<04494>>04116000
                                                               <<04494>>04118000
   FREEEXTMAP:=0;                                              <<04494>>04120000
   MOVE FREEEXTMAP(1):=FREEEXTMAP,(15);                        <<04494>>04122000
                                                               <<04494>>04124000
   @ENTP:=@DIR;                                                <<04494>>04126000
   DO BEGIN                                                    <<04494>>04128000
      IF ETYPE = EXTENSION AND EPIN = PIN THEN                 <<04494>>04130000
            SETBIT(FREEEXTMAP,EEXT);                           <<04494>>04132000
      @ENTP:=ENTRYLENGTH+@ENTP;                                <<04494>>04134000
   END UNTIL @ENTP = @DIR(DIRLEN);                             <<04494>>04136000
                                                               <<04494>>04138000
   INDEX:=1;                                                   <<04494>>04140000
   FOUND:=FALSE;                                               <<04494>>04142000
   WHILE INDEX < 256 DO                                        <<04494>>04144000
      BEGIN                                                    <<04494>>04146000
         IF NOT TESTBIT(FREEEXTMAP,INDEX) THEN                 <<04494>>04148000
            BEGIN                                              <<04494>>04150000
               FINDFREEEXTNR:=INDEX;                           <<04494>>04152000
               FOUND:=TRUE;                                    <<04494>>04154000
               GO EXIT;                                        <<04494>>04156000
            END;                                               <<04494>>04158000
         INDEX:=INDEX+1;                                       <<04494>>04160000
      END;                                                     <<04494>>04162000
                                                               <<04494>>04164000
EXIT:                                                          <<04494>>04166000
   EXCHANGEDB(0);                                              <<04494>>04168000
   RELSIR(*,*);                                                <<04494>>04170000
   IF FOUND THEN CONDCODE:=CCE                                 <<04494>>04172000
            ELSE CONDCODE:=CCL;                                <<04494>>04174000
END;                                                           <<04494>>04176000
INTEGER PROCEDURE LOADPROC (PROCNAME,LIBSEARCH,PLABEL);                 04178000
   <<LOADS THE SEGMENT CONTAINING THE NAMED PROCEDURE AND ALL THE       04180000
     SEGMENTS CONTAINING THE EXTERNALS OF THE SPECIFIED PROCEDURE.  ANY 04182000
     PROCEDURE IN AN SL (GSL, PSL OR SSL) MAY BE LOADPROC'ED.  LIBSEARCH04184000
     SPECIFIES THE FIRST LIBRARY TO BE SEARCHED FOR THE NAMED PROCEDURE.04186000
     THE P-LABEL (EXTERNAL FORMAT) OF THE NAMED PROCEDURE IS RETURNED   04188000
     SO THAT THE PROCEDURE MAY BE CALLED WITH ASSEMBLE(PCAL 0).  ALSO   04190000
     RETURNED (AS THE RESULT OF THE PROCEDURE) IS A PROCEDURE ID NUMBER 04192000
     (1 <= PROCID <= 255); THIS NUMBER IS USED TO UNLOAD THE NAMED      04194000
     PROCEDURE.  THE PROCEDURE NAME MUST BE FORMATTED SUCH THAT THERE   04196000
     ARE NO LEADING BLANKS AND IT MUST BE TERMINATED WITH A BLANK.      04198000
     CONDITION CODE CONVENTIONS:                                        04200000
                                                                        04202000
         CCE   REQUEST GRANTED                                          04204000
         CCL   REQUEST DENIED                                           04206000
                                                                        04208000
     IF CCL THEN THE PRIMARY ERROR NUMBER IS RETURNED AS THE RESULT     04210000
     OF THE PROCEDURE; THE SECONDARY ERROR NUMBER (FILE SYSTEM ERROR    04212000
     NUMBER), IF ANY, IS IN THE PCBX.  NOTE THAT THIS PROCEDURE MUST    04214000
     BE CALLED WITH DB SET TO THE STACK>>                               04216000
   VALUE LIBSEARCH;                                                     04218000
   BYTE ARRAY PROCNAME;                                                 04220000
   INTEGER LIBSEARCH,PLABEL;                                            04222000
   BEGIN                                                                04224000
   INTEGER EXTENSION = LOADPROC;                                        04226000
                                                                        04228000
   <<* * * CHECK PARAMETERS * * *>>                                     04230000
                                                                        04232000
   ERRORON;                                                             04234000
   CHEK([10/80,6/3],[8/0,2/1,1/0,5/3],[2/2,2/0,2/3]D);                  04236000
   IF NOT (0 <= LIBSEARCH <= 2) THEN  <<VALID LIBSEARCH?>>              04238000
      BEGIN                                                             04240000
      TOS := ERR20; GO NFG                                              04242000
      END;                                                              04244000
                                                                        04246000
   <<* * * UPSHIFT PROCEDURE NAME * * *>>                      <<01065>>04248000
                                                               <<01065>>04250000
   MOVE PROCNAME := PROCNAME WHILE ANS;                        <<01065>>04252000
                                                               <<01065>>04254000
   <<* * * SEND COMMAND TO LOAD PROCESS * * *>>                         04256000
                                                                        04258000
   TOS := 0D;  <<FOR LOADER RESULT>>                                    04260000
   TOS := USERPIN;  <<PIN OF CURRENT USER>>                             04262000
   TOS.(0:2) := 1;  <<LOAD PROCEDURE COMMAND NR.>>                      04264000
   TOS.(2:2) := LIBSEARCH;  <<LIBSEARCH PARAMETER>>                     04266000
   PCBXP;  <<POINTER TO PCBX FIXED AREA>>                               04268000
   TOS := PS0(22);  <<PCBX ENTRY WORD>>                                 04270000
   TOS := S0.(8:8);  <<LAST PROC. NR.>>                                 04272000
   IF S0 = 255 THEN  <<NEXT NUMBER VALID?>>                             04274000
      BEGIN                                                             04276000
         S0:=FINDFREEEXTNR(USERPIN);                           <<04494>>04278000
         IF <> THEN                                            <<04494>>04280000
            BEGIN                                              <<04494>>04282000
               TOS:=ERR40;                                     <<04494>>04284000
               GO NFG;                                         <<04494>>04286000
            END                                                <<04494>>04288000
         ELSE                                                  <<04494>>04290000
            BEGIN                                              <<04494>>04292000
               LOADPROC:=TOS;                                  <<04494>>04294000
               DEL;                                            <<04494>>04296000
               GO TO EXTNRFOUND;                               <<04494>>04298000
            END;                                               <<04494>>04300000
      END;                                                              04302000
   TOS := TOS+1;  <<PROC. EXT. NR.>>                                    04304000
   LOADPROC := S0;  <<RETURN PROCEDURE ID>>                             04306000
   TOS.(8:8) := TOS;  <<UPDATE PCBX ENTRY WORD>>                        04308000
   PS1(XREG) := TOS;  <<UPDATE PCBX>>                                   04310000
EXTNRFOUND:                                                    <<04494>>04312000
   DEL;                                                                 04314000
   TOS := LOADER (*,EXTENSION,0,PROCNAME,0<<DON'T CARE>>);     <<00211>>04316000
   ASSEMBLE(TEST);                                                      04318000
   IF <> THEN GO NFG;  <<ERROR?>>                                       04320000
   DEL;                                                                 04322000
   PLABEL := TOS;  <<ENTRY POINT P-LABEL>>                              04324000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04326000
   GO GETOUT;                                                           04328000
                                                                        04330000
   NFG:                                                                 04332000
   LOADPROC := TOS;  <<ERROR NR.>>                                      04334000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04336000
                                                                        04338000
   GETOUT:                                                              04340000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           04342000
   ERROREXIT( [10/80,6/3],0,0 );                                        04344000
   END;                                                                 04346000
PROCEDURE ADJEXTNR(PROCID);                                    <<04494>>04348000
VALUE PROCID;                                                  <<04494>>04350000
INTEGER PROCID;                                                <<04494>>04352000
                                                               <<04494>>04354000
<< SUPPORT UNLOADPROC PROCEDURE                        >>      <<04494>>04356000
<< THIS PROCEDURE ADJUSTS THE ENTENSION NUMBER IF THE  >>      <<04494>>04358000
<< EXTENSION NUMBER TO BE UNLOADED IS THE CURRENT      >>      <<04494>>04360000
<< EXTENSION NUMBER RECORDED IN PXFIX(22).(8:8)        >>      <<04494>>04362000
                                                               <<04494>>04364000
BEGIN                                                          <<04494>>04366000
   PCBXP;                                                      <<04494>>04368000
   TOS:=PS0(22);                                               <<04494>>04370000
   IF S0.(8:8) = PROCID THEN                                   <<04494>>04372000
      PS1(22) := TOS.(8:8) - 1;                                <<04494>>04374000
END;                                                           <<04494>>04376000
PROCEDURE UNLOADPROC (PROCID);                                          04378000
   <<UNLOADS THE SEGMENT CONTAINING THE PROCEDURE SPECIFIED BY THE      04380000
     PROCEDURE ID NUMBER (PROCID) AND ALL THE SEGMENTS CONTAINING THE   04382000
     EXTERNALS OF THE SEGMENT.  CONDITION CODE CONVENTIONS:             04384000
                                                                        04386000
         CCE   REQUEST GRANTED                                          04388000
         CCL   REQUEST DENIED - INVALID PROCID                          04390000
                                                                        04392000
     NOTE THAT THIS PROCEDURE MUST BE CALLED WITH DB SET TO THE STACK>> 04394000
   VALUE PROCID;                                                        04396000
   INTEGER PROCID;                                                      04398000
   BEGIN                                                                04400000
   DOUBLE KEY := 0D;                                                    04402000
   INTEGER KEY2 = KEY+1;                                                04404000
   BYTE EXT = KEY+1;                                                    04406000
                                                                        04408000
   <<* * * CHECK PARAMETERS * * *>>                                     04410000
                                                                        04412000
   ERRORON;                                                             04414000
   CHEK([10/81,6/1],[8/0,2/0,1/0,5/1]);                                 04416000
   IF NOT (1 <= PROCID <= 255) THEN GO NFG;  <<VALID ID?>>              04418000
                                                                        04420000
   <<* * * UNLOAD PROCEDURE(S) * * *>>                                  04422000
                                                                        04424000
   KEY2 := USERPIN CAT PROCID (0:8:8);                                  04426000
   TOS := SEGTABSIR;                                                    04428000
   TOS := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                 04430000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  04432000
   IF NOT LSEARCH(KEY,ANYMODE,EXTENSION) THEN GO ABORT;  <<VALID ID?>>  04434000
   ADJREFCOUNTS(-1);  <<DECREMENT REFERENCE COUNTS>>                    04436000
   LDELETE;  <<DELETE EXTENSION ENTRY>>                                 04438000
   EXCHANGEDB(0);  <<SET DB TO STACK>>                                  04440000
   RELSIR(*,*);  <<RELEASE SEGMENT TABLE SIR>>                          04442000
   ADJEXTNR(PROCID);                                           <<04494>>04444000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04446000
   GO GETOUT;                                                           04448000
                                                                        04450000
   ABORT:                                                               04452000
   EXCHANGEDB(0);  <<SET DB TO STACK>>                                  04454000
   RELSIR(*,*);  <<RELEASE SEGMENT TABLE SIR>>                          04456000
                                                                        04458000
   NFG:                                                                 04460000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04462000
                                                                        04464000
   GETOUT:                                                              04466000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           04468000
   ERROREXIT( [10/81,6/1],0,0 );                                        04470000
   END;                                                                 04472000
INTEGER PROCEDURE ALLOCATEPROG (PROGFNAME);                             04474000
   <<ALLOCATES OR DEALLOCATES (DEPENDING ON THE ENTRY POINT USED) THE   04476000
     SPECIFIED PROGRAM FILE. THE ONLY PROGRAMS THAT MAY BE       RV.PV  04478000
     ALLOCATED IN THIS FASHION ARE THOSE IN PUB.SYS. ONLY        RV.PV  04480000
     PROGRAMS IN THE SYSTEM DOMAIN MAY BE ALLOCATED.             RV.PV  04482000
     THE PROGAM NAME MUST BE FORMATTED SUCH THAT THERE ARE NO    RV.PV  04484000
     LEADING BLANKS AND IT MUST BE TERMINATED WITH A SPECIAL.    RV.PV  04486000
                                                                 RV.PV  04488000
     CONDITION CODE CONVENTIONS:                                 RV.PV  04490000
                                                                 RV.PV  04492000
         CCE   REQUEST GRANTED                                          04494000
         CCL   REQUEST DENIED                                           04496000
                                                                        04498000
     IF CCL THEN THE PRIMARY ERROR NUMBER IS RETURNED AS THE RESULT OF  04500000
     THE PROCEDURE; THE SECONDARY ERROR NUMBER (FILE SYSTEM ERROR       04502000
     NUMBER), IF ANY, IS IN THE PCBX.  NOTE THAT THIS PROCEDURE MUST BE 04504000
     CALLED WITH DB SET TO THE STACK>>                                  04506000
   BYTE ARRAY PROGFNAME;                                                04508000
   OPTION UNCALLABLE;                                                   04510000
   BEGIN                                                                04512000
   ENTRY DEALLOCATEPROG;                                                04514000
   LOGICAL FLAG:=FALSE;   <<ALLOCATE/DEALLOCATE FLAG>>         <<04681>>04518000
   INTEGER PROGFNUM;                                           <<04681>>04520000
   DOUBLE PROGKEY;                                             <<04681>>04522000
   INTEGER SAVESIR;                                            <<04681>>04524000
   INTEGER ARRAY PROGREC0(0:19)=Q;                             <<04681>>04526000
   DEFINE SAEXTLIST = PROGREC0(13)#;                           <<04681>>04528000
                                                               <<04681>>04530000
   FLAG:=TRUE;                                                 <<04681>>04532000
                                                               <<04681>>04534000
DEALLOCATEPROG:                                                <<04681>>04536000
   GO INITIALIZE;                                                       04538000
   DEALLOCATEPROG:                                                      04540000
   TOS := FALSE;  <<DEALLOCATE>>                                        04542000
                                                                        04544000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           04546000
                                                                        04548000
   INITIALIZE:                                                          04550000
   TOS := 0;                                                            04552000
   TOS := 0D;                                                           04554000
   TOS := -1;                                                           04556000
                                                                        04558000
   <<* * * OPEN PROGRAM FILE * * *>>                                    04560000
                                                                        04562000
   PROGFNUM:=DFOPEN(PROGFNAME,%(2)10000000011,%(2)111110111);  <<01191>>04564000
   IF < THEN  <<ERROR?>>                                                04566000
      BEGIN                                                             04568000
      TOS := ERR53; GO ABORT                                            04570000
      END;                                                              04572000
   FREADDIR(PROGFNUM,PROGREC0,20,0D);                          <<04681>>04574000
   ASSEMBLE (ADDS 7);                                          <<04816>>04576000
   FGETINFO(PROGFNUM,,S0,,,,S1,,S4,,,,,,,S5,,S6,,DS3);         <<04816>>04578000
   IF TOS.(14:2)=2 THEN   <<TEMPORARY FILE>>                   <<04816>>04580000
      BEGIN                                                    <<04816>>04582000
      TOS := ERR46;  GO ABORT                                  <<04816>>04584000
      END;                                                     <<04816>>04586000
   BS2 := TOS;  <<LOGICAL DEVICE NR.>>                                  04588000
   PROGKEY := TOS;  <<PROG. KEY>>                                       04590000
   IF TOS <> PROGFILECODE THEN  <<TYPE PROGRAM?>>              <<00672>>04592000
      BEGIN                                                    <<00672>>04594000
      TOS := ERR31; GO ABORT                                   <<00672>>04596000
      END;                                                     <<00672>>04598000
S1 := S1+1+SAEXTLIST;<<EXT. S.A.+#FILELABEL+#USERLABEL>>       <<04681>>04600000
IF TOS > TOS THEN   <<CODE NOT IN 1ST EXTENT>>                 <<04493>>04602000
      BEGIN                                                    <<00672>>04604000
      TOS := ERR34; GO ABORT                                   <<00672>>04606000
      END;                                                     <<00672>>04608000
   TOS := FGETPVINFO (PROGFNUM);                               <<00672>>04610000
   FCLOSE(PROGFNUM,0,0);                                                04612000
   IF TOS <> 0 THEN                                            <<00211>>04614000
   BEGIN <<ATTEMPTING TO ALLOCATE FROM NON-SYSEM DOMAIN>>      <<00211>>04616000
       TOS := ERR92;  GO ABORT;                                <<00211>>04618000
   END;                                                        <<00211>>04620000
   SAVESIR := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>             04622000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  04624000
                                                                        04626000
   <<* * * ALLOCATE/DEALLOCATE PROGRAM * * *>>                          04628000
                                                                        04630000
   IF FLAG THEN  <<ALLOCATE?>>                                          04632000
      BEGIN                                                             04634000
      TOS:=LOADPROGRAM (0,PROGKEY,0D,%100000,SAVESIR,0);     <<RV.PV>>  04636000
      IF < THEN GO ABORT;  <<ERROR?>>                                   04638000
      LSEARCH(PROGKEY,NORMAL,PROGFILE);  <<FIND PROG. ENTRY>>           04640000
      IF EPA = 1 THEN  <<ERROR?>>                                       04642000
         BEGIN                                                          04644000
         TOS := ERR80;                                                  04646000
         ADJREFCOUNTS(-1);                                              04648000
         GO ABORT                                                       04650000
         END;                                                           04652000
      EPA := 1;                                                         04654000
      END                                                               04656000
   ELSE  <<DEALLOCATE>>                                                 04658000
      BEGIN                                                             04660000
      IF NOT LSEARCH(PROGKEY,NORMAL,PROGFILE) OR EPA = 0 THEN           04662000
         BEGIN                                                          04664000
         TOS := ERR82; GO ABORT                                         04666000
         END;                                                           04668000
      EPA := 0;                                                         04670000
      ADJREFCOUNTS(-1)                                                  04672000
      END;                                                              04674000
   TOS := CCE;  <<OK CONDITION CODE>>                                   04676000
   GO GETOUT;                                                           04678000
   HELP;   << DUMMY CALL TO ESTABLISH LINKING >>                        04680000
                                                                        04682000
   ABORT:                                                               04684000
   ALLOCATEPROG := TOS;  <<ERROR NR.>>                                  04686000
   IF PROGFNUM <> 0 THEN FCLOSE(PROGFNUM,0,0);                 <<02824>>04688000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                04690000
                                                                        04692000
   GETOUT:                                                              04694000
   EXCHANGEDB(0);  <<SET DB TO STACK>>                                  04696000
   IF SAVESIR <> -1 THEN RELSIR(SEGTABSIR,SAVESIR);  <<RELEASE SIR>>    04698000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            04700000
   END;                                                                 04702000
INTEGER PROCEDURE ALLOCATEPROC (PROCNAME);                              04704000
   <<ALLOCATES THE SEGMENT CONTAINING THE NAMED PROCEDURE AND ALL       04706000
     THE SEGMENTS CONTAINING THE EXTERNALS OF THE SPECIFIED             04708000
     PROCEDURE.  THE ONLY PROCEDURES THAT MAY BE ALLOCATED IN THIS      04710000
     FASHION ARE THOSE IN THE SYSTEM SL.  THE PROCEDURE NAME MUST       04712000
     FORMATTED SUCH THAT THERE ARE NO LEADING BLANKS AND IT MUST        04714000
     BE TERMINATED WITH A BLANK OR CR.  CONDITION CODE CONVENTIONS:     04716000
                                                                        04718000
         CCE   REQUEST GRANTED                                          04720000
         CCL   REQUEST DENIED                                           04722000
                                                                        04724000
     IF CCL THEN THE PRIMARY ERROR NUMBER IS RETURNED AS THE RESULT     04726000
     OF THE PROCEDURE; THE SECONDARY ERROR NUMBER (FILE SYSTEM ERROR    04728000
     NUMBER), IF ANY, IS IN THE PCBX.  NOTE THAT THIS PROCEDURE         04730000
     MUST BE CALLED WITH DB SET TO THE STACK>>                          04732000
   BYTE ARRAY PROCNAME;                                                 04734000
   OPTION UNCALLABLE;                                                   04736000
   BEGIN                                                                04738000
                                                                        04740000
   <<* * * SEND COMMAND TO LOAD PROCESS * * *>>                         04742000
                                                                        04744000
   TOS := 0D;  <<FOR RESULT OF LOADER>>                                 04746000
   TOS := 0;                                                            04748000
   TOS.(0:2) := 3;  <<ALLOCATE PROCEDURE COMMAND>>                      04750000
   TOS := LOADER (*,0,0,PROCNAME,0<<DON'T CARE>>);             <<00211>>04752000
   CONDCODE := IF S0 = 0 THEN CCE ELSE CCL;  <<SET CONDITION CODE>>     04754000
   ALLOCATEPROC := TOS  <<ERROR. NR. OR GARBAGE>>                       04756000
   END;                                                                 04758000
INTEGER PROCEDURE DEALLOCATEPROC (PROCNAME);                            04760000
   <<DEALLOCATES THE SEGMENT CONTAINING THE NAMED PROCEDURE AND ALL     04762000
     THE SEGMENTS CONTAINING THE EXTERNALS OF THE SPECIFIED             04764000
     PROCEDURE.  SEE DESCRIPTION OF ALLOCATEPROC FOR FURTHER            04766000
     DETAILS>>                                                          04768000
   BYTE ARRAY PROCNAME;                                                 04770000
   OPTION UNCALLABLE;                                                   04772000
   BEGIN                                                                04774000
   EQUATE SLFHI = 33;  <<FIRST HASH LIST INDEX>>                        04776000
   INTEGER AMOUNT = SI;  <<REF. COUNT INCREMENT>>                       04778000
   INTEGER SEGTYPE' = SK;  <<SEG. TYPE NR.>>                            04780000
   INTEGER SLSEGS = SO;  <<SL CST BIT MAP>>                             04782000
   INTEGER CSTCOUNTER = Q+1;  <<LOOP COUNTER>>                          04784000
   INTEGER SAVESIR = Q+2;                                               04786000
   INTEGER SSLFNUM = Q+3;  <<SYS. SL FILE NR.>>                         04788000
   DOUBLE DRTRECD = Q+4;  <<REF. TABLE REC. NR.>>              <<00712>>04790000
   INTEGER RTRECD = DRTRECD+1;  <<SAME>>                       <<00712>>04792000
   INTEGER ARRAY SLREC0 (@) = Q+6;  <<RECORD 0>>               <<00712>>04794000
   INTEGER ARRAY SLREC1 (@) = Q+7;  <<RECORD 1>>               <<00712>>04796000
   INTEGER ARRAY SLDIR (*) = SLREC0;  <<DIRECTORY BUFFER>>              04798000
   INTEGER ARRAY RTBUF (*) = SBUF0;  <<REF. TABLE BUFFER>>     <<00712>>04800000
                                                                        04802000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                           04804000
                                                                        04806000
   TOS := LASTCST;                                                      04808000
   TOS := -1;                                                           04810000
   TOS := 0;                                                            04812000
   TOS := 0D;                                                  <<00712>>04814000
   ASSEMBLE(LRA Q+8);                                          <<00712>>04816000
   TOS := S0+128;                                                       04818000
   TOS := 256; ASSEMBLE(ADDS 0);                                        04820000
                                                                        04822000
   <<* * * FORMAT PROCEDURE NAME * * *>>                                04824000
                                                                        04826000
   FORMATNAME(PROCNAME,PROCNAME);                                       04828000
                                                                        04830000
   <<* * * OPEN SYSTEM SL FILE * * *>>                                  04832000
                                                                        04834000
   TOS := ABSOLUTE(SSLKEY);    << GET THE SL KEY >>                     04836000
   TOS := ABSOLUTE(XREG:=XREG+1);                                       04838000
   TOS := 0;  <<FOR RESULT OF FOPENDA>>                                 04840000
   TOS := BS2;  <<LOG. DEV. NR.>>                                       04842000
   TOS := DS3;  <<DISK ADR.>>                                           04844000
   BS1 := 0;  <<CLEAR LOG. DEV. NR.>>                                   04846000
   SSLFNUM := FOPENDA(*,*,%(2)111110110);  <<OPEN SYS. SL>>             04848000
   IF < THEN  <<ERROR?>>                                                04850000
      BEGIN                                                             04852000
      TOS := ERR50; GO ABORT                                            04854000
      END;                                                              04856000
   FLOCK(SSLFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                       04858000
   FREADDIR(SSLFNUM,SLREC0,256,0D);  <<READ REC'S 0,1>>                 04860000
   IF <> THEN GO IOERROR;  <<ERROR?>>                                   04862000
                                                                        04864000
   <<* * * SEARCH DIRECTORY FOR ENTRY POINT * * *>>                     04866000
                                                                        04868000
   TOS := PROCNAME(1);  <<FIRST CHAR.>>                                 04870000
   TOS := PROCNAME;  <<NR. CHAR'S>>                                     04872000
   XREG := S0;                                                          04874000
   TOS.(0:8) := TOS;  <<NR. CHAR'S AND FIRST CHAR.>>                    04876000
   TOS := PROCNAME(XREG);  <<LAST CHAR.>>                               04878000
   XREG := XREG-1;                                                      04880000
   TOS := PROCNAME(XREG);  <<SEC. TO LAST CHAR.>>                       04882000
   TOS.(0:8) := TOS;  <<SEC. TO LAST AND LAST CHAR'S>>                  04884000
   TOS := 95;                                                           04886000
   ASSEMBLE(LDIV,ZROB);                                                 04888000
   TOS := SLREC0(TOS+SLFHI);  <<FIRST REC. IN LIST>>                    04890000
   WHILE <> DO  <<STEP THRU HASH LIST REC'S>>                           04892000
      BEGIN                                                             04894000
      FREADDIR(SSLFNUM,SLDIR,128,DS1);                                  04896000
      IF <> THEN GO IOERROR;  <<ERROR?>>                                04898000
      TOS := @SLDIR(2);  <<INIT. ENTRY POINTER>>                        04900000
      WHILE @PS0 < @SLDIR(SLDIR(1)) DO  <<STEP THRU REC.>>              04902000
         BEGIN                                                          04904000
         IF PS0.(4:4) = INTEGER(PROCNAME) THEN                          04906000
            BEGIN                                                       04908000
            TOS := @PS0&LSL(1)+1;                                       04910000
            IF * = PROCNAME(1),(PROCNAME) THEN GO FOUNDIT               04912000
            END;                                                        04914000
         TOS := TOS+PS0.(4:3)+2;  <<POINTS TO PARM. INFO>>              04916000
         TOS := PS0.(0:2);  <<LEVEL OF CHECKING>>                       04918000
         TOS := IF = THEN 1 ELSE IF S0 = 3 THEN PS1.(2:6)+2 ELSE 2;     04920000
         ASSEMBLE(DELB,ADD)  <<NEXT ENTRY>>                             04922000
         END;                                                           04924000
      DDEL;                                                             04926000
      TOS := SLDIR  <<NEXT REC. NR.>>                                   04928000
      END;                                                              04930000
   TOS := ERR86; GO ABORT;  <<CAN'T FIND PROCEDURE>>                    04932000
                                                                        04934000
   <<* * * DETERMINE IF SEGMENT HAS BEEN ALLOCATED * * *>>              04936000
                                                                        04938000
   FOUNDIT:                                                             04940000
   IF PS0.(3:1)=1 THEN                                         <<00712>>04942000
      BEGIN                                                    <<00712>>04944000
      TOS:=ERR87;  <<PERMANENTLY ALLOCATED SYSTEM SEGMENT>>    <<00712>>04946000
      GO ABORT;                                                <<00712>>04948000
      END;                                                     <<00712>>04950000
   TOS := TOS+PS0.(4:3)+1;                                              04952000
   TOS := PS0.(8:8);  <<SEG. NR.>>                                      04954000
   DELB;                                                                04956000
                                                                        04958000
   TOS := S0; TOS := 4;                                        <<00712>>04960000
   ASSEMBLE(DIV,STBX);                                         <<00712>>04962000
   RTRECD := SLREC1(XREG);  <<REF. TABLE REC. NR.>>            <<00712>>04964000
   DELB;                                                       <<00712>>04966000
                                                               <<00712>>04968000
   SAVESIR := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>             04970000
   EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>                  04972000
   XREG := 0;  <<CST NR.>>                                              04974000
   TOS := CSTCOUNTER;  <<CST COUNTER>>                                  04976000
   DO BEGIN                                                             04978000
      IF USEDCST AND SEGNR = S2 AND SSLSEG THEN                <<00712>>04980000
         BEGIN                                                          04982000
         IF SYSTEMSEG THEN  <<SYS. SEG.?>>                              04984000
            BEGIN                                                       04986000
            TOS := ERR87; GO ABORT                                      04988000
            END;                                                        04990000
         IF NOT ALLOCATEDSEG THEN  <<NOT ALLOCATED?>>                   04992000
            BEGIN                                                       04994000
            NOTALLOC:                                                   04996000
            TOS := ERR86; GO ABORT                                      04998000
            END;                                                        05000000
         GO GOTIT                                                       05002000
         END;                                                           05004000
      ASSEMBLE(INCX,DECA)                                               05006000
      END UNTIL <;                                                      05008000
   GO NOTALLOC;  <<NOT ALLOCATED>>                                      05010000
                                                                        05012000
   <<* * * UPDATE REFERENCE TABLE ENTRY * * *>>                <<00712>>05014000
                                                               <<00712>>05016000
   GOTIT:                                                      <<00712>>05018000
   DEL;                                                        <<00712>>05020000
   FREADDIR(SSLFNUM,RTBUF,128,DRTRECD);                        <<00712>>05022000
   IF <> THEN GO IOERROR;  <<ERROR?>>                          <<00712>>05024000
   TOS := TOS&LSL(5)+@RTBUF+3;  <<REF. TAB. ENTRY FLAG WORD>>  <<00712>>05026000
                                                               <<00712>>05028000
   <<* * * UNLOAD SEGMENTS * * *>>                                      05030000
                                                                        05032000
   ALLOCATEDSEG := 0;  <<CLEAR "ALLOCATED" BIT>>                        05034000
   ASSEMBLE(ZERO,DZRO; DECA);                                           05036000
   AMOUNT := TOS; SEGTYPE' := TOS; SLSEGS := TOS;                       05038000
   TOS := TOS+13;  <<SET POINTER TO SEG. BIT MAP>>                      05040000
   XREG := 0;  <<CST NR.>>                                              05042000
   TOS := CSTCOUNTER;  <<CST COUNTER>>                                  05044000
   DO BEGIN                                                             05046000
      IF USEDCST AND SSLSEG AND TESTBIT(PS1,SEGNR) THEN ADJSEG(XREG);   05048000
      ASSEMBLE(INCX,DECA)                                               05050000
      END UNTIL <;                                                      05052000
   TOS := CCE;  <<OK CONDITION CODE>>                                   05054000
   GO GETOUT;                                                           05056000
                                                                        05058000
   IOERROR:                                                             05060000
   TOS := ERR60;                                                        05062000
                                                                        05064000
   ABORT:                                                               05066000
   DEALLOCATEPROC := TOS;  <<ERROR NR.>>                                05068000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                05070000
                                                                        05072000
   GETOUT:                                                              05074000
   IF SAVESIR <> -1 THEN  <<RESET DB TO STACK?>>                        05076000
      BEGIN                                                             05078000
      EXCHANGEDB(0);  <<RESET DB TO STACK>>                             05080000
      RELSIR(SEGTABSIR,SAVESIR);  <<RELEASE SEG. TABLE SIR>>            05082000
      END;                                                              05084000
   IF SSLFNUM <> 0 THEN  <<CLOSE SL FILE?>>                             05086000
      BEGIN                                                             05088000
      TOS := ERRORGET(1);  <<SAVE ERROR NR. IN PCBX>>                   05090000
      FCLOSEDA (SSLFNUM,0,0);  <<CLOSE SL FILE>>               <<RV.PV>>05092000
      ERRORPUT(*,1)  <<RESTORE ERROR NR.>>                              05094000
      END;                                                              05096000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            05098000
   END;                                                                 05100000
DOUBLE PROCEDURE LOGICALCST (CSTNR);                                    05102000
   <<RETURNS THE SEGMENT NUMBER CORRESPONDING TO THE GIVEN CST NUMBER   05104000
     AND THE TYPE OF THE SEGMENT:                                       05106000
                                                                        05108000
         S-0:  SEGMENT NUMBER                                           05110000
         S-1:  0  SYSTEM SL SEGMENT                                     05112000
               1  PUBLIC SL SEGMENT                                     05114000
               2  GROUP SL SEGMENT                                      05116000
               3  PROGRAM FILE SEGMENT                                  05118000
                                                                        05120000
     NOTE THAT THIS PROCEDURE USES THE CONDITION CODE TO INDICATE AN    05122000
     ERROR (INVALID CST NR.)>>                                          05124000
   VALUE CSTNR;                                                         05126000
   INTEGER CSTNR;                                                       05128000
   OPTION UNCALLABLE;                                                   05130000
   BEGIN                                                                05132000
   IF  CSTNR > %300  THEN                                               05134000
      BEGIN                                                             05136000
      TOS := 3;                                                         05138000
      TOS := CSTNR-%301;                                                05140000
      LOGICALCST := TOS;                                                05142000
CONDCODE := IF ABSOLUTE(ABSOLUTE(CSTXP))<CSTNR-%300 THEN CCL   <<04294>>05144000
                 ELSE  CCE;                                             05146000
      RETURN;                                                           05148000
      END;                                                              05150000
   TOS := SEGTABSIR;                                                    05152000
   TOS := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                 05154000
   TOS := 0;  <<FOR RESULT OF EXCHANGEDB>>                              05156000
   TOS := EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>           05158000
   XREG := CSTNR;                                                       05160000
   CONDCODE := IF USEDCST THEN CCE ELSE CCL;  <<SET CONDITION CODE>>    05162000
   TOS := SEGTYPE;  <<SEGMENT TYPE>>                                    05164000
   TOS := SEGNR;  <<SEGMENT NR.>>                                       05166000
   LOGICALCST := TOS;                                                   05168000
   EXCHANGEDB(*);  <<RESET DB>>                                         05170000
   RELSIR(*,*)  <<RELEASE SEGMENT TABLE SIR>>                           05172000
   END;                                                                 05174000
INTEGER PROCEDURE PHYSICALCST (PIN,SEGMENTNR);                          05176000
   <<RETURNS THE CST NUMBER CORRESPONDING TO THE GIVEN SEGMENT NUMBER   05178000
     CORRESPONDING TO THE GIVEN PIN. CONDITION CODES RETURNED:          05180000
                                                                        05182000
         CCE   OK                                                       05184000
         CCL   INVALID PIN                                              05186000
         CCG   VALID PIN, INVALID SEGMENT NUMBER                        05188000
                                                                        05190000
     PIN <> 0:  USE PROGRAM ENTRY, OTHERWISE SYSTEM SL.                 05192000
     SEGMENTNR.(8:8) = LOGICAL SEGMENT #                                05194000
     SEGMENTNR.(0:3) = TYPE:  0  PROGRAM                                05196000
                              1  SYSTEM SL                              05198000
                              2  PUBLIC SL                              05200000
                              3  GROUP SL                               05202000
                              4  PROGRAM                                05204000
                                                                        05206000
     THIS PROCEDURE MAY BE CALLED WITH DB SET TO ANY DATA SEGMENT>>     05208000
   VALUE PIN,SEGMENTNR;                                                 05210000
   INTEGER PIN,SEGMENTNR;                                               05212000
   OPTION UNCALLABLE;                                                   05214000
   BEGIN                                                                05216000
   LOGICAL EXT;                                                <<00444>>05218000
   TOS := SEGTABSIR;                                                    05220000
   TOS := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                 05222000
   TOS := 0;  <<FOR RESULT OF EXCHANGEDB>>                              05224000
   TOS := EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>           05226000
   IF  PIN = 0  THEN                                                    05228000
      BEGIN  << USE THE SYSTEM SL BIT MAP >>                            05230000
      TOS := 0;                                                         05232000
      TOS := ABSOLUTE(SSLKEY);     << KEY >>                            05234000
      TOS := ABSOLUTE(XREG:=XREG+1);                                    05236000
      TOS := ANYMODE;                                                   05238000
      TOS := SLFILE;                                                    05240000
      GO L;                                                             05242000
      END;                                                              05244000
   IF LSEARCH(DOUBLE(LOGICAL(PIN)),ANYMODE,SHARER) THEN  <<VALID PIN?>> 05246000
      BEGIN                                                             05248000
      TOS := 0;  <<FOR RESULT OF LSEARCH>>                              05250000
      TOS := ENTDP1;  <<PROGRAM FILE KEY>>                              05252000
      TOS := EPMODE;  <<PRIV. MODE>>                                    05254000
      TOS := PROGFILE;                                                  05256000
L:    LSEARCH(*,*,*);  <<FIND ENTRY>>                                   05258000
      IF  PIN <> 0  AND  SEGMENTNR.(1:2) = 0  THEN                      05260000
         BEGIN  << PROGRAM FILE ENTRY >>                                05262000
         PHYSICALCST := SEGMENTNR+%301;  <<CST NR.>>                    05264000
         XREG := IF SEGMENTNR >= ESEG THEN CCG ELSE CCE  <<ERROR?>>     05266000
         END                                                            05268000
      ELSE                                                              05270000
         BEGIN  << SL, MUST SEARCH THE BIT MAP >>                       05272000
         SI := SEGMENTNR.(8:8);                                         05274000
         SK := (SEGMENTNR.(0:3)-1).(14:2);   << TYPE >>                 05276000
         SJ := 0;                                                       05278000
         LSTEP(FINDSEG);                                                05280000
         IF SJ=0 AND SK=0 THEN                                 <<00699>>05282000
           BEGIN  <<MUST CHECK FOR SYSTEM SEGMENT>>            <<00699>>05284000
            XREG := %300;                                      <<04682>>05286000
           DO XREG:=XREG-1 UNTIL                               <<00699>>05288000
             SEGNR=SI AND SEGTYPE=0 AND SEGALLOC<>0 OR XREG=0; <<00699>>05290000
           SJ:=XREG;                                           <<00699>>05292000
           END;                                                <<00699>>05294000
         IF SJ=0 THEN  <<MUST SEARCH EXTENSION ENTRIES>>       <<00444>>05296000
           BEGIN                                               <<00444>>05298000
           EXT:=0;                                             <<00444>>05300000
           WHILE LSEARCH(                                      <<00444>>05302000
             DOUBLE(LOGICAL(PIN) LOR  (EXT:=EXT+1)&LSL(8)),    <<00444>>05304000
             ANYMODE,EXTENSION) DO                             <<00444>>05306000
               BEGIN                                           <<00444>>05308000
               LSTEP(FINDSEG);                                 <<00444>>05310000
               IF SJ<>0 THEN GO TO L2;                         <<00444>>05312000
               END;                                            <<00444>>05314000
           END;                                                <<00444>>05316000
L2:                                                            <<00444>>05318000
         PHYSICALCST := SJ;                                             05320000
         XREG := IF = THEN CCG ELSE CCE;                                05322000
         END;                                                           05324000
      END                                                               05326000
   ELSE XREG := CCL;  <<ERROR CONDITON CODE>>                           05328000
   EXCHANGEDB(*);  <<RESET DB>>                                         05330000
   RELSIR(*,*);  <<RELEASE SEGMENT TABLE SIR>>                          05332000
   CONDCODE := XREG  <<STORE CONDITION CODE>>                           05334000
   END;                                                                 05336000
PROCEDURE  FINDSEG(CSTNR);                                              05338000
   << SUPPORT PROCEDURE FOR PHYSICALCST >>                              05340000
   VALUE CSTNR;                                                         05342000
   INTEGER CSTNR;                                                       05344000
   OPTION INTERNAL,UNCALLABLE;                                          05346000
   BEGIN                                                                05348000
   XREG := CSTNR;                                                       05350000
   IF  SEGNR = SI  AND  SEGTYPE = SK  THEN  SJ := CSTNR;                05352000
   END;                                                                 05354000
PROCEDURE PROCFILE (PIN,FNAME);                                         05356000
   COMMENT:                                                    <<00090>>05358000
      RETURNS PROGRAM FILE NAME CORRESPONDING TO "PIN".        <<00090>>05360000
      "FNAME" MUST BE AT LEAST 28 BYTES LONG.  (THIS IS        <<00090>>05362000
      IN PART A CARRY-OVER FROM A PREVIOUS IMPLEMENTATION      <<00090>>05364000
      WHICH CALLED "FGETINFO".  IT ALSO ENSURES AT LEAST       <<00090>>05366000
      ONE BLANK AFTER THE FILE NAME FOR SCANNING PURPOSES.)    <<00090>>05368000
      NAME IS FULLY QUALIFIED AND PACKED WITH TRAILING         <<00090>>05370000
      BLANKS.  NOTE SPECIAL FORMAT FOR SYSTEM PROCESSES.       <<00090>>05372000
                                                               <<00090>>05374000
      DB MUST POINT TO STACK.                                  <<00090>>05376000
                                                               <<00090>>05378000
      OUTPUT DEPENDS ON CONDITION CODE:                        <<00090>>05380000
         CCE -- NO ERROR ... "FNAME" CONTAINS PROGRAM NAME     <<00090>>05382000
         CCG -- SYSTEM PROCESS ... "FNAME" CONTAINS "C.I."     <<00090>>05384000
                OR "SYS.PROC." DEPENDING ON PROCESS TYPE       <<00090>>05386000
         CCL -- INVALID PIN OR FILE I/O ERROR ... "FNAME"      <<00090>>05388000
                CONTAINS BLANKS                                <<00090>>05390000
      ;                                                        <<00090>>05392000
   VALUE PIN;                                                           05394000
   INTEGER PIN;                                                         05396000
   BYTE ARRAY FNAME;                                                    05398000
   OPTION PRIVILEGED, UNCALLABLE;                              <<00090>>05400000
   BEGIN                                                                05402000
   INTEGER POINTER PCB= 3; <<SYS GLOB+3>>                      <<00090>>05404000
   DEFINE NUMPCBS= PCB(0) #,                                   <<00090>>05406000
          PTYPE=   PCB(PIN*PCBSIZE+9).(6:3) #;                 <<00090>>05408000
                                                               <<00090>>05410000
   EQUATE FLSIZE= 128;                                         <<00090>>05412000
   INTEGER ARRAY FLAB(0:FLSIZE-1);                             <<00090>>05414000
   BYTE ARRAY BFLAB(*)= FLAB;                                  <<00090>>05416000
   DEFINE FLBLOCNAME=  BFLAB #,                                <<00090>>05418000
          FLBGRPNAME=  BFLAB(8) #,                             <<00090>>05420000
          FLBACCTNAME= BFLAB(16) #;                            <<00090>>05422000
                                                               <<00090>>05424000
   EQUATE MINPIN=1;                                            <<02823>>05426000
   INTEGER LDEV;                                               <<00090>>05428000
   DOUBLE DISCADDR;                                            <<00090>>05430000
   BYTE DALDEV= DISCADDR; <<LDEV IN LST ENTRY>>                <<00090>>05432000
                                                               <<00090>>05434000
                                                               <<00090>>05436000
   FNAME:=" ";   MOVE FNAME(1):=FNAME,(27);                    <<00090>>05438000
   TOS := SEGTABSIR;                                                    05440000
   TOS := GETSIR(SEGTABSIR);  <<GET SEGMENT TABLE SIR>>                 05442000
   TOS := 0;  <<FOR RESULT OF EXCHANGEDB>>                              05444000
   TOS := EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>           05446000
   IF LSEARCH(DOUBLE(LOGICAL(PIN)),ANYMODE,SHARER) THEN  <<VALID PIN?>> 05448000
      BEGIN                                                             05450000
      DISCADDR:=ENTDP1; <<FILE KEY>>                           <<00090>>05452000
      EXCHANGEDB(*);  <<RESET DB>>                                      05454000
      RELSIR(*,*);  <<RELEASE SEGMENT TABLE SIR>>                       05456000
      LDEV:=DALDEV;                                            <<00090>>05458000
      DALDEV:=0;                                               <<00090>>05460000
      IF FLABIO(LDEV,DISCADDR,0,FLAB)<>0 THEN TOS:=CCL         <<00090>>05462000
      ELSE                                                     <<00090>>05464000
         BEGIN                                                 <<00090>>05466000
         MOVE FNAME:=FLBLOCNAME,(8);                           <<00090>>05468000
         SCAN FNAME UNTIL " ",1;                               <<00090>>05470000
         MOVE * := ".",2;                                      <<00090>>05472000
         MOVE BPS0:=FLBGRPNAME,(8);                            <<00090>>05474000
         SCAN * UNTIL " ",1;                                   <<00090>>05476000
         MOVE * := ".",2;                                      <<00090>>05478000
         MOVE * := FLBACCTNAME,(8);                            <<00090>>05480000
                                                               <<00090>>05482000
         FLAB:=0;   MOVE FLAB(1):=FLAB,(FLSIZE-1);             <<00090>>05484000
         TOS:=CCE;                                             <<00090>>05486000
         END;                                                  <<00090>>05488000
      END                                                               05490000
   ELSE                                                                 05492000
      BEGIN                                                             05494000
      EXCHANGEDB(*);  <<RESET DB>>                                      05496000
      RELSIR(*,*);  <<RELEASE SEGMENT TABLE SIR>>                       05498000
      IF NOT (MINPIN<=PIN<=NUMPCBS) THEN TOS:=CCL              <<02823>>05500000
      ELSE IF 2<=PTYPE<=3 THEN                                 <<00090>>05502000
         BEGIN                                                 <<00090>>05504000
         MOVE FNAME:="C.I.";                                   <<00090>>05506000
         TOS:=CCG;                                             <<00090>>05508000
         END                                                   <<00090>>05510000
      ELSE IF > THEN                                           <<00090>>05512000
         BEGIN                                                 <<00090>>05514000
         MOVE FNAME:="SYS.PROC.";                              <<00090>>05516000
         TOS:=CCG;                                             <<00090>>05518000
         END                                                   <<00090>>05520000
      ELSE TOS:=CCL;                                           <<00090>>05522000
      END;                                                     <<00090>>05524000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            05526000
   END;                                                                 05528000
LOGICAL PROCEDURE LOADEDSLSEG (SLKEY,SEGMENTNR);                        05530000
   <<CHECKS TO SEE IF THE SPECIFIED SEGMENT OF THE SPECIFIED SL FILE    05532000
     IS CURRENTLY LOADED.  RETURNS THE VALUE TRUE IF IT IS, OTHERWISE   05534000
     FALSE.  NOTE THAT IT IS ASSUMED THAT THIS PROCEDURE IS CALLED WITH 05536000
     AN INITIAL RESULT OF ZERO>>                                        05538000
   VALUE SLKEY,SEGMENTNR;                                               05540000
   DOUBLE SLKEY;                                                        05542000
   INTEGER SEGMENTNR;                                                   05544000
   OPTION UNCALLABLE;                                                   05546000
   BEGIN                                                                05548000
   TOS := SEGTABSIR;                                                    05550000
   TOS := GETSIR(SEGTABSIR);                                            05552000
   TOS := 0;  <<FOR RESULT OF EXCHANGEDB>>                              05554000
   TOS := EXCHANGEDB(SEGTABDST);  <<SET DB TO SEGMENT TABLE>>           05556000
   IF LSEARCH(SLKEY,NORMAL,SLFILE) THEN                                 05558000
      BEGIN                                                             05560000
      SI := FALSE;                                                      05562000
      SJ := SEGMENTNR;                                                  05564000
      LSTEP(FINDSLSEG);                                                 05566000
      LOADEDSLSEG := SI                                                 05568000
      END;                                                              05570000
   EXCHANGEDB(*);                                                       05572000
   RELSIR(*,*)                                                          05574000
   END;                                                                 05576000
PROCEDURE FINDSLSEG (CSTNR);                                            05578000
   <<SUPPORT PROCEDURE FOR LOADEDSLSEG>>                                05580000
   VALUE CSTNR;                                                         05582000
   INTEGER CSTNR;                                                       05584000
   OPTION INTERNAL,UNCALLABLE;                                          05586000
   BEGIN                                                                05588000
   XREG := CSTNR;                                                       05590000
   IF SEGNR = SJ THEN SI := TRUE                                        05592000
   END;                                                                 05594000
$CONTROL SEGMENT=MAIN                                                   05596000
END.                                                                    05598000
