$CONTROL USLINIT,MAP,CODE                                               00010000
<< LOAD - MODULE 05 >>                                                  00015000
<<HP32002C MPE SOURCE C.00.00>>                                         00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1982.          ",&    00025000
$  "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A       ",&    00030000
$  "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR     ",&    00035000
$  "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",&    00040000
$  "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED   ",&    00045000
$  "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."      00050000
$TITLE "     MPE LOAD PROCESS"                                          00055000
$CONTROL SEGMENT=LOAD,MAIN=LOAD                                         00060000
$CONTROL PRIVILEGED,UNCALLABLE                                          00065000
$THIRTY                                                                 00070000
BEGIN                                                                   00075000
$PAGE                                                                   00080000
<<*************************************************>>          <<06094>>00085000
<<                                                 >>          <<06094>>00090000
<< THE LOAD PROCESS HAD BEEN REWRITTEN FOR THE CST >>          <<06094>>00095000
<< EXPANSION PROJECT AND INTEGRATED INTO THE MPEV. >>          <<06094>>00100000
<<                                                 >>          <<06094>>00105000
<<              JANUARY, 1983                      >>          <<06094>>00110000
<<                                                 >>          <<06094>>00115000
<<*************************************************>>          <<06094>>00120000
$PAGE                                                                   00125000
<<----------------------------------------------------------->>         00130000
<<                                                           >>         00135000
<<                            LOAD PROCESS                   >>         00140000
<<                                                           >>         00145000
<<----------------------------------------------------------->>         00150000
                                                                        00155000
<<ERROR NUMBERS>>                                                       00160000
                                                                        00165000
EQUATE ERR20 = 20,  <<ILLEGAL LIBRARY SEARCH>>                          00170000
       ERR21 = 21,  <<UNKNOWN ENTRY POINT>>                             00175000
       ERR22 = 22,  <<TRACE SYBSYSTEM NOT PRESENT>>                     00180000
       ERR23 = 23,  <<STACK SIZE TOO SMALL>>                            00185000
       ERR24 = 24,  <<MAX. DATA > 32K>>                                 00190000
       ERR25 = 25,  <<DATA SEGMENT > MAX DATA SEGMENT>>                 00195000
       ERR26 = 26,  <<PROGRAM LOADED IN OPPOSITE MODE>>                 00200000
       ERR27 = 27,  <<SL BINDING ERROR>>                                00205000
       ERR28 = 28,  <<INVALID SYSTEM SL FILE>>                          00210000
       ERR29 = 29,  <<INVALID PUBLIC SL FILE>>                          00215000
       ERR30 = 30,  <<INVALID GROUP SL FILE>>                           00220000
       ERR31 = 31,  <<INVALID PROGRAM FILE>>                            00225000
       ERR32 = 32,  <<INVALID LIST FILE>>                               00230000
       ERR33 = 33,  <<CODE SEGMENT > SYSTEM MAX.>>                      00235000
       ERR34 = 34,  <<PROGRAM USES MORE THAN ONE EXTENT>>               00240000
       ERR35 = 35,  <<DATA SEGMENT > 32K>>                              00245000
       ERR36 = 36,  <<DATA SEGMENT > SYSTEM MAX.>>                      00250000
       ERR37 = 37,  <<NR. CODE SEGMENTS > 63>>                          00255000
       ERR38 = 38,  <<NR. CODE SEGMENTS > SYSTEM MAX.>>                 00260000
       ERR39 = 39,  <<ILLEGAL CAPABILITY>>                              00265000
       ERR40 = 40,  <<TOO MANY PROCEDURES LOADED>>                      00270000
       ERR41 = 41,  <<UNKNOWN PROCEDURE NAME>>                          00275000
       ERR42 = 42,  <<INVALID PROCEDURE NUMBER>>                        00280000
       ERR43 = 43,  <<ILLEGAL PROCEDURE UNLOAD>>                        00285000
       ERR44 = 44,  <<ILLEGAL SL CAPABILITY>>                           00290000
       ERR45 = 45,  <<INVALID ENTRY POINT>>                             00295000
       ERR50 = 50,  <<UNABLE TO OPEN SYSTEM SL FILE>>                   00300000
       ERR51 = 51,  <<UNABLE TO OPEN PUBLIC SL FILE>>                   00305000
       ERR52 = 52,  <<UNABLE TO OPEN GROUP SL FILE>>                    00310000
       ERR53 = 53,  <<UNABLE TO OPEN PROGRAM FILE>>                     00315000
       ERR54 = 54,  <<UNABLE TO OPEN LIST FILE>>                        00320000
       ERR55 = 55,  <<UNABLE TO CLOSE SYSTEM SL FILE>>                  00325000
       ERR56 = 56,  <<UNABLE TO CLOSE PUBLIC SL FILE>>                  00330000
       ERR57 = 57,  <<UNABLE TO CLOSE GROUP SL FILE>>                   00335000
       ERR58 = 58,  <<UNABLE TO CLOSE PROGRAM FILE>>                    00340000
       ERR59 = 59,  <<UNABLE TO CLOSE LIST FILE>>                       00345000
       ERR60 = 60,  <<EOF OR I/O ERROR ON SYSTEM SL FILE>>              00350000
       ERR61 = 61,  <<EOF OR I/O ERROR ON PUBLIC SL FILE>>              00355000
       ERR62 = 62,  <<EOF OR I/O ERROR ON GROUP SL FILE>>               00360000
       ERR63 = 63,  <<EOF OR I/O ERROR ON PROGRAM FILE>>                00365000
       ERR64 = 64,  <<EOF OR I/O ERROR ON LIST FILE>>                   00370000
       ERR65 = 65,  <<UNABLE TO OBTAIN CST ENTRIES>>                    00375000
       ERR66 = 66,  <<UNABLE TO OBTAIN PROCESS DST ENTRY>>              00380000
       ERR67 = 67,  <<UNABLE TO OBTAIN MAIL DATA SEGMENT>>              00385000
       ERR68 = 68,  <<UNABLE TO OBTAIN WORKING SET>>                    00390000
       ERR70 = 70,  <<SEGMENT TABLE OVERFLOW>>                          00395000
       ERR71 = 71,  <<UNABLE TO OBTAIN SUFFICIENT DL STORAGE>>          00400000
       ERR72 = 72,  <<ATTIO ERROR>>                                     00405000
       ERR73 = 73,  <<UNABLE TO OBTAIN VIRTUAL MEMORY>>                 00410000
       ERR74 = 74,  <<DIRECTORY I/O ERROR>>                             00415000
       ERR75 = 75,  <<PRINT I/O ERROR>>                                 00420000
       ERR76 = 76,  <<ILLEGAL DLSIZE>>                                  00425000
       ERR80 = 80,  <<PROGRAM ALREADY ALLOCATED>>                       00430000
       ERR81 = 81,  <<ILLEGAL PROGRAM ALLOCATION>>                      00435000
       ERR82 = 82,  <<PROGRAM NOT ALLOCATED>>                           00440000
       ERR83 = 83,  <<ILLEGAL PROGRAM DEALLOCATION>>                    00445000
       ERR84 = 84,  <<PROCEDURE ALREADY ALLOCATED>>                     00450000
       ERR85 = 85,  <<ILLEGAL PROCEDURE ALLOCATION>>                    00455000
       ERR86 = 86,  <<PROCEDURE NOT ALLOCATED>>                         00460000
       ERR87 = 87,  <<ILLEGAL PROCEDURE DEALLOCATION>>                  00465000
       WARN88= 88,  <<LMAP NOT AVAILABLE>>                              00470000
       WARN89= 89,  <<LOAD WITH LIB=S>>                                 00475000
       WARN90= 90,  <<LOAD WITH LIB=P>>                                 00480000
       WARN91= 91,  <<LOAD WITH LIB=G>>                                 00485000
       ERR92 = 92,  <<ALLOCATE/DEALLOCATE FROM NON-SYSTEM DISC <<E9062>>00490000
       ERR93 = 93,  <<UNABLE TO MOUNT PROG'S HOME VOL. SET>>   <<06094>>00495000
       ERR94 = 94,  <<UNABLE TO MOUNT SYS SL'S H.V.S.>>        <<06094>>00500000
       ERR95 = 95,  <<UNABLE TO MOUNT PRIVATE SL'S H.V.S.>>    <<06094>>00505000
       ERR96 = 96,  <<UNABLE TO MOUNT GROUP SL'S H.V.S.>>      <<06094>>00510000
       ERR97 = 97,  <<UNABLE TO LOAD REMOTE PROGRAM>>                   00515000
       ERR98 = 98,  <<UNABLE TO CONVERT OLD FORMAT>>                    00520000
       ERR99 = 99,  <<UNABLE TO OBTAIN DST FOR LOGICAL MAP>>            00525000
       ERR100=100,  <<TOO MANY MAPPED SEGMENTS>>                        00530000
       ERR101=101,  <<SEGMAP TOO BIG>>                                  00535000
       ERR102=102,  <<UNABLE TO EXPAND SEGMAP>>                         00540000
       ERR103=103;  <<TOO MANY DYNAMIC LOADS ON PROCEDURE>>             00545000
$PAGE                                                                   00550000
<<--------------------------------------------------------->>           00555000
<<                                                         >>           00560000
<< MISCELLANEOUS DEFINITIONS                               >>           00565000
<<                                                         >>           00570000
<<--------------------------------------------------------->>           00575000
                                                                        00580000
DEFINE ASMB           = ASSEMBLE#,                                      00585000
       ABS            = ABSOLUTE#,                                      00590000
       SETBIT0        = ASSEMBLE(TSBC 0)#,                              00595000
       CONDCODE       = STATUS.(6:2)#,                                  00600000
       TURNOFFTRAPS   = PUSH(STATUS);                                   00605000
                        TOS.(2:1):=0;                                   00610000
                        SET(STATUS)#;                                   00615000
EQUATE CCG            = 0,                                              00620000
       CCL            = 1,                                              00625000
       CCE            = 2;                                              00630000
INTEGER XREG          = X;                                              00635000
INTEGER STATUS        = Q-1;                                            00640000
BYTE BS1              = S-1,                                            00645000
     BS2              = S-2;                                            00650000
INTEGER S0            = S-0,                                            00655000
        S1            = S-1,                                            00660000
        S2            = S-2,                                            00665000
        S3            = S-3;                                            00670000
LOGICAL LS0           = S-0;                                            00675000
DOUBLE DS1            = S-1,                                            00680000
       DS2            = S-2,                                            00685000
       DS3            = S-3,                                            00690000
       DS6            = S-6;                                            00695000
BYTE POINTER BPS0     = S-0;                                            00700000
INTEGER POINTER PS0   = S-0,                                            00705000
                PS1   = S-1;                                            00710000
DOUBLE POINTER DPS2   = S-2;                                            00715000
EQUATE P256           = 256,                                            00720000
       P384           = 384;                                            00725000
INTEGER TEMP1,                                                          00730000
        TEMP2;                                                          00735000
INTEGER POINTER PTEMP3;                                                 00740000
DOUBLE DTEMP4;                                                          00745000
INTEGER ARRAY BUF1(0:255),                                              00750000
              BUF2(*)=BUF1(128);                                        00755000
INTEGER SAVESIR;                                                        00760000
LOGICAL USERCAP;                                                        00765000
INTEGER CSTBX,                  <<CST BLOCK INDEX          >>           00770000
        GLOBALFLAGS;            <<FLAGS USED DURING LOAD   >>           00775000
DEFINE CSTSALLOCATED  = GLOBALFLAGS.(15:1)#,                            00780000
       CSTBLOCKALLOCATED=GLOBALFLAGS.(14:1)#,                           00785000
       PROGLOADBIT    = GLOBALFLAGS.(13:1)#,                            00790000
       LOADDOMAIN     = GLOBALFLAGS.(12:1)#,                            00795000
       RTMODIFIED     = GLOBALFLAGS.(11:1)#,                            00800000
       NEWSEGMAPFLAG  = GLOBALFLAGS.(10:1)#;                            00805000
EQUATE PHYDOMAIN = 1;                                          <<06281>>00810000
EQUATE LOAD'DONE'MESSAGE = %777,                               <<*7545>>00815000
       LOAD'MESSAGE = %111;                                    <<*7545>>00820000
$PAGE                                                                   00825000
<<--------------------------------------------------------->>           00830000
<<                                                         >>           00835000
<< SYSTEM DEFINITIONS                                      >>           00840000
<<                                                         >>           00845000
<<--------------------------------------------------------->>           00850000
                                                                        00855000
EQUATE SSLKEYA        = %1126,  <<SYSTEM SL FILE KEY       >>           00860000
       MAXCODESEG     = %1106,  <<MAX # PROG FILE CODE SEGS>>           00865000
       MAXCODE        = %1105;  <<MAX CODE SEG SIZE        >>           00870000
POINTER PCB           = 3;      <<SYSGLOB PTR TO PCB       >>           00875000
INTEGER POINTER DSTI  = 2;      <<SYSGLOB PTR TO DST       >>           00880000
DEFINE DSLEN          = (3:13)#;<<DST ENTRY LENGTH FIELD   >>           00885000
EQUATE SYSWAITTODISPMSG=%1053;                                 <<06094>>00890000
DEFINE PHASETRANSFLAG=(3:1)#;                                  <<06094>>00895000
$PAGE                                                                   00900000
<<----------------------------------------------------------->>         00905000
<<                                                           >>         00910000
<< DL AREA PARAMETERS                                        >>         00915000
<<                                                           >>         00920000
<<----------------------------------------------------------->>         00925000
                                                                        00930000
EQUATE SYSDL = 10,  <<NR. WORDS DL AREA RESERVED FOR SYSTEM>>           00935000
       DLINCREMENT = 128; <<NR. WORDS BY WHICH DL IS EXPANDED>>         00940000
INTEGER POINTER DLAREA1; <<DL USED AREA1 POINTER>>                      00945000
INTEGER POINTER DLAREA2;  <<DL USED AREA 2 POINTER>>                    00950000
INTEGER POINTER DLAVAIL;  <<DL AVAILABLE AREA POINTER>>                 00955000
INTEGER DLSZE;             <<INITIAL DL SIZE>>                          00960000
$PAGE                                                                   00965000
<<----------------------------------------------------------->>         00970000
<<                                                           >>         00975000
<< LIST FILE BUFFERS AND PARAMETERS                          >>         00980000
<<                                                           >>         00985000
<<----------------------------------------------------------->>         00990000
                                                                        00995000
INTEGER LISTFNUM := 0;  <<LIST DEVICE FILE NR.>>                        01000000
BYTE ARRAY LISTDESIG (0:8) := "LOADLIST ";                              01005000
INTEGER ARRAY LINE (0:35);  <<LIST BUFFER>>                             01010000
BYTE ARRAY BLINE (*) = LINE;                                            01015000
LOGICAL LISTFLAG;  <<TRUE IF LISTING GENERATED>>                        01020000
DOUBLE LISTADDR;  << LOADLIST FILE DISK ADDRESS >>                      01025000
INTEGER LISTADDR1 = LISTADDR;                                           01030000
INTEGER LISTADDR2 = LISTADDR+1;                                         01035000
$PAGE                                                                   01040000
<<--------------------------------------------------------->>           01045000
<<                                                         >>           01050000
<< LOADER SEGMENT TABLE DEFINITIONS                        >>           01055000
<<                                                         >>           01060000
<<--------------------------------------------------------->>           01065000
                                                                        01070000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01075000
<< GLOBAL AREA                                             >>           01080000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01085000
                                                                        01090000
EQUATE SEGTABDST = 18,          <<LST DST #                >>           01095000
       SEGTABSIR = 17;          <<LST SIR #                >>           01100000
EQUATE NUMENTRYTYPE = 9;        <<# DIRECTORY ENTRY TYPES  >>           01105000
INTEGER ARRAY LST(*) = DB+0;    <<LST                      >>           01110000
INTEGER ARRAY DIR(@) = DB+0;    <<PTR TO ENTRY DIRECTORY   >>           01115000
INTEGER DIRLEN       = DB+1;    <<DIRECTORY LENGTH         >>           01120000
INTEGER ARRAY LCT(@) = DB+2;    <<PTR TO LOADER COMM. TAB. >>           01125000
INTEGER POINTER ENTP = DB+3,    <<PRIMARY ENTRY PTR        >>           01130000
                ENTP1= DB+4,    <<SECONDARY ENTRY PTR      >>           01135000
                ENTP2= DB+5,    <<    "       "    "       >>           01140000
                ENTP3= DB+6;    <<    "       "    "       >>           01145000
DOUBLE POINTER ENTDP = ENTP,    <<    "       "    "       >>           01150000
               ENTDP1= ENTP1,   <<    "       "    "       >>           01155000
               ENTDP2= ENTP2,   <<    "       "    "       >>           01160000
               ENTDP3= ENTP3;   <<    "       "    "       >>           01165000
INTEGER ARRAY SBUF0(@)=DB+7;    <<DISC BUFFER (128 WORDS)  >>           01170000
INTEGER SI           = DB+8,    <<UTILITY INTEGER          >>           01175000
        SJ           = DB+9,    <<   "       "             >>           01180000
        SK           = DB+10,   <<   "       "             >>           01185000
        SL           = DB+11,   <<   "       "             >>           01190000
        SM           = DB+12,   <<   "       "             >>           01195000
        SN           = DB+13,   <<   "       "             >>           01200000
        SO           = DB+14,   <<   "       "             >>           01205000
        SP           = DB+15,   <<   "       "             >>           01210000
        SQ           = DB+16,   <<   "       "             >>           01215000
        SR           = DB+17,   <<   "       "             >>           01220000
        SS           = DB+18,   <<   "       "             >>           01225000
        ST           = DB+19;   <<   "       "             >>           01230000
INTEGER POINTER PSI  = SI,      <<UTILITY PTR              >>           01235000
                PSS  = SS,      <<   "     "               >>           01240000
                PST  = ST;      <<   "     "               >>           01245000
DOUBLE POINTER DPST  = ST;      <<   "     "               >>           01250000
INTEGER ARRAY HDFWDLINK(*)=DB+20,<<HEAD LINK FOR ENTRY TYPE>>           01255000
              HDBKWDLINK(*)=HDFWDLINK+NUMENTRYTYPE;                     01260000
                                <<TAIL LINK FOR ENTRY TYPE >>           01265000
$PAGE                                                                   01270000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01275000
<<  LOADER COMMUNICATION TABLE (LCT)                       >>           01280000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01285000
                                                                        01290000
EQUATE LCTPTR        = 2,       <<OFFSET TO LCT PTR IN LST >>           01295000
       LCTLENGTH     = 22;      <<LENGTH OF LCT            >>           01300000
                                                                        01305000
<<INCOMING MESSAGE>>                                                    01310000
                                                                        01315000
DEFINE MALLOCATE     = LOGICAL(LCTBUF.(0:1))#,<<ALLOCATE CMD>>          01320000
       MCOMMAND      = LCTBUF.(0:2)#, <<LOADER COMMAND     >>           01325000
       MLIBSEARCH    = LCTBUF.(2:2)#, <<LIBRARY SEARCH     >>           01330000
       MPMODE        = LOGICAL(LCTBUF.(4:1))#,<<LOAD MODE  >>           01335000
       MLMAP         = LOGICAL(LCTBUF.(6:1))#,<<LOAD MAP   >>           01340000
       MPIN          = LCTBUF(1)#,    <<PROCESS PIN        >>           01345000
       MLOADDOMAIN   = LCTBUF.(5:1)#, <<LOAD DOMAIN        >>           01350000
       MPROGKEY      = LCTBUF(2)#,    <<PROGRAM FILE KEY   >>           01355000
       MPROCNAME     = LCTBUF(3)#,    <<PROCEDURE NAME     >>           01360000
       WPROC         = LCTBUF(11)#,   <<WAITING PROCESS PIN>>           01365000
       USERCAP2      = LCTBUF(12)#,   <<CAPABILITY         >>           01370000
       MPVINFO       = LCTBUF(21)#,   <<PRIVATE VOL INFO   >>           01375000
       MEXTENSION    = LCTBUF(2)#,    <<EXTENSION #        >>           01380000
       MGROUP        = LCTBBUF(26)#,  <<USER GROUP         >>           01385000
       MACCT         = LCTBBUF(34)#;  <<USER ACCOUNT       >>           01390000
DEFINE PROCLOAD      = LOGICAL(MCOMMAND)#,<<LOAD/ALLOCATE  >>           01395000
                                          <<PROCEDURE      >>           01400000
       ALLOCPROC     = MCOMMAND=3#,   <<ALLOCATE PROCEDURE >>           01405000
       PROGLOAD      = NOT PROCLOAD#; <<LOAD/ALLOCATE PROG >>           01410000
                                                                        01415000
<<OUTGOING MESSAGE>>                                                    01420000
                                                                        01425000
DEFINE LCTANSWER     = LCTBUF(0)#,<<ANSWER FROM LOAD       >>           01430000
       LCTERROR      = LCTBUF(1)#,<<LOAD ERROR             >>           01435000
       LCTLISTFLAG   = LCTBUF(2)#,<<LOAD MAP FLAG          >>           01440000
       LCTLMAPLDEV   = LCTBUF(3)#,<<LOAD MAP LDEV          >>           01445000
       LCTLMAPHIDA   = LCTBUF(4)#,<<LOAD MAP HI DISC ADDR  >>           01450000
       LCTLMAPLODA   = LCTBUF(5)#;<<LOAD MAP LO DISC ADDR  >>           01455000
$PAGE                                                                   01460000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01465000
<< DIRECTORY ENTRY DEFINITIONS                             >>           01470000
<<  (COMMON TO ALL ENTRIES)                                >>           01475000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01480000
                                                                        01485000
EQUATE GARBAGE       = 0,       <<GARBAGE ENTRY TYPE #     >>           01490000
       SLFILE        = 1,       <<SL FILE ENTRY TYPE #     >>           01495000
       PROGFILE      = 2,       <<PROGRAM FILE ENTRY TYPE #>>           01500000
       LOADING       = 3,       <<PROGRAM LOADING ENTRY TYP>>           01505000
       WAITING       = 4,       <<PROCESS WAITING ENTRY TYP>>           01510000
       LOADED        = 5,       <<PROCESS WAIT COMPLETED   >>           01515000
       SHARER        = 6,       <<PROCESS INFO ENTRY TYPE  >>           01520000
       EXTENSION     = 7,       <<DYNAMIC LOAD ENTRY TYPE  >>           01525000
       LOADPROCMASTER= 8;       <<MASTER DYNAMIC LOAD ENTRY>>           01530000
EQUATE ANYMODE       = -1,      <<WILD CARD FOR ENTRY MODE >>           01535000
       NORMAL        = 0;       <<NORMAL (PRIV.) MODE      >>           01540000
DEFINE FWDLINK  = ENTP(-3)#,    <<ENTRY FORWARD LINK       >>           01545000
       BKWDLINK = ENTP(-2)#,    <<ENTRY BACKWARD LINK      >>           01550000
       RLENGTH  = ENTP(-1)#,    <<REGION LENGTH--HEADER +  >>           01555000
                                <<  ENTRY + TRAILING EXCESS>>           01560000
       ETYPE    = ENTP.(8:8)#;  <<ENTRY TYPE               >>           01565000
$PAGE                                                                   01570000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01575000
<<  (GARBAGE ENTRY - TYPE 0)                               >>           01580000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01585000
                                                                        01590000
DEFINE ENWG = ENTP(-1)#;        <<GARBAGE ENTRY LENGTH     >>           01595000
                                                                        01600000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01605000
<<  (SL FILE ENTRY - TYPE 1)                               >>           01610000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01615000
                                                                        01620000
DEFINE EFID        = ENTDP1#,   <<FILE ID                  >>           01625000
       EFID1       = ENTP(1)#,  <<FILE ID - WORD 1         >>           01630000
       EFID2       = ENTP(2)#,  <<FILE ID - WORD 2         >>           01635000
       EPVINFO'SL  = ENTP(3)#,  <<PRIVATE VOL INFO         >>           01640000
       EALLOCSEG'SL= ENTP(4).(0:8)#,<<# ALLOCATED SEG IN SL>>           01645000
       ESLSEG'SL   = ENTP(4).(8:8)#,<<# SEG LIST ENTRIES   >>           01650000
       <<  SEG LIST ENTRY DEFINITIONS                      >>           01655000
       SLLOGSEGNR  = PTEMP2.(0:8)#, <<SL LOGICAL SEG NUMBER>>           01660000
       SYSTEMSEG   = LOGICAL(PTEMP2.(14:1))#, <<FLAGS X-BIT>>           01665000
       REFCOUNT    = PTEMP2(1)#,    <<LOG SEG REFERENCE CNT>>           01670000
       PHYCST      = PTEMP2(2)#;    <<LOG SEG'S CST #      >>           01675000
                                                                        01680000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01685000
<<  (PROGRAM FILE ENTRY - TYPE 2)                          >>           01690000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01695000
                                                                        01700000
DEFINE EPMODE      = ENTP.(0:1)#, <<PROGRAM MODE           >>           01705000
       EPA         = ENTP.(1:1)#, <<ALLOCATED FLAG         >>           01710000
       ELIB        = ENTP.(4:4)#, <<LIB SEARCH             >>           01715000
       ECSTBLK     = ENTP(3)#,    <<CST BLOCK INDEX        >>           01720000
       EMAPDST     = ENTP(4)#,    <<SEGMAP DST NUMBER      >>           01725000
       ESHR        = ENTP(5)#,    <<PROG FILE REFERENCE CNT>>           01730000
       ESEG        = ENTP(6).(0:8)#,<<# SEGS IN PROG FILE  >>           01735000
       ESLINFO'PROG= ENTP(6).(8:8)#,<<# SLINFO AREAS       >>           01740000
       EPVINFO'PROG= ENTP(7)#,    <<PRIVATE VOL INFO       >>           01745000
       ETRACE'PLABEL=ENTP1(7)#,   <<TRACE0' EXTERNAL LABEL >>           01750000
       EMAPSIZE    = ENTP3#;      <<# ENTRIES IN MAP ARRAY >>           01755000
                                                                        01760000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01765000
<<  (PROG FILE LOADING ENTRY - TYPE 3)                     >>           01770000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01775000
                                                                        01780000
<< NO DEFINITIONS UNIQUE TO THIS ENTRY TYPE                >>           01785000
                                                                        01790000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01795000
<<  (PROCESS WAITING ENTRY - TYPE 4)                       >>           01800000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01805000
                                                                        01810000
DEFINE EWAITINGPIN = ENTP2#;    <<PIN OF WAITING PROCESS   >>           01815000
                                                                        01820000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01825000
<<  (LOADED ENTRY - TYPE 5)                                >>           01830000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01835000
                                                                        01840000
<< NO DEFINITIONS UNIQUE TO THIS ENTRY TYPE                >>           01845000
                                                                        01850000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01855000
<<  (PROCESS INFO ENTRY - TYPE 6)                          >>           01860000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01865000
                                                                        01870000
DEFINE EPID  = ENTP(1)#;        <<PROCESS ID               >>           01875000
                                                                        01880000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01885000
<<  (DYNAMIC LOAD ENTRY - TYPE 7)                          >>           01890000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01895000
                                                                        01900000
DEFINE EEXT        = ENTP(2)#,     <<EXTENSION #           >>           01905000
       EPIN        = ENTP(1)#,     <<PIN #                 >>           01910000
       LOADPROCCOUNT=ENTP(3)#,     <<# LOADPROC'S THIS EXT#>>           01915000
       ESLINFO'EXT = ENTP(6+ENTP(5).(4:3)).(8:8)#;                      01920000
                                   <<# SLINFO AREAS        >>           01925000
                                                                        01930000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01935000
<<  (MASTER DYNAMIC LOAD ENTRY - TYPE 8)                   >>           01940000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           01945000
                                                                        01950000
DEFINE ESLID'LPROC = ENTP(2).(0:8)#, <<# SLID ENTRIES      >>           01955000
       ACTIVE'LPROCS=ENTP(2).(8:8)#, <<# ACTIVE LOADPROC'S >>           01960000
       EMCSTLS'LPROC=ENTP3.(8:8)#;   <<# MCSTLOGSEG ENTRIES>>           01965000
$PAGE                                                                   01970000
<<#########################################################>>           01975000
<<  LOCAL DEFINITIONS FOR LST                              >>           01980000
<<#########################################################>>           01985000
                                                                        01990000
INTEGER ARRAY LCTBUF(0:LCTLENGTH-1);   <<LCT BUFFER        >>           01995000
BYTE ARRAY LCTBBUF(*) = LCTBUF;        <<LCT BUFFER        >>           02000000
DOUBLE ARRAY MPROGKEY'(*) = MPROGKEY; <<PROGRAM FILE KEY   >>           02005000
INTEGER ARRAY MPROCNAME'(*)=MPROCNAME;<<PROCEDURE NAME     >>           02010000
DOUBLE LCTDBACK := 0D;          <<LOAD INFO RETURN AREA    >>           02015000
INTEGER MSTARTINGCST = LCTDBACK,<<STARTING CST #           >>           02020000
        MPLABEL      = LCTDBACK,<<STARTING PLABEL          >>           02025000
        MFERROR      = LCTDBACK,<<FILE SYS ERROR #         >>           02030000
        MERROR       = LCTDBACK+1; <<LOAD ERROR #          >>           02035000
INTEGER LCTOFFSET;              <<ADDRESS OF LCT IN LST    >>           02040000
INTEGER POINTER LPROCMASTERTAB; <<PTR TO LOCAL COPY OF     >>           02045000
                                <<LOADPROCMASTER ENTRY     >>           02050000
$PAGE                                                                   02055000
<<--------------------------------------------------------->>           02060000
<<                                                         >>           02065000
<< PROGRAM FILE DEFINITIONS                                >>           02070000
<<                                                         >>           02075000
<<--------------------------------------------------------->>           02080000
                                                                        02085000
EQUATE PROGFILECODE  = 1029;    <<CODE FOR PROGRAM FILE    >>           02090000
DEFINE PZERODB       = (LOGICAL(PROGREC0.(2:1)))#,                      02095000
                                   <<ZERO DB AREA FLAG     >>           02100000
       PCAPABILITY   = PROGREC0.(6:10)#,<<CAPABILITY LIST  >>           02105000
       PPRIVMODE     = PROGREC0.(9:1)#,<<PRIV MODE CAP.    >>           02110000
       PNRSEGS       = PROGREC0(1)#,   <<# CODE SEGMENTS   >>           02115000
       PGLOBALSIZE   = PROGREC0(2)#,   <<GLOBAL AREA SIZE  >>           02120000
       PGLOBALRECD   = PROGREC0(3)#,   <<GLOBAL AREA RECD# >>           02125000
       PSEGMENTRECD  = PROGREC0(4)#,   <<SEGMENT LIST RECD >>           02130000
       PSTACKSIZE    = PROGREC0(5)#,   <<STACK SIZE        >>           02135000
       PDLSIZE       = PROGREC0(6)#,   <<DL SIZE           >>           02140000
       PMAXDATA      = PROGREC0(7)#,   <<MAX DATA SIZE     >>           02145000
       PENTRYRECD    = PROGREC0(8)#,   <<ENTRY PT LIST RECD>>           02150000
       PSTARTINGSEG  = PROGREC0(9)#,   <<STARTING SEG #    >>           02155000
       PSTARTINGADR  = PROGREC0(10)#,  <<STARTING PB ADDR  >>           02160000
       PSASTLT       = PROGREC0(11)#,  <<STLT ADDRESS      >>           02165000
       PSAFLUT       = PROGREC0(12)#,  <<FLUT ADDRESS      >>           02170000
       PEXTERNALRECD = PROGREC0(13)#,  <<EXTERNAL LIST RECD>>           02175000
       PSTARTINGSTT  = PROGREC0(14)#,  <<STARTING STT #    >>           02180000
       PSATRAPCOM    = PROGREC0(15)#;  <<TRAPCOM ADDRESS   >>           02185000
DEFINE PROGEXTSTT    = (1:1)#;  <<FLAG IN SEG DESC ARRAY   >>           02190000
                                <<=1 IF STT IN MAPPED FORM >>           02195000
                                                                        02200000
<<#########################################################>>           02205000
<<  LOCAL DEFINITIONS FOR PROGRAM FILE                     >>           02210000
<<#########################################################>>           02215000
                                                                        02220000
INTEGER PROGFNUM;               <<PROGRAM FILE NUMBER      >>           02225000
DOUBLE PROGKEY;                 <<PROGRAM FILE KEY         >>           02230000
INTEGER POINTER PROGREC0;       <<PTR TO PROG FILE REC 0   >>           02235000
BYTE POINTER PROGMAP;           <<PTR TO PROGMAP ARRAY     >>           02240000
LOGICAL LASTPROGLOADLOGICAL;    <<TRUE IF LAST LOAD OF PROG>>           02245000
                                <<WAS WITH MAPPED FIRMWARE >>           02250000
INTEGER NPA;                    <<# PROGRAM SEGMENTS       >>           02255000
$PAGE                                                                   02260000
<<--------------------------------------------------------->>           02265000
<<                                                         >>           02270000
<< SL FILE DEFINITIONS                                     >>           02275000
<<                                                         >>           02280000
<<--------------------------------------------------------->>           02285000
                                                                        02290000
EQUATE SLFILECODE    = 1031,    <<CODE FOR SL FILE         >>           02295000
       SLFILEID      = 3,       <<SL FILE VERSION #        >>           02300000
       SLFHI         = 33;      <<FIRST HASH BUCKET INDEX  >>           02305000
                                                                        02310000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02315000
<<  (RECORD 0 - CONTROL INFORMATION)                       >>           02320000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02325000
                                                                        02330000
DEFINE SLID          = SLREC0#; <<SL FILE VERSION #        >>           02335000
                                                                        02340000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02345000
<<  DIRECTORY ENTRIES                                      >>           02350000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02355000
                                                                        02360000
INTEGER POINTER SLP,            <<ENTRY PTR                >>           02365000
                SLP1;           <<SECONDARY ENTRY PTR      >>           02370000
DEFINE SLNAME        = SLP#,    <<ENTRY POINT NAME         >>           02375000
       SLPLABEL      = SLP1#,   <<ENTRY POINT PLABEL       >>           02380000
       SLSTTNR       = SLP1.(0:8)#,<<ENTRY POINT STT #     >>           02385000
       SLSEGNR       = SLP1.(8:8)#,<<ENTRY POINT SEG #     >>           02390000
       SLPARMS       = SLP1(1)#;<<ENTRY POINT PARM INFO    >>           02395000
                                                                        02400000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02405000
<<  REFERENCE TABLE DEFINITIONS                            >>           02410000
<<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++>>           02415000
                                                                        02420000
INTEGER POINTER RTP;            <<REF TABLE ENTRY PTR      >>           02425000
LOGICAL POINTER RTLP = RTP;     <<REF TABLE ENTRY PTR      >>           02430000
DOUBLE POINTER RTDP = RTP;      <<REF TABLE ENTRY PTR      >>           02435000
DEFINE SLSLD        = RTP#,     <<SEGMENT DESCRIPTOR       >>           02440000
       REFTAB'EXTSTT = RTP.(1:1)#,  << =1 IF STT IN MAPPED >>           02445000
                                    << FORM                >>           02450000
       SLSL          = RTP.(2:14)#,<<SEGMENT LENGTH        >>           02455000
       SLSA          = RTP(1)#, <<SEGMENT ADDRESS          >>           02460000
       SLNRRECS      = RTP(2)#, <<# RECORDS FOR SEGMENT    >>           02465000
                                << AND EXTERNAL LIST       >>           02470000
       SLFLAGS       = RTLP(3)#,<<SEGMENT FLAGS            >>           02475000
       SLSATISFIEDSEG= RTLP(3).(1:1)#,<<FLAG ALL EXTERNALS >>           02480000
                                      <<OF SEG SATISFIED   >>           02485000
       SLALLOCATEDSEG= RTLP(3).(4:1)#,<<FLAG SEG ALLOCATED >>           02490000
                                      <<PERMANENTLY        >>           02495000
       SLCORESEG     = RTLP(3).(5:1)#,<<FLAG SEG CORE RES  >>           02500000
       SLSYSTEMSEG   = RTLP(3).(6:1)#,<<FLAG SEG SYSTEM SEG>>           02505000
       SLSEGNAME     = RTP(8)#, <<SEGMENT NAME             >>           02510000
       SLREFEDSEGS   = RTP(16)#;<<BIT MAP OF REF'ED SEGS   >>           02515000
$PAGE                                                                   02520000
<<#########################################################>>           02525000
<<  LOCAL SL FILE DEFINITIONS                              >>           02530000
<<#########################################################>>           02535000
                                                                        02540000
INTEGER SLNR;                   <<CURRENT SL #             >>           02545000
INTEGER ARRAY SLFNAME(*) = DB;  <<SL FILE NAMES BUFFER     >>           02550000
BYTE ARRAY SSLFNAME(0:10),      <<SYSTEM SL NAME           >>           02555000
           PSLFNAME(0:15),      <<ACCOUNT SL NAME          >>           02560000
           GSLFNAME(0:20);      <<GROUP SL NAME            >>           02565000
INTEGER ARRAY SLFNUM(0:15);     <<SL FILE NUMBERS          >>           02570000
DOUBLE ARRAY SLKEY(0:15);       <<SL FILE KEYS             >>           02575000
ARRAY SLCAP(0:15);              <<SL CAPABILITIES          >>           02580000
INTEGER ARRAY SLREC0(*) = BUF1; <<SL RECORD 0 BUFFER       >>           02585000
INTEGER ARRAY SLREC1(0:15);     <<PTR TO EACH SL'S RECORD 1>>           02590000
INTEGER ARRAY SLDIR(*) = BUF2;  <<SL DIRECTORY BUFFER      >>           02595000
INTEGER ARRAY RTBUF(*) = BUF2;  <<SL REFERENCE TABLE BUFFER>>           02600000
DOUBLE DRTRECD;                 <<CURRENT REF TAB RECORD # >>           02605000
INTEGER RTRECD=DRTRECD+1;                                               02610000
LOGICAL ARRAY SLSEGS(0:15);     <<PTR TO SL'S REF'D SEG MAP>>           02615000
INTEGER ARRAY SLPVINFO(0:15);   <<SL PRIVATE VOL INFO      >>           02620000
INTEGER ARRAY NSLA(0:15);       <<# SEGS ALLOCATED IN SL   >>           02625000
$PAGE                                                                   02630000
<<--------------------------------------------------------->>           02635000
<<                                                         >>           02640000
<< SL ENTRY POINT CACHE DEFINITIONS                        >>           02645000
<<                                                         >>           02650000
<<--------------------------------------------------------->>           02655000
                                                                        02660000
DEFINE LOADCACHESEG  = ABS(ABS(%1377)+%1072)#; <<DST #     >>           02665000
EQUATE BUCKETSIZE    = 42,      <<SIZE OF EACH CACHE BUCKET>>           02670000
       CACHEHITS     = 0,       <<HIT COUNTER POINTER      >>           02675000
       CACHEMISSES   = 2,       <<MISS COUNTER POINTER     >>           02680000
       BUCKET0       = 4,       <<FIRST BUCKET POINTER     >>           02685000
       NBUCKETS      = 95;      <<NUMBER OF BUCKETS        >>           02690000
                                                                        02695000
<<#########################################################>>           02700000
<<  LOCAL SL ENTRY POINT CACHE DEFINITIONS                 >>           02705000
<<#########################################################>>           02710000
                                                                        02715000
LOGICAL ARRAY WBUCKET(0:BUCKETSIZE-1);<<SINGLE BUCKET BUFFER>>          02720000
DOUBLE HITS,                    <<CACHE HIT COUNT          >>           02725000
       MISSES;                  <<CACHE MISS COUNT         >>           02730000
$PAGE                                                                   02735000
<<--------------------------------------------------------->>           02740000
<<                                                         >>           02745000
<< LOGICAL MAPPING SEGMAP DEFINITIONS                      >>           02750000
<<                                                         >>           02755000
<<--------------------------------------------------------->>           02760000
                                                                        02765000
DEFINE LOGICALMAPPING = ABS(%1220)#; <<TRUE IF MAPPING     >>           02770000
                                     <<FIRMWARE IS PRESENT >>           02775000
DEFINE SEGTABDST'EX = ABS(%1226)#;                             <<06541>>02780000
INTEGER ARRAY SEGMAP(*) = DB+0; <<SEGMAP ARRAY             >>           02785000
                                                                        02790000
$INCLUDE INCLPCB5                                              <<06641>>02795000
                                                                        02800000
<<#########################################################>>           02805000
<<  LOCAL LOGICAL MAPPING DEFINITIONS                      >>           02810000
<<#########################################################>>           02815000
                                                                        02820000
EQUATE INITSEGMAPSIZE = 2040,   <<INITIAL SEGMAP SIZE      >>           02825000
       MAXSEGMAPSIZE  = 4090;   <<INITIAL SEGMAP VDS SIZE  >>           02830000
INTEGER SEGMAPDST,              <<SEGMAP DST #             >>           02835000
        OLDSEGMAPDST,           <<INITIAL SEGMAP DST #     >>           02840000
        SEGMAPSEGCOUNT,         <<NEXT ENTRY POSITION IN MAP>>          02845000
        SEGMAPSTTPOSITION,      <<NEXT STT POSITION IN MAP >>           02850000
        SEGMAPLENGTH;           <<LENGTH OF SEGMAP DST     >>           02855000
INTEGER PCBPT;  << INDEX OF PCB ENTRY >>                                02860000
LOGICAL NEEDSEGMAP;                                                     02865000
INTEGER POINTER MCSTTAB;        <<PTR TO TABLE OF AVAILABLE>>           02870000
                                <<MAPPED CST INDICES       >>           02875000
INTEGER MAXMCSTIDX;             <<MAX MAPPED CST INDEX USED>>           02880000
$PAGE                                                                   02885000
$PAGE                                                                   02890000
<<----------------------------------------------------------->>         02895000
<<                                                           >>         02900000
<< UNSATISFIED EXTERNAL TABLE AND PARAMETERS                 >>         02905000
<<                                                           >>         02910000
<<----------------------------------------------------------->>         02915000
                                                                        02920000
INTEGER POINTER SAVEUXP;  <<SAVE ENTRY POINTER>>                        02925000
INTEGER POINTER UXP;  <<POINTS TO NAME>>                                02930000
INTEGER POINTER UXP1;  <<SECONDARY POINTER>>                            02935000
INTEGER POINTER UXP2;  <<SECONDARY POINTER>>                            02940000
INTEGER UXNW;  <<NR. WORDS IN ENTRY>>                                   02945000
INTEGER UXNC;  <<NR. CHAR'S IN NAME>>                                   02950000
DEFINE UXNAME = UXP#,  <<EXTERNAL NAME>>                                02955000
       UXUTYPE = UXP1.(0:4)#,  <<ORIGIN OF EXTERNAL>>                   02960000
       UXSTYPE = UXP1.(4:4)#,  <<SATISFIER OF EXTERNAL>>                02965000
       UXNR = UXP1.(8:8)#,  <<NR. REFERENCES>>                          02970000
       UXPARMS = UXP2#;  <<PARM. INFO>>                                 02975000
$PAGE                                                                   02980000
<<----------------------------------------------------------->>         02985000
<<                                                           >>         02990000
<< SATISFIED EXTERNAL TABLE AND PARAMETERS                   >>         02995000
<<                                                           >>         03000000
<<----------------------------------------------------------->>         03005000
                                                                        03010000
INTEGER ARRAY SLDB'SEG'DIR(0:255); <<DIRECTORY FOR SLDB SEG>>           03015000
                                   <<ENTRIES--1 SLOT PER 16>>           03020000
                                   <<LOGICAL SEG NUMBERS   >>           03025000
INTEGER ARRAY SLDATABASE(0:15)=DB; <<REF'ED SEGS DATA BASE>>            03030000
    <<LOCAL SLDATABASE SEG ENTRY DEFINITIONS>>                          03035000
    DEFINE SEGNEXT  = 0#,         <<LINK TO NEXT ENTRY>>                03040000
           DBMCST   = 1).(0:8#,   <<MCST>>                              03045000
           DBLOGSEG = 1).(8:8#,   <<LOGSEG>>                            03050000
           STTNEXT  = 2#,         <<LINK TO STT ENTRY>>                 03055000
           DBPHYCST = 3#,         <<PHYCST>>                            03060000
           DBMAPFLAG= 4).(15:1#,  <<MAPFLAG>>                           03065000
           DBFLAGS  = 4).(12:4#,  <<A,C,X,M BITS>>                      03070000
           DBXBIT   = 4).(14:1#,  <<X BIT>>                             03075000
           DBNEWFLAG= 4).(11:1#,  <<NEWLY ALLOCATED>>                   03080000
           DBREFFLAG= 4).(10:1#,  <<REF'ED PREVIOUSLY>>                 03085000
           DBLBIT   = 4).(9:1#;   <<BEING ALLOCATED>>                   03090000
                                                                        03095000
    <<SLDATABASE STT ENTRY DEFINITIONS>>                                03100000
    DEFINE DBSTT    = 0).(8:8#,   <<STT #>>                             03105000
           DBPLABEL = 1#,         <<PLABEL>>                            03110000
           DBSAT    = 0).(0:4#;   <<SATISFIER SOURCE>>                  03115000
$PAGE                                                                   03120000
<<----------------------------------------------------------->>         03125000
<<                                                           >>         03130000
<< PROCEDURE DECLARATIONS                                    >>         03135000
<<                                                           >>         03140000
<<----------------------------------------------------------->>         03145000
                                                                        03150000
PROCEDURE SUDDENDEATH(E);                                               03155000
  VALUE E; INTEGER E;                                                   03160000
  OPTION EXTERNAL;                                                      03165000
INTEGER PROCEDURE ENTRYLENGTH;                                          03170000
  OPTION EXTERNAL;                                                      03175000
INTEGER PROCEDURE ALTDSEGSIZE(DST,DELTA);                               03180000
  VALUE DST,DELTA; INTEGER DST,DELTA;                                   03185000
  OPTION EXTERNAL;                                                      03190000
PROCEDURE ADJREFCOUNTS (AMOUNT);                                        03195000
   VALUE AMOUNT;                                                        03200000
   INTEGER AMOUNT;                                                      03205000
   OPTION EXTERNAL;                                                     03210000
INTEGER PROCEDURE ALCSTBLOCK(NUM);                                      03215000
   VALUE NUM;                                                           03220000
    INTEGER NUM;                                                        03225000
   OPTION EXTERNAL;                                                     03230000
PROCEDURE AWAKE (PCBINDEX,OLDWAIT,NEWWAIT);                             03235000
   VALUE PCBINDEX,OLDWAIT,NEWWAIT;                                      03240000
   INTEGER PCBINDEX,OLDWAIT,NEWWAIT;                                    03245000
   OPTION EXTERNAL;                                                     03250000
PROCEDURE BLANKLINE;                                                    03255000
   OPTION FORWARD;                                                      03260000
PROCEDURE CLEARBITMAP (BITMAP);                                         03265000
   ARRAY BITMAP;                                                        03270000
   OPTION FORWARD;                                                      03275000
PROCEDURE CLEARBUFFER (BUFFER);                                         03280000
   ARRAY BUFFER;                                                        03285000
   OPTION FORWARD;                                                      03290000
PROCEDURE CLEARLINE;                                                    03295000
   OPTION FORWARD;                                                      03300000
PROCEDURE RELDATASEG(DST);                                              03305000
  VALUE DST; INTEGER DST;                                               03310000
  OPTION EXTERNAL;                                                      03315000
PROCEDURE DEALCSTBLOCK(IX);                                             03320000
   VALUE IX;                                                            03325000
   INTEGER IX;                                                          03330000
   OPTION EXTERNAL;                                                     03335000
DOUBLE PROCEDURE DIRECFIND (T,LINKAGE'INDEXP,ACCT,                      03340000
                            GROUP,DUM,BUF);                             03345000
   VALUE T,LINKAGE'INDEXP;                                              03350000
   INTEGER T;                                                           03355000
   DOUBLE  LINKAGE'INDEXP;                                              03360000
   ARRAY ACCT,GROUP,DUM,BUF;                                            03365000
   OPTION EXTERNAL;                                                     03370000
INTEGER PROCEDURE DLSIZE (SIZE);                                        03375000
   VALUE SIZE;                                                          03380000
   INTEGER SIZE;                                                        03385000
   OPTION EXTERNAL;                                                     03390000
INTEGER PROCEDURE EXCHANGEDB (DSTNR);                                   03395000
   VALUE DSTNR; INTEGER DSTNR;                                          03400000
   OPTION EXTERNAL;                                                     03405000
PROCEDURE EXTNPARMS;                                                    03410000
   OPTION FORWARD;                                                      03415000
PROCEDURE FCHECK (FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);               03420000
   VALUE FILENUM;                                                       03425000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              03430000
   DOUBLE BLKNUM;                                                       03435000
   OPTION VARIABLE,EXTERNAL;                                            03440000
PROCEDURE FCLOSE (FILENUM,DISPOSITION,SECCODE);                         03445000
   VALUE FILENUM,DISPOSITION,SECCODE;                                   03450000
   INTEGER FILENUM,DISPOSITION,SECCODE;                                 03455000
   OPTION EXTERNAL;                                                     03460000
INTRINSIC FCONTROL;                                                     03465000
PROCEDURE FERROR (FNUM);                                                03470000
   VALUE FNUM;                                                          03475000
   INTEGER FNUM;                                                        03480000
   OPTION FORWARD;                                                      03485000
DOUBLE PROCEDURE FGETDISKADR (FNUM,RECNUM);                             03490000
   VALUE FNUM,RECNUM;                                                   03495000
   INTEGER FNUM;                                                        03500000
   DOUBLE RECNUM;                                                       03505000
   OPTION EXTERNAL;                                                     03510000
PROCEDURE FGETINFO (FILENUM,FILENAME,FOPTIONS,AOPTIONS,RECSIZE,         03515000
      DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,FLIMIT,LOGCOUNT,         03520000
      PHYSCOUNT,BLKSIZE,EXTSIZE,NUMEXTENTS,USERLABEL,CREATORID,         03525000
      DISKADR);                                                         03530000
   VALUE FILENUM;                                                       03535000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,NUMEXTENTS,         03540000
      USERLABEL;                                                        03545000
   BYTE ARRAY FILENAME,CREATORID;                                       03550000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;                      03555000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;                 03560000
   OPTION VARIABLE,EXTERNAL;                                            03565000
PROCEDURE ADDTOLOCALITY(SLLINX,SEGID,FLAGS);                   <<06641>>03570000
   VALUE SLLINX,SEGID,FLAGS;                                   <<06641>>03575000
   INTEGER SLLINX,FLAGS;                                       <<06641>>03580000
   DOUBLE SEGID;                                               <<06641>>03585000
   OPTION EXTERNAL;                                            <<06641>>03590000
LOGICAL PROCEDURE SETSYSDB;                                             03595000
   OPTION EXTERNAL;                                                     03600000
PROCEDURE RESETDB(WHERE);                                               03605000
   VALUE WHERE;                                                         03610000
   INTEGER WHERE;                                                       03615000
   OPTION EXTERNAL;                                                     03620000
PROCEDURE FLOCK (FILENUM,FLAG);                                         03625000
   VALUE FILENUM,FLAG;                                                  03630000
   INTEGER FILENUM;                                                     03635000
   LOGICAL FLAG;                                                        03640000
   OPTION EXTERNAL;                                                     03645000
INTEGER PROCEDURE FOPEN (FILEDESIGNATOR,FOPTIONS,AOPTIONS,              03650000
      RECSIZE,DEVICE,FORMMSG,RECMODE,BLOCKFACTOR,NUMBUFFERS,            03655000
      FILESIZE,NUMEXTENTS,INITALLOC,FILECODE);                          03660000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,RECMODE,BLOCKFACTOR,                 03665000
      NUMBUFFERS,FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                03670000
   BYTE ARRAY FILEDESIGNATOR,DEVICE,FORMMSG;                            03675000
   LOGICAL FOPTIONS,AOPTIONS;                                           03680000
   INTEGER RECSIZE,RECMODE,BLOCKFACTOR,NUMBUFFERS,NUMEXTENTS,           03685000
      INITALLOC,FILECODE;                                               03690000
   DOUBLE FILESIZE;                                                     03695000
   OPTION VARIABLE,EXTERNAL;                                            03700000
INTEGER PROCEDURE FOPENDA (LDNUM,DISKADR,AOPTIONS,NUMBUF,      <<06094>>03705000
   FILECODE,DNTYPE,DISP,FOPTIONS,PVINFO,COMINFO);              <<06094>>03710000
   VALUE LDNUM,DISKADR,AOPTIONS,NUMBUF,FILECODE,               <<06094>>03715000
         DNTYPE,DISP,FOPTIONS,PVINFO;                          <<06094>>03720000
   INTEGER LDNUM,AOPTIONS,NUMBUF,FILECODE,DNTYPE,DISP,PVINFO,  <<06094>>03725000
           FOPTIONS;                                           <<06094>>03730000
   ARRAY COMINFO;                                              <<06094>>03735000
   DOUBLE DISKADR;                                             <<06094>>03740000
   OPTION VARIABLE,EXTERNAL;                                   <<06094>>03745000
PROCEDURE FCLOSEDA (FILENUM,DISP,SECCODE);                              03750000
    VALUE   FILENUM,DISP,SECCODE;                                       03755000
    INTEGER FILENUM,DISP,SECCODE;                                       03760000
    OPTION EXTERNAL;                                                    03765000
PROCEDURE FREADDIR (FILENUM,TARGET,TCOUNT,RECNUM);                      03770000
   VALUE FILENUM,TCOUNT,RECNUM;                                         03775000
   INTEGER FILENUM,TCOUNT;                                              03780000
   ARRAY TARGET;                                                        03785000
   DOUBLE RECNUM;                                                       03790000
   OPTION EXTERNAL;                                                     03795000
PROCEDURE FUNLOCK (FILENUM);                                            03800000
   VALUE FILENUM;                                                       03805000
   INTEGER FILENUM;                                                     03810000
   OPTION EXTERNAL;                                                     03815000
PROCEDURE FWRITE (FILENUM,TARGET,TCOUNT,CONTROL);                       03820000
   VALUE FILENUM,TCOUNT,CONTROL;                                        03825000
   INTEGER FILENUM,TCOUNT,CONTROL;                                      03830000
   ARRAY TARGET;                                                        03835000
   OPTION EXTERNAL;                                                     03840000
PROCEDURE FWRITEDIR (FILENUM,TARGET,TCOUNT,RECNUM);                     03845000
   VALUE FILENUM,TCOUNT,RECNUM;                                         03850000
   INTEGER FILENUM,TCOUNT;                                              03855000
   ARRAY TARGET;                                                        03860000
   DOUBLE RECNUM;                                                       03865000
   OPTION EXTERNAL;                                                     03870000
INTEGER PROCEDURE GETENTRY(LIST);                                       03875000
   VALUE LIST;                                                          03880000
   INTEGER LIST;                                                        03885000
   OPTION EXTERNAL;                                                     03890000
PROCEDURE GETREFTABENT (SEGNR);                                         03895000
   VALUE SEGNR;                                                         03900000
   INTEGER SEGNR;                                                       03905000
   OPTION FORWARD;                                                      03910000
LOGICAL PROCEDURE GETSIR (SIR);                                         03915000
   VALUE SIR;                                                           03920000
   INTEGER SIR;                                                         03925000
   OPTION EXTERNAL;                                                     03930000
INTEGER PROCEDURE LDNTOA( NUM, BASE, BA);                               03935000
   VALUE NUM, BASE;                                                     03940000
   DOUBLE NUM;                                                          03945000
   INTEGER BASE;                                                        03950000
   BYTE ARRAY BA;                                                       03955000
   OPTION FORWARD;                                                      03960000
INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                                03965000
   VALUE NUM, BASE;                                                     03970000
   INTEGER NUM, BASE;                                                   03975000
   BYTE ARRAY BA;                                                       03980000
   OPTION FORWARD;                                                      03985000
INTEGER PROCEDURE MOUNTVOLSET(FILENUM,SOME'OTHER'PIN);                  03990000
    VALUE   FILENUM,SOME'OTHER'PIN;                                     03995000
    INTEGER FILENUM,SOME'OTHER'PIN;                                     04000000
    OPTION EXTERNAL,VARIABLE;                                           04005000
INTEGER PROCEDURE DISMOUNTVOLSET (PVINFO,SOME'OTHER'PIN);               04010000
    VALUE   PVINFO,SOME'OTHER'PIN;                                      04015000
    INTEGER PVINFO,SOME'OTHER'PIN;                                      04020000
    OPTION EXTERNAL,VARIABLE;                                           04025000
PROCEDURE GETSLNAMES (FLAG);                                            04030000
   VALUE FLAG;                                                          04035000
   LOGICAL FLAG;                                                        04040000
   OPTION FORWARD;                                                      04045000
PROCEDURE HELP;                                                         04050000
   OPTION EXTERNAL;                                                     04055000
PROCEDURE LCREATE (LENGTH,TYPE,PMODE,LIBRARY,KEY);                      04060000
   VALUE LENGTH,TYPE,PMODE,LIBRARY,KEY;                                 04065000
   INTEGER LENGTH,TYPE,PMODE,LIBRARY;                                   04070000
   DOUBLE KEY;                                                          04075000
   OPTION EXTERNAL;                                                     04080000
PROCEDURE LDELETE;                                                      04085000
   OPTION EXTERNAL;                                                     04090000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                           04095000
   VALUE      MEMSIZE,VDSIZE;                                           04100000
   INTEGER    MEMSIZE,VDSIZE;                                           04105000
   OPTION     EXTERNAL;                                                 04110000
PROCEDURE INITLOADCACHE;                                                04115000
   OPTION EXTERNAL;                                                     04120000
INTEGER PROCEDURE LINELENGTH;                                           04125000
   OPTION FORWARD;                                                      04130000
PROCEDURE LOADBIT (KEY,BIT,DSTNR);                                      04135000
   VALUE KEY,BIT,DSTNR;                                                 04140000
   DOUBLE KEY;                                                          04145000
   LOGICAL BIT;                                                         04150000
   INTEGER DSTNR;                                                       04155000
   OPTION EXTERNAL;                                                     04160000
PROCEDURE LOADEXTERNALS;                                                04165000
   OPTION FORWARD;                                                      04170000
PROCEDURE LOADPROGRAM;                                                  04175000
   OPTION FORWARD;                                                      04180000
PROCEDURE LOADSEGMENT(FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD,                04185000
         SEGPTR,CAPABILITY,PRIVMODE);                                   04190000
  VALUE FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD,                              04195000
         CAPABILITY,PRIVMODE,SEGPTR;                                    04200000
  INTEGER FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD;                            04205000
  LOGICAL CAPABILITY,PRIVMODE;                                          04210000
  INTEGER POINTER SEGPTR;                                               04215000
  OPTION FORWARD;                                                       04220000
LOGICAL PROCEDURE LSEARCH (KEY,PMODE,TYPE);                             04225000
   VALUE KEY,PMODE,TYPE;                                                04230000
   DOUBLE KEY;                                                          04235000
   INTEGER PMODE,TYPE;                                                  04240000
   OPTION EXTERNAL;                                                     04245000
LOGICAL PROCEDURE LSEARCH'(KEY,PMODE,TYPE);                    <<06541>>04250000
   VALUE KEY,PMODE,TYPE;                                       <<06541>>04255000
   DOUBLE KEY;                                                 <<06541>>04260000
   INTEGER PMODE,TYPE;                                         <<06541>>04265000
   OPTION EXTERNAL;                                            <<06541>>04270000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       04275000
   VALUE NRWORDS; INTEGER NRWORDS;                                      04280000
   OPTION FORWARD;                                                      04285000
PROCEDURE NTOA (NUM,BASE,BUF);                                          04290000
   VALUE NUM,BASE;                                                      04295000
   INTEGER NUM,BASE;                                                    04300000
   BYTE ARRAY BUF;                                                      04305000
   OPTION FORWARD;                                                      04310000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                            04315000
   INTEGER ARRAY FORMALP,ACTUALP,PARMS;                                 04320000
   OPTION FORWARD;                                                      04325000
INTEGER PROCEDURE PARMLEN (PARMS);                                      04330000
   INTEGER ARRAY PARMS;                                                 04335000
   OPTION FORWARD;                                                      04340000
PROCEDURE PRINTLINE;                                                    04345000
   OPTION FORWARD;                                                      04350000
PROCEDURE PRINTLINE';                                                   04355000
   OPTION FORWARD;                                                      04360000
PROCEDURE PUTCST(EN,MASK,DEV,DISKADR,SYSFLAG);                          04365000
   VALUE EN,MASK,DEV,DISKADR;                                           04370000
   INTEGER EN,MASK,DEV;                                                 04375000
   LOGICAL SYSFLAG;                                                     04380000
   DOUBLE DISKADR;                                                      04385000
   OPTION EXTERNAL;                                                     04390000
PROCEDURE PUTCSTBLOCK(EIX,LSEGNUM,MASK,DEV,DISKADR,SYSFLAG);            04395000
   VALUE EIX,LSEGNUM,MASK,DEV,DISKADR;                                  04400000
   INTEGER EIX,LSEGNUM,MASK,DEV;                                        04405000
   LOGICAL SYSFLAG;                                                     04410000
   DOUBLE DISKADR;                                                      04415000
   OPTION EXTERNAL;                                                     04420000
PROCEDURE RELSIR (SIR,FLAG);                                            04425000
   VALUE SIR,FLAG;                                                      04430000
   INTEGER SIR,FLAG;                                                    04435000
   OPTION EXTERNAL;                                                     04440000
PROCEDURE RETURNENTRY (TYPE,ENTRYNR);                                   04445000
   VALUE TYPE,ENTRYNR;                                                  04450000
   INTEGER TYPE,ENTRYNR;                                                04455000
   OPTION EXTERNAL;                                                     04460000
LOGICAL PROCEDURE SAMENAME (NAME1,NAME2);                               04465000
   INTEGER ARRAY NAME1,NAME2;                                           04470000
   OPTION FORWARD;                                                      04475000
PROCEDURE SATISFYPROC;                                                  04480000
   OPTION FORWARD;                                                      04485000
PROCEDURE SATISFYPROG;                                                  04490000
   OPTION FORWARD;                                                      04495000
PROCEDURE SATISFY;                                                      04500000
   OPTION FORWARD;                                                      04505000
PROCEDURE SAVEREFTABBUF;                                                04510000
   OPTION FORWARD;                                                      04515000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  04520000
   VALUE BITNUMBER;                                                     04525000
   INTEGER ARRAY BITARRAY;                                              04530000
   INTEGER BITNUMBER;                                                   04535000
   OPTION FORWARD;                                                      04540000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         04545000
   VALUE BITNUMBER;                                                     04550000
   INTEGER ARRAY BITARRAY;                                              04555000
   INTEGER BITNUMBER;                                                   04560000
   OPTION FORWARD;                                                      04565000
PROCEDURE UNIMPEDE(P);                                                  04570000
   VALUE P;                                                             04575000
   INTEGER P;                                                           04580000
   OPTION EXTERNAL;                                                     04585000
PROCEDURE UPDATESEGTAB;                                                 04590000
   OPTION FORWARD;                                                      04595000
PROCEDURE VALIDCAP (FLAG);                                              04600000
   VALUE FLAG;                                                          04605000
   LOGICAL FLAG;                                                        04610000
   OPTION FORWARD;                                                      04615000
PROCEDURE LINKLSTENTRY;                                                 04620000
  OPTION EXTERNAL;                                                      04625000
PROCEDURE UNLINKLSTENTRY;                                               04630000
  OPTION EXTERNAL;                                                      04635000
PROCEDURE BUILDGARBAGE(POSITION,LENGTH);                                04640000
  VALUE POSITION,LENGTH;                                                04645000
  INTEGER POSITION,LENGTH;                                              04650000
  OPTION EXTERNAL;                                                      04655000
INTEGER PROCEDURE GET'PHY'CST;                                 <<06281>>04660000
   OPTION EXTERNAL;                                            <<06281>>04665000
INTEGER PROCEDURE GETDATASEGC(MSIZE,VSIZE);                    <<06541>>04670000
   VALUE MSIZE,VSIZE;                                          <<06541>>04675000
   INTEGER MSIZE,VSIZE;                                        <<06541>>04680000
   OPTION EXTERNAL;                                            <<06541>>04685000
PROCEDURE TRANS'LST'TO'XDST;                                   <<06541>>04690000
   OPTION EXTERNAL;                                            <<06541>>04695000
PROCEDURE ADJUSTLOCALITY(PROCINX,OBJID,REQSIZE,FLAGS);         <<07300>>04700000
   VALUE PROCINX,OBJID,REQSIZE,FLAGS;                          <<07300>>04705000
   LOGICAL PROCINX,REQSIZE,FLAGS;                              <<07300>>04710000
   DOUBLE OBJID;                                               <<07300>>04715000
   OPTION EXTERNAL;                                            <<07300>>04720000
INTRINSIC FSETMODE;                                            <<07301>>04725000
PROCEDURE SENDMSG(DESCPIN,SUBQ,MSGLENGTH,FLAGS);               <<*7545>>04730000
   VALUE DESCPIN,SUBQ,MSGLENGTH,FLAGS;                         <<*7545>>04735000
   INTEGER DESCPIN,SUBQ,MSGLENGTH;                             <<*7545>>04740000
   LOGICAL FLAGS;                                              <<*7545>>04745000
   OPTION EXTERNAL;                                            <<*7545>>04750000
PROCEDURE RECEIVEMSG(SUBQ,MSGLENGTH,FLAGS);                    <<*7545>>04755000
   VALUE SUBQ,MSGLENGTH,FLAGS;                                 <<*7545>>04760000
   INTEGER SUBQ,MSGLENGTH;                                     <<*7545>>04765000
   LOGICAL FLAGS;                                              <<*7545>>04770000
   OPTION EXTERNAL;                                            <<*7545>>04775000
$PAGE                                                                   04780000
<<----------------------------------------------------------->>         04785000
<<                                                           >>         04790000
<< UTILITY PROCEDURES                                        >>         04795000
<<                                                           >>         04800000
<<----------------------------------------------------------->>         04805000
                                                                        04810000
LOGICAL PROCEDURE TESTBIT (BITARRAY,BITNUMBER);                         04815000
  <<TESTS BIT NUMBER BITNUMBER IN THE BIT ARRAY BITARRAY>>              04820000
  VALUE BITNUMBER;                                                      04825000
  INTEGER ARRAY BITARRAY;                                               04830000
  INTEGER BITNUMBER;                                                    04835000
  OPTION UNCALLABLE;                                                    04840000
  BEGIN                                                                 04845000
    TOS := BITNUMBER.(0:12)+@BITARRAY;                                  04850000
    TOS := PS0;                                                         04855000
    XREG := BITNUMBER.(12:4);                                           04860000
    ASSEMBLE(CSL 1,X);                                                  04865000
    TESTBIT := TOS                                                      04870000
  END;                                                                  04875000
$PAGE                                                                   04880000
PROCEDURE SETBIT (BITARRAY,BITNUMBER);                                  04885000
  <<SETS BIT NUMBER BITNUMBER IN THE BIT ARRAY BITARRAY>>               04890000
  VALUE BITNUMBER;                                                      04895000
  INTEGER ARRAY BITARRAY;                                               04900000
  INTEGER BITNUMBER;                                                    04905000
  OPTION UNCALLABLE;                                                    04910000
  BEGIN                                                                 04915000
    TOS := BITNUMBER.(0:12)+@BITARRAY;                                  04920000
    TOS := PS0;                                                         04925000
    XREG := BITNUMBER;                                                  04930000
    ASSEMBLE(TSBC 0,X);                                                 04935000
    PS1 := TOS                                                          04940000
  END;                                                                  04945000
$PAGE                                                                   04950000
INTEGER PROCEDURE NEXTBIT(BITARRAY);                                    04955000
  <<RETURN NEXT AVAILABLE INDEX FROM BITARRAY>>                         04960000
  <<IF NONE AVAILABLE RETURN 0             >>                           04965000
  INTEGER ARRAY BITARRAY;                                               04970000
  BEGIN                                                                 04975000
    INTEGER INDEX:=0;                                                   04980000
    <<SEARCH FOR AVAILABLE INDEX>>                                      04985000
    WHILE (INDEX:=INDEX+1) <= 255 DO                                    04990000
      BEGIN                                                             04995000
        IF NOT TESTBIT(BITARRAY,INDEX) THEN                             05000000
          BEGIN            <<FOUND AVAILABLE INDEX>>                    05005000
            <<RESERVE INDEX>>                                           05010000
            SETBIT(BITARRAY,INDEX);                                     05015000
            NEXTBIT:=INDEX;                                             05020000
            RETURN;                                                     05025000
          END;                                                          05030000
      END; <<WHILE>>                                                    05035000
    <<NO AVAILABLE INDEX>>                                              05040000
    NEXTBIT:=0;                                                         05045000
  END;                                                                  05050000
$PAGE                                                                   05055000
PROCEDURE CLEARBITMAP (BITMAP);                                         05060000
  <<CLEARS A 16 WORD BIT MAP>>                                          05065000
  ARRAY BITMAP;                                                         05070000
  OPTION UNCALLABLE;                                                    05075000
  BEGIN                                                                 05080000
    TOS := @BITMAP; PS0 := 0;                                           05085000
    ASSEMBLE(DUP,INCB); TOS := 15; ASSEMBLE(MOVE 3)                     05090000
  END;                                                                  05095000
$PAGE                                                                   05100000
PROCEDURE CLEARBUFFER (BUFFER);                                         05105000
  <<CLEARS A 128 WORD BUFFER>>                                          05110000
  ARRAY BUFFER;                                                         05115000
  OPTION UNCALLABLE;                                                    05120000
  BEGIN                                                                 05125000
    TOS := @BUFFER; PS0 := 0;                                           05130000
    ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3)                    05135000
  END;                                                                  05140000
$PAGE                                                                   05145000
INTEGER PROCEDURE FINDSEGENTRY(SLNR,SEGNR);                             05150000
  VALUE SLNR,SEGNR;                                                     05155000
  INTEGER SLNR,SEGNR;                                                   05160000
  <<FIND SEG ENTRY IN SATISFIED DATA BASE>>                             05165000
  <<FOUND- RETURN POINTER TO ENTRY   >>                                 05170000
  <<     - CONDITION CODE=CCE        >>                                 05175000
  <<NOT FOUND - RETURN 0             >>                                 05180000
  <<          - CONDITION CODE=CCL   >>                                 05185000
  <<SLNR--SL CHAIN TO USE>>                                             05190000
  <<SEGNR--LOG SEG # FOR SEARCH>>                                       05195000
  BEGIN                                                                 05200000
    INTEGER POINTER SEGPTR;                                             05205000
    INTEGER INDEX;                                                      05210000
    INDEX:=SLNR&LSL(4)+SEGNR&LSR(4); <<DIRECTORY INDEX>>                05215000
    @SEGPTR:=SLDB'SEG'DIR(INDEX);    <<PTR FOR SEARCH START>>           05220000
    <<SEARCH FOR ENTRY>>                                                05225000
    WHILE @SEGPTR <> 0 AND                                              05230000
          SEGPTR(DBLOGSEG) <> SEGNR DO                                  05235000
      BEGIN                 <<WRONG ENTRY-GO NEXT>>                     05240000
        IF SEGPTR(DBLOGSEG) < SEGNR                                     05245000
          THEN @SEGPTR:=SEGPTR(SEGNEXT) <<KEEP UP SEARCH>>              05250000
          ELSE @SEGPTR:=0;           <<STOP SEARCH>>                    05255000
      END; <<WHILE>>                                                    05260000
    <<RETURN INFO >>                                                    05265000
    FINDSEGENTRY:=@SEGPTR;           <<RETURN PTR>>                     05270000
    IF @SEGPTR <> 0                                                     05275000
      THEN CONDCODE:=CCE             <<FOUND CODE>>                     05280000
      ELSE CONDCODE:=CCL;            <<NOT FOUND CODE>>                 05285000
    RETURN;                                                             05290000
  END;                                                                  05295000
$PAGE                                                                   05300000
INTEGER PROCEDURE FINDSTTENTRY(SEGPTR,STTNR,STTPTR);                    05305000
  VALUE STTNR,SEGPTR,STTPTR;                                            05310000
  INTEGER STTNR;                                                        05315000
  INTEGER POINTER SEGPTR,STTPTR;                                        05320000
  <<FIND STT ENTRY IN SATISFIED DATA BASE>>                             05325000
  <<ENTRY FOUND - RETURN POINTER TO ENTRY>>                             05330000
  <<            - CONDITION CODE=CCE     >>                             05335000
  <<ENTRY NOT FOUND - RETURN 0           >>                             05340000
  <<                - CONDITION CODE=CCL >>                             05345000
  <<SEGPTR--PTR TO HEAD SEG ENTRY        >>                             05350000
  <<STTNR --STT # FOR SEARCH             >>                             05355000
  <<STTPTR--STARTING PTR IN SEARCH       >>                             05360000
  <<         =0 - START AT HEAD          >>                             05365000
  <<        <>0 - START AT STTPTR        >>                             05370000
  BEGIN                                                                 05375000
    IF @STTPTR = 0 THEN                                                 05380000
      BEGIN                 <<START SEARCH AT HEAD>>                    05385000
        @STTPTR:=SEGPTR(STTNEXT);                                       05390000
      END;                                                              05395000
    <<SEARCH FOR ENTRY>>                                                05400000
    WHILE @STTPTR <> 0 AND                                              05405000
          STTPTR(DBSTT) <> STTNR DO                                     05410000
      BEGIN                 <<WRONG ENTRY-GO NEXT>>                     05415000
        IF STTPTR(DBSTT) < STTNR                                        05420000
          THEN @STTPTR:=STTPTR(STTNEXT) <<KEEP UP SEARCH>>              05425000
          ELSE @STTPTR:=0;           <<STOP SEARCH>>                    05430000
      END; <<WHILE>>                                                    05435000
    <<RETURN INFO >>                                                    05440000
    FINDSTTENTRY:=@STTPTR;           <<RETURN PTR>>                     05445000
    IF @STTPTR <> 0                                                     05450000
      THEN CONDCODE:=CCE             <<FOUND CODE>>                     05455000
      ELSE CONDCODE:=CCL;            <<NOT FOUND CODE>>                 05460000
    RETURN;                                                             05465000
  END;                                                                  05470000
$PAGE                                                                   05475000
INTEGER PROCEDURE BLDSEGENTRY(SLNR,SEGNR);                              05480000
  VALUE SLNR,SEGNR;                                                     05485000
  INTEGER SLNR,SEGNR;                                                   05490000
  <<BUILD SEG ENTRY FOR SATISFIED DATA BASE>>                           05495000
  <<ENTRY BUILT - RETURN POINTER TO ENTRY>>                             05500000
  <<            - CONDITION CODE=CCE     >>                             05505000
  <<ENTRY NOT BUILT - RETURN 0           >>                             05510000
  <<                - CONDITION CODE=CCL >>                             05515000
  <<SLNR--SL CHAIN TO USE>>                                             05520000
  <<SEGNR--LOG SEG NR FOR ENTRY>>                                       05525000
  BEGIN                                                                 05530000
    INTEGER POINTER OLDSEGPTR,CURRSEGPTR,NEWSEGPTR;                     05535000
    INTEGER INDEX,INDEX2;                                               05540000
    <<CHECK IF ENTRY ALREADY EXISTS>>                                   05545000
    BLDSEGENTRY:=FINDSEGENTRY(SLNR,SEGNR);                              05550000
    IF = THEN                                                           05555000
      BEGIN                <<ENTRY ALREADY EXISTS>>                     05560000
        CONDCODE:=CCE;     <<OK CODE             >>                     05565000
        RETURN;                                                         05570000
      END;                                                              05575000
    <<ALLOCATE SPACE FOR ENTRY>>                                        05580000
    MAKEROOMINDL(5);                                                    05585000
    IF < THEN                                                           05590000
      BEGIN                <<NO ROOM>>                                  05595000
        BLDSEGENTRY:=0;    <<RETURN 0>>                                 05600000
        CONDCODE:=CCL;     <<ERROR CODE>>                               05605000
        RETURN;                                                         05610000
      END;                                                              05615000
    TOS:=@DLAREA1-5;                                                    05620000
    @NEWSEGPTR:=S0;        <<NEW ENTRY PTR>>                            05625000
    @DLAREA1:=TOS;                                                      05630000
    <<FIND POSITION FOR ENTRY>>                                         05635000
    INDEX:=SLNR&LSL(4)+SEGNR&LSR(4); <<DIRECTORY INDEX>>                05640000
    <<CHECK IF NEW ENTRY CAN BE LINKED IN FRONT OF LIST>>               05645000
    @CURRSEGPTR:=SLDATABASE(SLNR);                                      05650000
    IF @CURRSEGPTR = 0 OR                                               05655000
       CURRSEGPTR(DBLOGSEG) > SEGNR THEN                                05660000
      BEGIN                                                             05665000
        <<LIST IS EMPTY OR               >>                             05670000
        <<FIRST ENTRY HAS LOGSEG > SEGNR >>                             05675000
        <<LINK NEW ENTRY FIRST           >>                             05680000
        SLDATABASE(SLNR):=@NEWSEGPTR;                                   05685000
        GO FINISHLINK;                                                  05690000
      END;                                                              05695000
    <<NEW ENTRY MUST BE LINKED AFTER FIRST ENTRY>>                      05700000
    <<FIND STARTING POINT FOR SEARCH OF PROPER SLOT FOR>>               05705000
    <<THE NEW ENTRY.  STARTING POINT IS SUCH THAT THE  >>               05710000
    <<NEW SEGNR IS > SEGNR OF STARTING ENTRY           >>               05715000
    INDEX2:=INDEX;                                                      05720000
    @CURRSEGPTR:=SLDB'SEG'DIR(INDEX2);                                  05725000
    WHILE @CURRSEGPTR = 0 OR                                            05730000
          CURRSEGPTR(DBLOGSEG) > SEGNR DO                               05735000
      BEGIN                                                             05740000
        INDEX2:=INDEX2-1;                                               05745000
        @CURRSEGPTR:=SLDB'SEG'DIR(INDEX2);                              05750000
      END;                                                              05755000
    <<FOUND STARTING POINT--NOW FIND PROPER SLOT>>                      05760000
    WHILE @CURRSEGPTR <> 0 AND                                          05765000
          CURRSEGPTR(DBLOGSEG) < SEGNR DO                               05770000
      BEGIN                                                             05775000
        @OLDSEGPTR:=@CURRSEGPTR;                                        05780000
        @CURRSEGPTR:=CURRSEGPTR(SEGNEXT);                               05785000
      END;                                                              05790000
    <<FOUND SLOT>>                                                      05795000
    OLDSEGPTR(SEGNEXT):=@NEWSEGPTR;                                     05800000
FINISHLINK:                                                             05805000
    <<UPDATE DIRECTORY PTRS (SLDB'SEG'DIR)>>                            05810000
    @OLDSEGPTR:=SLDB'SEG'DIR(INDEX); <<CURRENT PTR>>                    05815000
    IF @OLDSEGPTR = 0 OR             <<NO PTR OR      >>                05820000
       OLDSEGPTR(DBLOGSEG) > SEGNR   <<OLD LOGSEG > NEW>>               05825000
      THEN SLDB'SEG'DIR(INDEX):=@NEWSEGPTR;                             05830000
    <<INITIALIZE ENTRY>>                                                05835000
    NEWSEGPTR(0):=0;                                                    05840000
    MOVE NEWSEGPTR(1):=NEWSEGPTR(0),(4);                                05845000
    NEWSEGPTR(SEGNEXT):=@CURRSEGPTR;                                    05850000
    NEWSEGPTR(DBLOGSEG):=SEGNR;                                         05855000
    <<RETURN INFO>>                                                     05860000
    BLDSEGENTRY:=@NEWSEGPTR;                                            05865000
    CONDCODE:=CCE;                                                      05870000
  END;                                                                  05875000
$PAGE                                                                   05880000
INTEGER PROCEDURE BLDSTTENTRY(SEGPTR,STTNR);                            05885000
  VALUE STTNR,SEGPTR;                                                   05890000
  INTEGER STTNR;                                                        05895000
  INTEGER POINTER SEGPTR;                                               05900000
  <<BUILD NEW STT ENTRY IN SATISFIED DATA BASE>>                        05905000
  <<ENTRY BUILT - RETURN PTR TO ENTRY >>                                05910000
  <<            - CONDITION CODE=CCE  >>                                05915000
  <<ENTRY NOT BUILT - RETURN 0        >>                                05920000
  <<                - CONDITION CODE=CCL>>                              05925000
  <<SEGPTR - POINTER TO SEG ENTRY     >>                                05930000
  <<STTNR  - STT # FOR NEW ENTRY      >>                                05935000
  BEGIN                                                                 05940000
    INTEGER POINTER OLDSTTPTR,CURRSTTPTR,NEWSTTPTR;                     05945000
    <<CHECK IF ENTRY ALREADY EXISTS>>                                   05950000
    @CURRSTTPTR:=0;        <<START SEARCH AT HEAD>>                     05955000
    BLDSTTENTRY:=FINDSTTENTRY(SEGPTR,STTNR,CURRSTTPTR);                 05960000
    IF = THEN                                                           05965000
      BEGIN                <<ENTRY ALREADY EXISTS>>                     05970000
        CONDCODE:=CCE;     <<OK CODE             >>                     05975000
        RETURN;                                                         05980000
      END;                                                              05985000
    <<ALLOCATE SPACE FOR ENTRY>>                                        05990000
    MAKEROOMINDL(3);                                                    05995000
    IF < THEN                                                           06000000
      BEGIN                <<NO ROOM>>                                  06005000
        BLDSTTENTRY:=0;    <<RETURN 0>>                                 06010000
        CONDCODE:=CCL;     <<ERROR CODE>>                               06015000
        RETURN;                                                         06020000
      END;                                                              06025000
    TOS:=@DLAREA1-3;                                                    06030000
    @NEWSTTPTR:=S0;        <<NEW ENTRY PTR>>                            06035000
    @DLAREA1:=TOS;                                                      06040000
    <<FIND POSITION FOR ENTRY>>                                         06045000
    @OLDSTTPTR:=0;                                                      06050000
    @CURRSTTPTR:=SEGPTR(STTNEXT);                                       06055000
    WHILE @CURRSTTPTR <> 0 AND                                          06060000
          CURRSTTPTR(DBSTT) < STTNR DO                                  06065000
      BEGIN                                                             06070000
        @OLDSTTPTR:=@CURRSTTPTR;                                        06075000
        @CURRSTTPTR:=CURRSTTPTR(STTNEXT);                               06080000
      END; <<WHILE>>                                                    06085000
    <<FOUND SPOT--LINK IN NEW ENTRY>>                                   06090000
    IF @OLDSTTPTR = 0 THEN                                              06095000
      BEGIN                <<LINK TO HEAD>>                             06100000
        SEGPTR(STTNEXT):=@NEWSTTPTR;                                    06105000
      END ELSE                                                          06110000
      BEGIN                <<LINK OTHER THAN HEAD>>                     06115000
        OLDSTTPTR(STTNEXT):=@NEWSTTPTR;                                 06120000
      END;                                                              06125000
    <<INITIALIZE ENTRY>>                                                06130000
    NEWSTTPTR(0):=0;                                                    06135000
    MOVE NEWSTTPTR(1):=NEWSTTPTR(0),(2);                                06140000
    NEWSTTPTR(STTNEXT):=@CURRSTTPTR;                                    06145000
    NEWSTTPTR(DBSTT):=STTNR;                                            06150000
    <<RETURN INFO>>                                                     06155000
    BLDSTTENTRY:=@NEWSTTPTR;                                            06160000
    CONDCODE:=CCE;                                                      06165000
  END;                                                                  06170000
LOGICAL PROCEDURE SAMENAME (NAME1,NAME2);                               06175000
$PAGE                                                                   06180000
  <<COMPARES TWO NAMES (THE FIRST BYTE BEING THE # OF CHAR>>            06185000
  <<AND RETURNS TRUE IF THEY ARE THE SAME; OTHERWISE FALSE>>            06190000
  INTEGER ARRAY NAME1,NAME2;                                            06195000
  OPTION UNCALLABLE;                                                    06200000
  BEGIN                                                                 06205000
    INTEGER RESULT = SAMENAME;                                          06210000
    TOS := @NAME1&LSL(1);                                               06215000
    TOS := @NAME2&LSL(1);                                               06220000
    ASSEMBLE(INCA,INCB);                                                06225000
    TOS := NAME1.(4:4);                                                 06230000
    IF NAME2.(4:4) = S0 AND * = *,(TOS) THEN RESULT:=RESULT+1;          06235000
  END;                                                                  06240000
$PAGE                                                                   06245000
PROCEDURE FERROR (FNUM);                                                06250000
  <<DETERMINES THE ERROR NUMB FOR THE EOF OR I/O ERROR JUST>>           06255000
  <<DETECTED>>                                                          06260000
  VALUE FNUM;                                                           06265000
  INTEGER FNUM;                                                         06270000
  OPTION UNCALLABLE;                                                    06275000
  BEGIN                                                                 06280000
    INTEGER TEMP;                                                       06285000
    TEMP:=MLIBSEARCH+1;                                                 06290000
    WHILE (TEMP:=TEMP-1) >= 0 DO                                        06295000
      BEGIN  <<FIND SL # FOR THIS FNUM>>                                06300000
        IF SLFNUM(TEMP) = FNUM THEN GO REPORTERR;                       06305000
      END; <<WHILE>>                                                    06310000
    IF FNUM = PROGFNUM AND PROGFNUM <> 0 THEN                  <<07301>>06315000
      BEGIN                                                    <<07301>>06320000
         TEMP:=3;                                              <<07301>>06325000
         GO TO REPORTERR;                                      <<07301>>06330000
      END;                                                     <<07301>>06335000
    <<MATCH NOT FOUND - USE SYS SL>>                                    06340000
    TEMP:=0;                                                            06345000
REPORTERR:                                                              06350000
    MERROR:=ERR60+TEMP;                                                 06355000
    FCHECK(FNUM,MFERROR);                                               06360000
  END;                                                                  06365000
$PAGE                                                                   06370000
PROCEDURE PRINTBITMAP( MAP);                                            06375000
  ARRAY MAP;                                                            06380000
  OPTION UNCALLABLE;                                                    06385000
  BEGIN                                                                 06390000
    INTEGER COL, I;                                                     06395000
    LOGICAL FIRSTPARM := TRUE;                                          06400000
    COL := (-LINELENGTH)+1;                                             06405000
    FOR *I := 0 UNTIL %77 DO                                            06410000
       BEGIN                                                            06415000
         IF COL > 66 THEN                                               06420000
            BEGIN                                                       06425000
              PRINTLINE';                                               06430000
              IF <> THEN GO ABORT;                                      06435000
              COL := 0;                                                 06440000
            END;                                                        06445000
         IF TESTBIT( MAP, I) THEN                                       06450000
            BEGIN                                                       06455000
              IF COL <> 0 AND NOT FIRSTPARM THEN                        06460000
                 BEGIN                                                  06465000
                   BLINE(COL) := ",";                                   06470000
                   COL:=COL+1;                                          06475000
                 END;                                                   06480000
              FIRSTPARM := FALSE;                                       06485000
              COL := COL+LNTOA(I+1,10,BLINE(COL));                      06490000
            END;                                                        06495000
       END;                                                             06500000
    IF COL <> 0 THEN                                                    06505000
       BEGIN                                                            06510000
         PRINTLINE';                                                    06515000
         IF <> THEN GO ABORT;                                           06520000
       END;                                                             06525000
    CLEARLINE;                                                          06530000
                                                                        06535000
    CONDCODE := CCE;                                                    06540000
    RETURN;                                                             06545000
                                                                        06550000
ABORT:                                                                  06555000
    CONDCODE := CCL;                                                    06560000
  END;                                                                  06565000
$PAGE                                                                   06570000
PROCEDURE CLEARLINE;                                                    06575000
  <<CLEARS THE LIST BUFFER>>                                            06580000
  OPTION UNCALLABLE;                                                    06585000
  BEGIN                                                                 06590000
    TOS := @LINE; PS0 := "  ";                                          06595000
    ASSEMBLE(DUP,INCB); TOS := 35; ASSEMBLE(MOVE 3)                     06600000
  END;                                                                  06605000
$PAGE                                                                   06610000
INTEGER PROCEDURE LINELENGTH;                                           06615000
  <<RETURNS THE NEGATIVE # OF CHAR IN THE LIST BUFFER>>                 06620000
  OPTION UNCALLABLE;                                                    06625000
  BEGIN                                                                 06630000
    TOS := @BLINE(71);  <<POINTER TO LAST CHAR.>>                       06635000
    IF BPS0 = " " THEN                                                  06640000
       BEGIN                                                            06645000
         ASSEMBLE(DUP,DECB);                                            06650000
         TOS := -71;                                                    06655000
         ASSEMBLE(CMPB 2)                                               06660000
       END;                                                             06665000
    LINELENGTH := -(TOS-@BLINE+1);  <<NEG. NR. CHAR'S>>                 06670000
  END;                                                                  06675000
$PAGE                                                                   06680000
PROCEDURE PRINTLINE;                                                    06685000
  <<PRINTS THE CONTENTS OF THE LIST BUFF ON THE LIST FILE>>             06690000
  <<NOTE THAT THIS PROCEDURE USES THE CONDITION CODE     >>             06695000
  <<TO INDICATE AN ERROR>>                                              06700000
  OPTION UNCALLABLE;                                                    06705000
  BEGIN                                                                 06710000
    ENTRY BLANKLINE,PRINTLINE';                                         06715000
                                                                        06720000
    BLANKLINE:                                                          06725000
    IF MLMAP THEN  <<LISTING WANTED?>>                                  06730000
       BEGIN                                                            06735000
         PRINTLINE':                                                    06740000
         FWRITE(LISTFNUM,LINE,LINELENGTH,0);                            06745000
         IF <> THEN  <<ERROR?>>                                         06750000
            BEGIN                                                       06755000
              TOS := ERR64; GO ABORT                                    06760000
            END;                                                        06765000
         LISTFLAG := TRUE;                                              06770000
       END;                                                             06775000
    TOS := CCE;  <<OK CONDITION CODE>>                                  06780000
    GO GETOUT;                                                          06785000
                                                                        06790000
ABORT:                                                                  06795000
    MERROR := TOS;  <<ERROR NR.>>                                       06800000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               06805000
                                                                        06810000
GETOUT:                                                                 06815000
    CLEARLINE;                                                          06820000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           06825000
  END;                                                                  06830000
$PAGE                                                                   06835000
PROCEDURE NTOA (NUM,BASE,BUF);                                          06840000
  <<CONVERTS THE NUMBER INTO AN ASCII STRING THAT IS >>                 06845000
  <<RIGHT JUSTIFIED IN THE SPECIFIED BUFFER>>                           06850000
  VALUE NUM,BASE;                                                       06855000
  INTEGER NUM,BASE;                                                     06860000
  BYTE ARRAY BUF;                                                       06865000
  OPTION UNCALLABLE;                                                    06870000
  BEGIN                                                                 06875000
    BUF(0) := "0";                                                      06880000
    WHILE NUM <> 0 DO                                                   06885000
       BEGIN                                                            06890000
         TOS := 0; TOS := NUM; TOS := BASE;                             06895000
         ASSEMBLE(LDIV);                                                06900000
         BUF(XREG) := TOS+%60;                                          06905000
         NUM := TOS;                                                    06910000
         XREG := XREG-1                                                 06915000
       END                                                              06920000
  END;                                                                  06925000
$PAGE                                                                   06930000
   INTEGER PROCEDURE LDNTOA(NUM, BASE, BA);                             06935000
     VALUE NUM, BASE;                                                   06940000
     DOUBLE NUM;                                                        06945000
     INTEGER BASE;                                                      06950000
     BYTE ARRAY BA;                                                     06955000
     OPTION UNCALLABLE;                                                 06960000
     BEGIN                                                              06965000
       BYTE ARRAY BUF(0:11)=Q;                                          06970000
       XREG := 12;                                                      06975000
       DO BEGIN                                                         06980000
            ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;                   06985000
                     LDD NUM; DELB; LOAD BASE; LDIV;                    06990000
                     ADDI %60);                                         06995000
            BUF(XREG:=XREG-1) := TOS;                                   07000000
            NUM := TOS;                                                 07005000
          END UNTIL NUM=0D;                                             07010000
       MOVE BA := BUF(XREG),(LDNTOA:=12-XREG);                          07015000
     END;                                                               07020000
$PAGE                                                                   07025000
   INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                             07030000
     VALUE NUM, BASE;                                                   07035000
     INTEGER NUM, BASE;                                                 07040000
     BYTE ARRAY BA;                                                     07045000
     OPTION UNCALLABLE;                                                 07050000
     BEGIN                                                              07055000
       LNTOA := LDNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);                   07060000
     END;                                                               07065000
$PAGE                                                                   07070000
PROCEDURE MAKEROOMINDL (NRWORDS);                                       07075000
  <<CHECKS THE AVAILABLE DL TO SEE IF THERE IS ROOM FOR>>               07080000
  <<THE SPECIFIED NUMBER OF WORDS.  IF NOT, THE DL AREA>>               07085000
  <<IS EXPANDED BY THE NECESSARY AMOUNT.  NOTE THAT THIS>>              07090000
  <<PROCEDURE USES CONDITION CODE TO INDICATE AN ERROR>>                07095000
  VALUE NRWORDS;                                                        07100000
  INTEGER NRWORDS;                                                      07105000
  OPTION UNCALLABLE;                                                    07110000
  BEGIN                                                                 07115000
    INTEGER NWAVAIL;                                                    07120000
    NWAVAIL:=@DLAREA1-@DLAVAIL; <<# WORDS AVAILABLE>>                   07125000
    IF NRWORDS > NWAVAIL THEN  <<NOT ENOUGH ROOM?>>                     07130000
       BEGIN                                                            07135000
                                                                        07140000
         <<* * * EXPAND DL AREA * * *>>                                 07145000
                                                                        07150000
         TOS := 0;  <<FOR RESULT OF DLSIZE>>                            07155000
         TOS := @DLAREA2;                                               07160000
         TOS := DLINCREMENT;  <<INIT. INCREMENT>>                       07165000
         WHILE NRWORDS > S0+NWAVAIL DO TOS := TOS+DLINCREMENT;          07170000
         TOS := TOS-TOS;  <<NEW DL LIMIT>>                              07175000
         TOS := DLSIZE(*);  <<EXPAND DL AREA>>                          07180000
                                                                        07185000
         <<* * * MOVE TABLES AND FIX POINTERS IN AREA 2 * * *>>         07190000
                                                                        07195000
         MOVE PS0 := DLAREA2,(@DLAVAIL-@DLAREA2);  <<MOVE TABLES>>      07200000
         TOS := TOS-@DLAREA2;  <<POINTER FIX TERM>>                     07205000
         @SAVEUXP := @SAVEUXP+S0;                                       07210000
         @UXP := @UXP+S0;                                               07215000
         @UXP1 := @UXP1+S0;                                             07220000
         @UXP2 := @UXP2+S0;                                             07225000
         @DLAREA2 := @DLAREA2+S0;                                       07230000
         @DLAVAIL := TOS+@DLAVAIL;                                      07235000
         IF NRWORDS > @DLAREA1-@DLAVAIL THEN <<ROOM NOW?>>              07240000
           BEGIN                             <<NO>>                     07245000
             TOS:=ERR71; GO ABORT;                                      07250000
           END;                                                         07255000
       END;                                                             07260000
    CONDCODE:=CCE;              <<OK CODE>>                             07265000
    RETURN;                                                             07270000
                                                                        07275000
ABORT:                                                                  07280000
    MERROR:=TOS;                <<ERROR #>>                             07285000
    CONDCODE:=CCL;              <<ERROR CODE>>                          07290000
    RETURN;                                                             07295000
  END;                                                                  07300000
$PAGE                                                                   07305000
INTEGER PROCEDURE PARMLEN (PARMS);                                      07310000
  <<RETURNS THE #OF WORDS IN THE PARAMETER INFO BLOCK>>                 07315000
  INTEGER ARRAY PARMS;                                                  07320000
  OPTION UNCALLABLE;                                                    07325000
  BEGIN                                                                 07330000
    INTEGER P = Q+1;                                                    07335000
    TOS := PARMS.(0:2);  <<LEVEL OF CHECKING>>                          07340000
    PARMLEN:=IF = THEN 1                                                07345000
                  ELSE IF P = 3 THEN PARMS.(2:6)+2                      07350000
                                ELSE 2;                                 07355000
  END;                                                                  07360000
$PAGE                                                                   07365000
PROCEDURE PARMCHECK (FORMALP,ACTUALP,PARMS);                            07370000
  <<CHECKS FOR COMPATABILITY BETWEEN THE ACTUAL PARAMETER>>             07375000
  <<INFO BLOCK AND THE FORMAL PARAMETER INFO BLOCK>>                    07380000
  INTEGER ARRAY FORMALP,ACTUALP,PARMS;                                  07385000
  OPTION UNCALLABLE;                                                    07390000
  BEGIN                                                                 07395000
    INTEGER P = Q+1;  <<LEVEL OF CHECKING>>                             07400000
    INTEGER POINTER PARMMAP = Q+2; <<BAD PARMS BIT MAP>>                07405000
                                                                        07410000
    <<* * * LEVEL 0 - NO CHECKING * * *>>                               07415000
                                                                        07420000
    PARMS := 0;                                                         07425000
    MOVE PARMS(1) := PARMS,(4);                                         07430000
    TOS := FORMALP.(0:2); TOS := ACTUALP.(0:2);                         07435000
    ASSEMBLE(DDUP,CMP);                                                 07440000
    IF > THEN ASSEMBLE(XCH);                                            07445000
    ASSEMBLE(DEL,TEST);                                                 07450000
    IF = THEN GO MATCH;                                                 07455000
    TOS := @PARMS(1);  <<INITIALIZE PARMMAP>>                           07460000
                                                                        07465000
    <<* * * LEVEL 1 - PROCEDURE TYPE * * *>>                            07470000
                                                                        07475000
    TOS := FORMALP(1);                                                  07480000
    IF = THEN GO L1;                                                    07485000
    TOS := ACTUALP(XREG);                                               07490000
    IF = THEN GO L1;                                                    07495000
    IF TOS <> TOS OR                                                    07500000
       FORMALP.(8:8) <> ACTUALP.(8:8) THEN                              07505000
       BEGIN                                                            07510000
         PARMS := 1;                                                    07515000
         RETURN;                                                        07520000
       END;                                                             07525000
L1:     IF P = 1 THEN GO MATCH;                                         07530000
                                                                        07535000
    <<* * * LEVEL 2 - NUMBER OF PARAMETERS * * *>>                      07540000
                                                                        07545000
    TOS := FORMALP.(2:6);                                               07550000
    TOS := ACTUALP.(2:6);                                               07555000
    ASSEMBLE(DDUP,CMP);                                                 07560000
    IF <> THEN                                                          07565000
       BEGIN                                                            07570000
         PARMS := 2;                                                    07575000
         RETURN;                                                        07580000
       END;                                                             07585000
    IF P = 2 THEN GO MATCH;                                             07590000
                                                                        07595000
    <<* * * LEVEL 3 - PARAMETER TYPES * * *>>                           07600000
                                                                        07605000
    ASSEMBLE(DEL,TEST);                                                 07610000
    IF = THEN GO MATCH;  <<CHECK FOR NO PARM'S>>                        07615000
AGAIN:                                                                  07620000
    XREG := XREG+1;                                                     07625000
    TOS := FORMALP(XREG);                                               07630000
    IF = THEN GO DEL1;                                                  07635000
    TOS := ACTUALP(XREG);                                               07640000
    IF = THEN GO DEL2;                                                  07645000
                                                                        07650000
    <<CHECK MODE>>                                                      07655000
                                                                        07660000
    TOS := FORMALP(XREG).(0:4);                                         07665000
    TOS := ACTUALP(XREG).(0:4);                                         07670000
    ASSEMBLE(DDUP,CMP);                                                 07675000
    IF <> THEN                                                          07680000
       IF S0 <> 4 AND S1 <> 4 THEN                                      07685000
          BEGIN                                                         07690000
            PARMS := 3;                                                 07695000
            SETBIT( PARMMAP, XREG-2);                                   07700000
          END;                                                          07705000
                                                                        07710000
    <<CHECK STRUCTURE>>                                                 07715000
                                                                        07720000
    TOS := FORMALP(XREG).(4:6);                                         07725000
    TOS := ACTUALP(XREG).(4:6);                                         07730000
    ASSEMBLE(DDUP,CMP);                                                 07735000
    IF <> THEN                                                          07740000
       IF S1 <> 0 OR S0 <> 1 AND S0 <> 2 THEN                           07745000
          BEGIN                                                         07750000
            PARMS := 3;                                                 07755000
            SETBIT( PARMMAP, XREG-2);                                   07760000
          END;                                                          07765000
                                                                        07770000
    <<CHECK TYPE>>                                                      07775000
                                                                        07780000
    TOS := FORMALP(XREG).(10:6);                                        07785000
    TOS := ACTUALP(XREG).(10:6);                                        07790000
    ASSEMBLE(DDUP,CMP);                                                 07795000
    IF <> THEN                                                          07800000
       IF S0 <> 11 AND S1 <> 11 THEN                                    07805000
          BEGIN                                                         07810000
            PARMS := 3;                                                 07815000
            SETBIT( PARMMAP, XREG-2);                                   07820000
          END;                                                          07825000
                                                                        07830000
    ASSEMBLE(SUBS 6);                                                   07835000
DEL2:     DEL;                                                          07840000
DEL1 :     DEL;                                                         07845000
    ASSEMBLE(DABZ MATCH);                                               07850000
    GO AGAIN;                                                           07855000
                                                                        07860000
MATCH:                                                                  07865000
  END;                                                                  07870000
$PAGE                                                                   07875000
LOGICAL PROCEDURE SCANCACHE (NAME,BUCKET);                              07880000
  <<SCAN BUCKET IN LOAD CACHE FOR SL DIRECTORY ENTRY>>                  07885000
  <<FOR SEGMENT NAME.  IF SUCCESSFUL, MOVE ENTRY TO >>                  07890000
  <<FRONT OF BUCKET AND RETURN TRUE, ELSE FALSE.    >>                  07895000
  VALUE BUCKET;                                                         07900000
  INTEGER BUCKET;        <<HASH BUCKET NUMBER>>                         07905000
  INTEGER ARRAY NAME;    <<SEGMENT NAME>>                               07910000
  OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                                07915000
  BEGIN                                                                 07920000
    INTEGER BUCKETP,LENGTH;                                             07925000
    LOGICAL ARRAY WORKAREA(0:BUCKETSIZE-1)=Q;                           07930000
    IF SLNR=0 AND LOADCACHESEG<>0 THEN                                  07935000
      BEGIN  <<SYSTEM SL AND A CACHE EXISTS>>                           07940000
                                                                        07945000
        <<MOVE CACHE BUCKET TO STACK>>                                  07950000
                                                                        07955000
        TOS:=@WBUCKET;                   <<TARGET>>                     07960000
        TOS:=LOADCACHESEG;               <<SOURCE SEGMENT>>             07965000
        TOS:=BUCKET*BUCKETSIZE+BUCKET0;  <<SOURCE>>                     07970000
        TOS:=BUCKETSIZE;                 <<LENGTH>>                     07975000
        ASSEMBLE(MFDS 4);                <<MOVE>>                       07980000
                                                                        07985000
        <<SCAN FOR ENTRY IN BUCKET>>                                    07990000
                                                                        07995000
        BUCKETP:=0;                                                     08000000
        WHILE BUCKETP+(LENGTH:=WBUCKET(BUCKETP))<=BUCKETSIZE            08005000
                        AND BUCKETP<BUCKETSIZE                          08010000
          DO IF SAMENAME(NAME,WBUCKET(BUCKETP+1))                       08015000
            THEN                                                        08020000
              BEGIN   <<ENTRY IS IN CACHE BUCKET>>                      08025000
                IF BUCKETP<>0 THEN  <<NOT AT FRONT OF BUCKET>>          08030000
                  BEGIN    <<MUST MOVE TO FRONT>>                       08035000
                    MOVE WORKAREA:=WBUCKET(BUCKETP),(LENGTH);           08040000
                    MOVE WBUCKET(BUCKETP+LENGTH-1):=                    08045000
                         WBUCKET(BUCKETP-1),(-BUCKETP);                 08050000
                    MOVE WBUCKET:=WORKAREA,(LENGTH);                    08055000
                                                                        08060000
                    <<MOVE TO CACHE>>                                   08065000
                                                                        08070000
                    TOS:=LOADCACHESEG;      <<TARGET SEGMENT>>          08075000
                    TOS:=BUCKET*BUCKETSIZE+BUCKET0;  <<TARGET>>         08080000
                    TOS:=@WBUCKET;             <<SOURCE>>               08085000
                    TOS:=BUCKETSIZE;           <<LENGTH>>               08090000
                    ASSEMBLE(MTDS 4);          <<MOVE>>                 08095000
                  END;                                                  08100000
                                                                        08105000
                <<SET UP POINTERS>>                                     08110000
                                                                        08115000
                @SLP:=@WBUCKET+1;                                       08120000
                @SLP1:=@SLP+SLP.(4:3)+1;                                08125000
                SCANCACHE:=TRUE;                                        08130000
                RETURN;                                                 08135000
              END                                                       08140000
            ELSE BUCKETP:=BUCKETP+LENGTH;                               08145000
      END;                                                              08150000
  END;                                                                  08155000
$PAGE                                                                   08160000
PROCEDURE ADDTOCACHE (DIRENTRY,LENGTH,BUCKET);                          08165000
  <<ADDS DIRECTORY ENTRY OF GIVEN LENGTH TO CACHE BUCKET>>              08170000
  VALUE LENGTH,BUCKET;                                                  08175000
  INTEGER POINTER DIRENTRY;   <<DIRECTORY DIRENTRY POINTER>>            08180000
  INTEGER LENGTH;          <<LENGTH OF DIRECTORY ENTRY>>                08185000
  INTEGER BUCKET;          <<HASH BUCKET>>                              08190000
  OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                                08195000
  BEGIN                                                                 08200000
    INTEGER BUCKETSTART,BUCKETEND,LENGTH1;                              08205000
    IF LOADCACHESEG<>0 AND LENGTH<BUCKETSIZE THEN                       08210000
      BEGIN  <<CACHE EXISTS AND ENTRY FITS IN BUCKET>>                  08215000
                                                                        08220000
        <<MAKE ROOM FOR ENTRY AT FRONT OF BUCKET>>                      08225000
                                                                        08230000
        LENGTH1:=LENGTH+1;                                              08235000
        BUCKETSTART:=BUCKET*BUCKETSIZE+BUCKET0;                         08240000
        BUCKETEND:=BUCKETSTART+BUCKETSIZE-1;                            08245000
        TOS:=LOADCACHESEG;           <<TARGET SEGMENT>>                 08250000
        TOS:=BUCKETEND;              <<TARGET>>                         08255000
        TOS:=LOADCACHESEG;           <<SOURCE SEGMENT>>                 08260000
        TOS:=BUCKETEND-LENGTH1;      <<SOURCE>>                         08265000
        TOS:=LENGTH1-BUCKETSIZE;     <<LENGTH>>                         08270000
        ASSEMBLE(MDS 4);        <<MOVE - SAVE TARGET SEGMENT>>          08275000
                                                                        08280000
        <<MOVE IN NEW ENTRY>>                                           08285000
                                                                        08290000
        TOS:=BUCKETSTART;      <<TARGET>>                               08295000
        TOS:=@LENGTH1;         <<SOURCE>>                               08300000
        TOS:=1;                <<LENGTH>>                               08305000
        ASSEMBLE(MTDS 2);      <<MOVE - SAVE TARGET>>                   08310000
        TOS:=@DIRENTRY;        <<SOURCE>>                               08315000
        TOS:=LENGTH;           <<LENGTH>>                               08320000
        ASSEMBLE(MTDS 4);      <<MOVE>>                                 08325000
      END;                                                              08330000
  END;                                                                  08335000
$PAGE                                                                   08340000
LOGICAL PROCEDURE SEARCHSL(NAME,ERRORFLAG);                             08345000
  <<SEARCHES THE CURRENT SL FILE FOR THE ENTRY POINT. NOTE>>            08350000
  <<THAT THIS PROCEDURE USES CONDITION CODE TO INDICATE AN>>            08355000
  <<ERROR.  ALSO ERRORFLAG=1 ON AN ERROR>>                              08360000
  INTEGER ERRORFLAG;                                                    08365000
  INTEGER ARRAY NAME;                                                   08370000
  OPTION UNCALLABLE;                                                    08375000
  BEGIN                                                                 08380000
    INTEGER RESULT = SEARCHSL;                                          08385000
    INTEGER BUCKET = Q+1;                                               08390000
    INTEGER LENGTH = Q+2;                                               08395000
    BYTE POINTER BNAME = Q+3;  <<IDENTIFIER>>                           08400000
    DOUBLE DRECD = Q+4;  <<CURRENT REC. NR.>>                           08405000
    INTEGER RECD = DRECD+1;                                             08410000
                                                                        08415000
    <<* * * INITIALIZE LOCAL VARIABLES * * *>>                          08420000
                                                                        08425000
    ASSEMBLE(ADDS 2);    <<SAVE SPACE FOR BUCKET AND LENGTH>>           08430000
    TOS := @NAME&LSL(1);                                                08435000
    TOS := NAME.(4:12);  <<NC AND FIRST CHAR.>>                         08440000
    XREG := NAME.(4:4)-1;  <<NC-1>>                                     08445000
    TOS := BNAME(XREG)&CSL(8);  <<SEC. TO LAST CHAR.>>                  08450000
    XREG := XREG+1;                                                     08455000
    TOS := BNAME(XREG);  <<LAST CHAR.>>                                 08460000
    ASSEMBLE(ADD,DECX);                                                 08465000
    IF = THEN TOS := TOS.(4:12);                                        08470000
    TOS := NBUCKETS;                                                    08475000
    ASSEMBLE(LDIV,ZROB);                                                08480000
    BUCKET:=TOS;                                                        08485000
    IF SCANCACHE(NAME,BUCKET) THEN                                      08490000
      BEGIN  <<FOUND DIRECTORY ENTRY IN CACHE>>                         08495000
        HITS:=HITS+1D;  <<INCREMENT HIT COUNTER>>                       08500000
        RESULT:=RESULT+1;                                               08505000
        GO AOK;                                                         08510000
      END                                                               08515000
     ELSE                                                               08520000
      BEGIN    <<MUST READ SL DIRECTORY>>                               08525000
        TOS := SLREC0(BUCKET+SLFHI);  <<FIRST REC. IN LIST>>            08530000
        WHILE <> DO                                                     08535000
          BEGIN                                                         08540000
           FREADDIR(SLFNUM(SLNR),SLDIR,128,DRECD);                      08545000
           IF <> THEN GO IOERROR;  <<ERROR?>>                           08550000
           @SLP := @SLDIR(2);  <<INIT. ENTRY POINTER>>                  08555000
           WHILE @SLP < @SLDIR(SLDIR(1)) DO                             08560000
              BEGIN                                                     08565000
              @SLP1 := @SLP+SLP.(4:3)+1; <<SECONDARY POINTER>>          08570000
              IF SAMENAME(NAME,SLNAME) THEN  <<NAME'S MATCH?>>          08575000
                 BEGIN                                                  08580000
                 IF SLNR=0 THEN   <<SYSTEM SL>>                         08585000
                   BEGIN                                                08590000
                     MISSES:=MISSES+1D;  <<INC MISS COUNTER>>           08595000
                     LENGTH:=@SLP1-@SLP+PARMLEN(SLPARMS)+1;             08600000
                     ADDTOCACHE(SLP,LENGTH,BUCKET);                     08605000
                   END;                                                 08610000
                 RESULT := RESULT+1;                                    08615000
                 GO AOK                                                 08620000
                 END;                                                   08625000
              @SLP := @SLP1+PARMLEN(SLPARMS)+1  <<NEXT ENTRY>>          08630000
              END;                                                      08635000
           RECD := SLDIR  <<NEXT RECORD IN LIST>>                       08640000
          END;                                                          08645000
      END;                                                              08650000
AOK:                                                                    08655000
    ERRORFLAG:=0; <<RETURN OK CODE>>                                    08660000
    TOS := CCE;  <<OK CONDITION CODE>>                                  08665000
    GO GETOUT;                                                          08670000
                                                                        08675000
IOERROR:                                                                08680000
    ERRORFLAG:=1; <<RETURN ERROR CONDITION>>                            08685000
    FERROR(SLFNUM(XREG));                                               08690000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               08695000
                                                                        08700000
GETOUT:                                                                 08705000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           08710000
  END;                                                                  08715000
$PAGE                                                                   08720000
PROCEDURE GETREFTABENT (SEGNR);                                         08725000
  <<LOADS THE RECORD (IF NECESSARY) CONTAINING THE REFERENCE>>          08730000
  <<TABLE ENTRY AND SETS THE ENTRY POINTER TO IT.  NOTE THAT>>          08735000
  <<THIS PROCEDURE USES CONDITION CODE TO INDICATE AN ERROR>>           08740000
  VALUE SEGNR;                                                          08745000
  INTEGER SEGNR;                                                        08750000
  OPTION UNCALLABLE;                                                    08755000
  BEGIN                                                                 08760000
    TOS := SEGNR; TOS := 4;                                             08765000
    ASSEMBLE(DIV);                                                      08770000
    @RTP := (TOS&LSL(5))+@RTBUF;  <<SET ENTRY POINTER>>                 08775000
    TOS := TOS+SLREC1(SLNR);  <<BUFFER POINTER>>                        08780000
    TOS := PS0;  <<REC. NR.>>                                           08785000
    IF S0 <> RTRECD THEN  <<DIFFERENT RECORD?>>                         08790000
       BEGIN                                                            08795000
         SAVEREFTABBUF;                                                 08800000
         IF < THEN GO NFG;  <<ERROR?>>                                  08805000
         RTRECD := TOS;                                                 08810000
         FREADDIR(SLFNUM(XREG),RTBUF,128,DRTRECD);                      08815000
         IF <> THEN GO IOERROR  <<ERROR?>>                              08820000
       END;                                                             08825000
    TOS := CCE;  <<OK CONDITION CODE>>                                  08830000
    GO GETOUT;                                                          08835000
                                                                        08840000
IOERROR:                                                                08845000
    FERROR(SLFNUM(XREG));                                               08850000
                                                                        08855000
NFG:                                                                    08860000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               08865000
                                                                        08870000
GETOUT:                                                                 08875000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           08880000
  END;                                                                  08885000
$PAGE                                                                   08890000
PROCEDURE SAVEREFTABBUF;                                                08895000
  <<SAVES THE CONTENTS OF THE REFERENCE TABLE BUFFER IF IT >>           08900000
  <<HAS BEEN MODIFIED.  NOTE THAT THIS PROCEDURE USES >>                08905000
  <<CONDITION CODE TO INDICATE AN ERROR>>                               08910000
  OPTION UNCALLABLE;                                                    08915000
  BEGIN                                                                 08920000
    TOS := RTMODIFIED;  <<MODIFIED FLAG>>                               08925000
    IF <> THEN  <<MODIFIED?>>                                           08930000
       BEGIN                                                            08935000
         FWRITEDIR(SLFNUM(SLNR),RTBUF,128,DRTRECD);                     08940000
         IF <> THEN GO IOERROR  <<ERROR?>>                              08945000
       END;                                                             08950000
    RTMODIFIED := 0;  <<CLEAR MODIFIED FLAG>>                           08955000
    TOS := CCE;  <<OK CONDITION CODE>>                                  08960000
    GO GETOUT;                                                          08965000
                                                                        08970000
IOERROR:                                                                08975000
    FERROR(SLFNUM(XREG));                                               08980000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               08985000
                                                                        08990000
GETOUT:                                                                 08995000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           09000000
  END;                                                                  09005000
$PAGE                                                                   09010000
PROCEDURE GETSLNAMES (FLAG);                                            09015000
   <<INITIALIZES THE SL FILE NAME ARRAYS WITH THE PROPER SET >>         09020000
   <<OF FILE NAMES.  IF THE FLAG IS TRUE, THEN THE FILE NAMES>>         09025000
   <<ARE DETERMINED FROM THE DOMAIN OF THE PROGRAM FILE;   >>           09030000
   <<OTHERWISE FROM THE LOG-ON DOMAIN.  NOTE THAT THIS  >>              09035000
   <<PROCEDURE USES CONDITION CODE TO INDICATE AN ERROR>>               09040000
   VALUE FLAG;                                                          09045000
   LOGICAL FLAG;                                                        09050000
   OPTION UNCALLABLE;                                                   09055000
   BEGIN                                                                09060000
   BYTE ARRAY B0 (0:2)=PB := "SL.";                                     09065000
   BYTE ARRAY B1 (0:3)=PB := "PUB.";                                    09070000
   BYTE ARRAY B2 (0:3)=PB := "SYS ";                                    09075000
   BYTE ARRAY GROUP (0:8);  <<GROUP NAME>>                              09080000
   BYTE ARRAY ACCT (0:8);  <<ACCOUNT NAME>>                             09085000
   INTEGER LIBNO;                                                       09090000
   ARRAY BUF (0:40);                                                    09095000
$PAGE                                                                   09100000
SUBROUTINE GETNAMES(LINEPTR);                                           09105000
VALUE LINEPTR;                                                          09110000
BYTE POINTER LINEPTR;                                                   09115000
BEGIN                                                                   09120000
   TOS := @GROUP&LSR(1);                                                09125000
   PS0 := "  ";                                                         09130000
   ASMB(DUP,INCB);                                                      09135000
   TOS := 9;                                                            09140000
   ASMB(MOVE 3); << BLANK BUFFER >>                                     09145000
   TOS := @LINEPTR;                                                     09150000
   TOS := @ACCT;                                                        09155000
   TOS := @GROUP;                                                       09160000
   ASMB(CAB); << LINE PTR TO TOS >>                                     09165000
   SCAN * UNTIL ".",1; << SKIP FILE NAME >>                             09170000
   TOS := TOS + 1; << SKIP "." >>                                       09175000
   MOVE * := * WHILE AN,0; << GET GROUP NAME >>                         09180000
   DELB; << DEL GROUP NAME POINTER >>                                   09185000
   TOS := TOS + 1; << SKIP "." >>                                       09190000
   MOVE * := * WHILE AN; << GET ACCOUNT NAME >>                         09195000
END;                                                                    09200000
$PAGE                                                                   09205000
   <<* * * PARTIALLY INITIALIZE FILE NAMES * * *>>                      09210000
                                                                        09215000
   MOVE SSLFNAME := B0,(3),2;                                           09220000
   MOVE * := B1,(4),2;                                                  09225000
   MOVE * := B2,(4);                                                    09230000
   MOVE PSLFNAME := B0,(3),2;                                           09235000
   MOVE * := B1,(4),2;                                                  09240000
   MOVE GSLFNAME := B0,(3),2;                                           09245000
                                                                        09250000
   <<* * * COMPLETE FILE NAME INITIALIZATION * * *>>                    09255000
                                                                        09260000
   IF FLAG THEN  <<SAVED FILE?>>                                        09265000
      BEGIN                                                             09270000
      SCAN BLINE UNTIL ".",1;  <<SKIP OVER LOCAL NAME>>                 09275000
      TOS := TOS+1;  <<SKIP OVER ".">>                                  09280000
      MOVE * := * WHILE AN,0;  <<INSERT GROUP NAME>>                    09285000
      MOVE * := *,(1),1;  <<INSERT ".">>                                09290000
      XREG := S0;  <<SAVE POINTER TO ACCT. NAME>>                       09295000
      MOVE * := * WHILE AN,1;  <<INSERT ACCT. NAME>>                    09300000
      BPS0 := " ";  <<INSERT TRAILING BLANK>>                           09305000
      ASMB(XAX); << GET ACCT POINTER >>                                 09310000
      MOVE * := * WHILE AN,1;  <<INSERT ACCOUNT NAME>>                  09315000
      BPS0 := " ";  <<INSERT TRAILING BLANK>>                           09320000
      GETNAMES(BLINE);                                                  09325000
      SCAN GROUP UNTIL "  ",1;                                          09330000
      BPS0 := "."; << SET AT END OF GROUP STRING >>                     09335000
      DEL;                                                              09340000
      END                                                               09345000
   ELSE  <<NON-SAVED FILE>>                                             09350000
      BEGIN                                                             09355000
      GROUP(8) := " "; ACCT(8) := " ";                                  09360000
      MOVE  GROUP := MGROUP,(8);                                        09365000
      SCAN GROUP UNTIL "  ",1;                                 <<06094>>09370000
      BPS0 := ".";                                             <<06094>>09375000
      DEL;                                                     <<06094>>09380000
      MOVE  ACCT := MACCT,(8);                                          09385000
      MOVE * := GROUP WHILE AN,1;  <<INSERT GROUP NAME>>                09390000
      BPS0 := ".";  <<INSERT ".">>                                      09395000
      ASSEMBLE (INCA);  <<SKIP OVER ".">>                               09400000
      MOVE * := ACCT WHILE AN,0;  <<INSERT ACCOUNT NAME>>               09405000
      MOVE * := *,(1);  <<INSERT TRAILING BLANK>>                       09410000
      MOVE * := ACCT WHILE AN,0;  <<INSERT ACCOUNT NAME>>               09415000
      MOVE * := *,(1)  <<INSERT TRAILING BLANK>>                        09420000
      END;                                                              09425000
<<   * * *  CHECK FOR VALID LIBRARAY SEARCH  * * *  >>                  09430000
   TOS := MLIBSEARCH;             <<LIBRARY SEARCH LEVEL>>              09435000
   IF GROUP = B1,(4) THEN         <<PUBLIC GROUP?>>                     09440000
    IF ACCT = B2,(4) THEN         <<SYSTEM ACCOUNT?>>                   09445000
     IF TOS <> 0 THEN             <<LIB NEQ TO SYS?>>                   09450000
     BEGIN                                                              09455000
         MLIBSEARCH:=0;                                                 09460000
     END                                                                09465000
     ELSE                                                               09470000
    ELSE                                                                09475000
     IF TOS = 2 THEN MLIBSEARCH := 1 <<DEFAULT TO PUB SEARCH>>          09480000
     ELSE                                                               09485000
   ELSE                                                                 09490000
     DEL;                                                               09495000
   SLCAP(0):=1; <<SYS SL HAS PM CAPABILITY>>                            09500000
   LIBNO := MLIBSEARCH;                                                 09505000
   WHILE > DO                                                           09510000
   BEGIN << DETERMINE GROUP CAPABILITY >>                               09515000
      SLCAP(LIBNO):=0;                                                  09520000
      TOS := SLFNAME(LIBNO);                                            09525000
      GETNAMES(*);                                                      09530000
      DIRECFIND (8,0D,ACCT,GROUP,BUF,BUF);<< GET GROUP ENTRY >>         09535000
      IF = THEN SLCAP(LIBNO) := BUF(23).(9:1); << PM BIT >>             09540000
      LIBNO := LIBNO - 1;                                               09545000
   END;                                                                 09550000
   TOS := CCE;  <<OK CONDITION CODE>>                                   09555000
   GO GETOUT;                                                           09560000
                                                                        09565000
ABORT:                                                                  09570000
   MERROR := TOS;  <<INSERT ERROR NR.>>                                 09575000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                09580000
                                                                        09585000
GETOUT:                                                                 09590000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            09595000
   END;                                                                 09600000
$PAGE                                                                   09605000
PROCEDURE VALIDCAP (FLAG);                                              09610000
  <<CHECKS THE PROGRAM FILE CAPABILITY TO SEE IF IT IS A >>             09615000
  <<SUBSET OF THE GROUP OR USER'S CAPABILITY.  NOTE THAT >>             09620000
  <<THIS PROCEDURE USES CONDITION CODE TO INDICATE AN ERROR>>           09625000
  VALUE FLAG;                                                           09630000
  LOGICAL FLAG;                                                         09635000
  OPTION UNCALLABLE;                                                    09640000
  BEGIN                                                                 09645000
   ARRAY BUF (0:40) = Q;                                                09650000
   ARRAY GROUP (*) = BUF;                                               09655000
   ARRAY ACCT (*) = BUF(4);                                             09660000
   TOS := PCAPABILITY;                                                  09665000
   TOS.(7:2) := 0;  <<CLEAR "IA" AND "BA">>                             09670000
   IF TOS <> 0 THEN  <<NON-STANDARD CAPABILITIES?>>                     09675000
     BEGIN                                                              09680000
      TOS := @GROUP; PS0 := "  ";                                       09685000
      ASSEMBLE(DUP,INCB); TOS := 7; ASSEMBLE(MOVE 3);                   09690000
      IF FLAG THEN  <<SAVED FILE?>>                                     09695000
        BEGIN                                                           09700000
         TOS := @ACCT&LSL(1);                                           09705000
         TOS := @GROUP&LSL(1);                                          09710000
         SCAN BLINE UNTIL ".",1;  <<SKIP OVER LOCAL NAME>>              09715000
         TOS := TOS+1;                                                  09720000
         MOVE * := * WHILE AN,0;  <<INSERT GROUP NAME>>                 09725000
         ASSEMBLE(DELB,INCA);                                           09730000
         MOVE * := * WHILE AN;  <<INSERT ACCOUNT NAME>>                 09735000
         DIRECFIND (8,0D,ACCT,GROUP,BUF,BUF);<<GROUP ENTRY>>            09740000
         IF < THEN  <<ERROR?>>                                          09745000
           BEGIN                                                        09750000
            TOS := ERR74; GO ABORT                                      09755000
           END;                                                         09760000
         TOS := BUF(23)  <<GROUP'S RESOURCE CAPABILITIES>>              09765000
        END                                                             09770000
      ELSE  <<NON-SAVED FILE>>                                          09775000
        BEGIN                                                           09780000
         TOS := USERCAP2  <<USER'S RESOURCE CAPABILITIES>>              09785000
        END;                                                            09790000
      USERCAP := S0.(9:1); << PM BIT >>                                 09795000
      TOS := PCAPABILITY;                                               09800000
      ASSEMBLE(DUP,CAB; AND,CMP);                                       09805000
      IF <> THEN  <<NOT SUBSET?>>                                       09810000
        BEGIN                                                           09815000
         TOS := ERR39; GO ABORT                                         09820000
        END                                                             09825000
     END;                                                               09830000
   TOS := CCE;  <<OK CONDITION CODE>>                                   09835000
   GO GETOUT;                                                           09840000
                                                                        09845000
ABORT:                                                                  09850000
   MERROR := TOS;  <<ERROR NR.>>                                        09855000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                09860000
                                                                        09865000
GETOUT:                                                                 09870000
   CONDCODE := TOS  <<STORE CONDITION CODE>>                            09875000
   END;                                                                 09880000
$PAGE                                                                   09885000
PROCEDURE EXTNPARMS;                                                    09890000
   <<CALCULATES THE UNSATISFIED EXTERNAL ENTRY PARAMETERS>>             09895000
   OPTION UNCALLABLE;                                                   09900000
   BEGIN                                                                09905000
     UXNC := UXP.(4:4);                                                 09910000
     @UXP1 := @UXP+UXP.(4:3)+1;                                         09915000
     @UXP2 := @UXP1+UXNR+1;                                             09920000
     UXNW := @UXP2-@UXP+PARMLEN(UXPARMS)                                09925000
   END;                                                                 09930000
$PAGE                                                                   09935000
PROCEDURE SATISFYPROG;                                                  09940000
  <<SATISFIES THE EXTERNALS OF THE PROGRAM AND CONSTRUCTS>>             09945000
  <<THE SATISFIED EXTERNAL TABLE.  NOTE THIS PROCEDURE >>               09950000
  <<USES THE CONDITION CODE TO INDICATE AN ERROR>>                      09955000
  OPTION UNCALLABLE;                                                    09960000
  BEGIN                                                                 09965000
                                                                        09970000
    <<* * * OPEN PROGRAM FILE * * *>>                                   09975000
                                                                        09980000
    PROGKEY := MPROGKEY';  <<PROG. FILE KEY>>                           09985000
    TOS := 0;  <<FOR RESULT OF FOPENDA>>                                09990000
    TOS := 0;                                                           09995000
    TOS := MPROGKEY';                                                   10000000
    S2 := BS1;  <<LOGICAL DEVICE NR.>>                                  10005000
    BS1 := 0;  <<CLEAR LOG. DEV. NR.>>                                  10010000
    PROGFNUM := FOPENDA (*,*,%(2)111110111,,,,,,MPVINFO);      <<06094>>10015000
    IF < THEN  <<ERROR?>>                                               10020000
       BEGIN                                                            10025000
       FCHECK(0,MFERROR);  <<FILE SYS. ERROR NR'S>>                     10030000
       TOS := ERR53; GO ABORT                                           10035000
       END;                                                             10040000
    FLOCK(PROGFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                     10045000
                                                                        10050000
    <<* * * READ RECORDS 0 AND 1 * * *>>                                10055000
                                                                        10060000
    DTEMP4:=0D;                                                         10065000
    FREADDIR(PROGFNUM,BUF1,P256,DTEMP4); <<REC 0,1>>                    10070000
    IF <> THEN GO IOERROR;  <<ERROR?>>                                  10075000
    NPA := BUF1(1);  <<NR. SEGMENTS>>                                   10080000
    IF LOGICALMAPPING THEN                                              10085000
      BEGIN     <<MAPPING FIRMWARE PRESENT>>                            10090000
        IF NOT (1<=NPA<=255) THEN                                       10095000
          BEGIN <<ILLEGAL # SEGMENTS>>                                  10100000
            TOS:=ERR37;                                                 10105000
            GO ABORT;                                                   10110000
          END;                                                          10115000
      END                                                               10120000
     ELSE                                                               10125000
      BEGIN     <<NO MAPPING FIRMWARE>>                                 10130000
        IF NOT (1<=NPA<=63) THEN                                        10135000
          BEGIN <<ILLEGAL # SEGMENTS>>                                  10140000
            TOS:=ERR37;                                                 10145000
            GO ABORT;                                                   10150000
          END;                                                          10155000
      END;                                                              10160000
    TOS := ABS(MAXCODESEG);   << GET MAX # CODE SEGMENTS >>             10165000
    IF TOS < NPA THEN  <<TOO MANY SEGMENTS?>>                           10170000
       BEGIN                                                            10175000
       TOS := ERR38; GO ABORT                                           10180000
       END;                                                             10185000
    TEMP1:=28+NPA+(NPA+1)&LSR(1);                                       10190000
    <<TEMP1=NUMBER OF WORDS NEEDED>>                                    10195000
    MAKEROOMINDL(TEMP1);                                                10200000
    IF < THEN GO NFG;   <<ERROR>>                                       10205000
    @PROGREC0:=@DLAREA1-TEMP1;                                          10210000
    @DLAREA1:=@DLAREA1-TEMP1;                                           10215000
    @PTEMP3:=@PROGREC0;                                                 10220000
    <<MOVE ALL OF PROGRAM FILE INFO INTO DL AREA-->>                    10225000
    <<DO IT IN 256 WORD CHUNKS                    >>                    10230000
    TEMP2:=P256;                                                        10235000
    WHILE TEMP1 > 0 DO                                                  10240000
      BEGIN           <<MOVE UP TO 256 WORDS>>                          10245000
        IF TEMP1 < TEMP2 THEN TEMP2:=TEMP1;                             10250000
        MOVE PTEMP3:=BUF1,(TEMP2);                                      10255000
        TEMP1:=TEMP1-TEMP2;                                             10260000
        IF TEMP1 > 0 THEN                                               10265000
          BEGIN    <<MORE TO MOVE--READ NEXT 2 RECORDS>>                10270000
            @PTEMP3:=@PTEMP3+TEMP2;                                     10275000
            DTEMP4:=DTEMP4+2D;                                          10280000
            FREADDIR(PROGFNUM,BUF1,P256,DTEMP4);                        10285000
            IF <> THEN GO IOERROR;  <<ERROR>>                           10290000
          END;                                                          10295000
      END; <<WHILE>>                                                    10300000
                                                                        10305000
    <<* * * GET FILE CHARACTERISTICS * * *>>                            10310000
                                                                        10315000
    BLANKLINE;                                                          10320000
    IF < THEN GO NFG;  <<ERROR?>>                                       10325000
    TOS := 0;  <<FOR FOPTIONS>>                                         10330000
    TOS := PROGFNUM;                                                    10335000
    MOVE BLINE := "PROGRAM FILE ",2;                                    10340000
    FGETINFO(*,*,S2);                                                   10345000
    VALIDCAP(S0);  <<CHECK CAPABILITY>>                                 10350000
    IF < THEN GO NFG;  <<ERROR?>>                                       10355000
    GETSLNAMES(*);                                                      10360000
    IF < THEN GO NFG;  <<ERROR?>>                                       10365000
    PRINTLINE;                                                          10370000
    IF < THEN GO NFG;  <<ERROR?>>                                       10375000
    BLANKLINE;                                                          10380000
    IF < THEN GO NFG;  <<ERROR?>>                                       10385000
                                                                        10390000
    <<* * * FORMAT EXTERNAL LIST * * *>>                                10395000
                                                                        10400000
    TOS:=(PENTRYRECD-PEXTERNALRECD)&LSL(7);<<NR. WORDS>>                10405000
    MAKEROOMINDL(S0);                                                   10410000
    IF < THEN GO NFG;  <<ERROR?>>                                       10415000
    FREADDIR(PROGFNUM,DLAREA2,S0,                                       10420000
                      DOUBLE(LOGICAL(PEXTERNALRECD)));                  10425000
    IF <> THEN GO IOERROR;  <<ERROR?>>                                  10430000
    @UXP := @DLAREA2;  <<INIT. ENTRY POINTER>>                          10435000
    WHILE UXP <> 0 DO                                                   10440000
       BEGIN                                                            10445000
       EXTNPARMS;                                                       10450000
       UXUTYPE:=14;  <<SOURCE OF EXTERNAL=PROG SEG>>                    10455000
       @UXP := @UXP+UXNW  <<NEXT ENTRY>>                                10460000
       END;                                                             10465000
    @DLAVAIL := @UXP;  <<INIT. DL AVAILABLE POINTER>>                   10470000
                                                                        10475000
    <<* * * SATISFY EXTERNALS OF PROGRAM * * *>>                        10480000
                                                                        10485000
    SATISFY;                                                            10490000
    IF < THEN GO NFG;  <<ERROR?>>                                       10495000
    TOS := CCE;  <<OK CONDITION CODE>>                                  10500000
    GO GETOUT;                                                          10505000
                                                                        10510000
IOERROR:                                                                10515000
    FERROR(PROGFNUM);                                                   10520000
    GO NFG;                                                             10525000
                                                                        10530000
ABORT:                                                                  10535000
    MERROR := TOS;  <<ERROR NR.>>                                       10540000
                                                                        10545000
NFG:                                                                    10550000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               10555000
                                                                        10560000
GETOUT:                                                                 10565000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           10570000
  END;                                                                  10575000
$PAGE                                                                   10580000
PROCEDURE SATISFYPROC;                                                  10585000
  <<FINDS THE PROCEDURE AND SATISFIES ALL IT'S EXTERNALS>>              10590000
  <<NOTE THIS PROCEDURE USES CONDTION CODE TO INDICATE AN>>             10595000
  <<ERROR>>                                                             10600000
  OPTION UNCALLABLE;                                                    10605000
  BEGIN                                                                 10610000
                                                                        10615000
    <<* * * PRIME EXTERNAL TABLE WITH PROCEDURE ENTRY * * *>>           10620000
                                                                        10625000
    MAKEROOMINDL(10);                                                   10630000
    IF < THEN GO NFG;  <<ERROR?>>                                       10635000
    MOVE DLAREA2 := MPROCNAME',(8);                                     10640000
    TOS := @DLAREA2+DLAREA2.(4:3)+1;                                    10645000
    TOS:=%170001;  <<SOURCE OF EXTERNAL=LOADPROC,NR=1>>                 10650000
    PS1:=TOS;                                                           10655000
    TOS:=TOS+1;                                                         10660000
    TOS:=0 D;      <<REFERENCES AND PARMS>>                             10665000
    DPS2 := TOS;                                                        10670000
    @DLAVAIL := TOS+2;  <<RESET DL AVAILABLE POINTER>>                  10675000
                                                                        10680000
    <<* * * FIND PROCEDURE AND SATISFY IT'S EXTERNALS * * *>>           10685000
                                                                        10690000
    GETSLNAMES(FALSE);  <<GET SL FILE NAMES>>                           10695000
    SATISFY;                                                            10700000
    IF < THEN GO NFG;  <<ERROR?>>                                       10705000
    TOS := CCE;  <<OK CONDITION CODE>>                                  10710000
    GO GETOUT;                                                          10715000
                                                                        10720000
NFG:                                                                    10725000
    TOS := CCL;  <<ERROR CONDITION CODE>>                               10730000
                                                                        10735000
GETOUT:                                                                 10740000
    CONDCODE := TOS  <<STORE CONDITION CODE>>                           10745000
  END;                                                                  10750000
PROCEDURE SATISFY;                                                      10755000
   <<STEPS THRU THE SL FILES AND TRIES TO SATISFY THE >>                10760000
   <<EXTERNALS IN THE UNSATISFIED EXTERNAL TABLE, THEREBY>>             10765000
   <<CONSTRUCTING A DATA BASE OF ALL REFERENCED SEGS AND>>              10770000
   <<THEIR STT ENTRIES.  THIS PROCEDURE USES CONDITION  >>              10775000
   <<CODE TO INDICATE AN ERROR.                         >>              10780000
   OPTION UNCALLABLE;                                                   10785000
   BEGIN                                                                10790000
   BYTE ARRAY B3 (0:2)=PB := "SPG";                                     10795000
   BYTE ARRAY B4(0:12)=PB := "INCOMPATIBLE ";                           10800000
   BYTE ARRAY B5(0:12)=PB := "FUNCTION FOR ";                           10805000
   BYTE ARRAY B6(0:24)=PB := "NUMBER OF PARAMETERS FOR ";               10810000
   BYTE ARRAY B7(0:14)=PB := "PARAMETERS FOR ";                         10815000
   BYTE ARRAY B8(0:13)=PB := " PARAMETER(S) ";                          10820000
   DEFINE UXSEG = UXP1(TEMP2).(8:8)#, <<REFERENCING SEG #>>             10825000
          UXSTT = UXP1(TEMP2).(0:8)#; <<REFERENCING STT #>>             10830000
   INTEGER SAVEDB,SAVESIR,SEGNR,SEARCHERR;                              10835000
   INTEGER ARRAY TRACE0'EXT(0:6)=PB:= %3524, <<CN=7 , T >>              10840000
                                      %51101,<<   R , A >>              10845000
                                      %41505,<<   C , E >>              10850000
                                      %30047,<<   0 , ' >>              10855000
                                     %170001,<<SRC=15,NR=1>>            10860000
                                           0,<<REFERENCES>>             10865000
                                           0;<<PARMS    >>              10870000
   INTEGER BINDINGERROR := 0;   <<BINDING ERROR FLAG>>                  10875000
   LOGICAL ARRAY SEGS (0:15)=Q; <<SEGMENTS REFERENCED BIT MAP>>         10880000
   INTEGER ARRAY PARMS(0:4)=Q;  <<PARMCHECK ARRAY>>                     10885000
   INTEGER POINTER SEGPTR, <<PTR TO DATA BASE SEG ENTRY>>               10890000
                   STTPTR; <<PTR TO DATA BASE STT ENTRY>>               10895000
   LOGICAL POINTER PTEMP1,PTEMP2; <<TEMP PTRS>>                         10900000
$PAGE                                                                   10905000
SUBROUTINE TYPESTRING (BUF,TYPE);                                       10910000
  VALUE TYPE;                                                           10915000
  BYTE ARRAY BUF;                                                       10920000
  INTEGER TYPE;                                                         10925000
  BEGIN                                                                 10930000
    TOS := DS2;                                                         10935000
    IF TOS = 14                                                         10940000
      THEN MOVE * := "PROG"                                             10945000
      ELSE                                                              10950000
        BEGIN                                                           10955000
          MOVE * := B3(S2),(1),2;                                       10960000
          MOVE * := "SL"                                                10965000
        END                                                             10970000
  END;                                                                  10975000
$PAGE                                                                   10980000
SUBROUTINE PARMS'MATCH;                                                 10985000
  <<PARMS OF EXTERNAL SATISFIER MATCH.  BUILD LOADMAP>>                 10990000
  <<INFO AND ENTRIES IN SLDATABASE FOR SATISFIER.    >>                 10995000
  BEGIN                                                                 11000000
    IF MLMAP THEN                                                       11005000
      BEGIN       <<LOADMAP DESIRED>>                                   11010000
        TOS := @BLINE;                                                  11015000
        TOS:=@UXNAME&LSL(1)+1;                                          11020000
        MOVE * := *,(UXNC);                                             11025000
        TYPESTRING(BLINE(16),UXUTYPE);                                  11030000
        NTOA(UXPARMS.(0:2),8,BLINE(21));                                11035000
        TYPESTRING(BLINE(31),SLNR);                                     11040000
        NTOA(SLPARMS.(0:2),8,BLINE(36));                                11045000
        NTOA(SLSTTNR,8,BLINE(40));                                      11050000
        NTOA(SLSEGNR,8,BLINE(44));                                      11055000
        XREG := UXNR;                                                   11060000
        WHILE <> DO                                                     11065000
           BEGIN                                                        11070000
             TOS := UXP1(XREG).(0:8);                                   11075000
             TOS := 8;                                                  11080000
             TOS := @BLINE+25;                                          11085000
             NTOA(*,*,*);                                               11090000
             TOS := UXP1(XREG).(8:8);                                   11095000
             TOS := 8;                                                  11100000
             TOS := @BLINE+29;                                          11105000
             NTOA(*,*,*);                                               11110000
             PRINTLINE;                                                 11115000
             IF < THEN GO NFG;                                          11120000
             XREG := XREG-1                                             11125000
           END;                                                         11130000
      END;                                                              11135000
    <<CONSTRUCT SATISFIED DATA BASE ENTRIES>>                           11140000
    TEMP2:=UXNR+1;                <<# REFERENCES>>                      11145000
    WHILE ( TEMP2:=TEMP2-1) > 0 DO                                      11150000
      BEGIN                       <<ENTRY FOR EACH REFERENCE>>          11155000
        TOS:=BLDSEGENTRY(UXUTYPE,UXSEG);                                11160000
        IF < THEN GO TO NFG; <<NO ROOM>>                                11165000
        @SEGPTR:=TOS;                                                   11170000
        TOS:=BLDSTTENTRY(SEGPTR,UXSTT);                                 11175000
        IF < THEN GO TO NFG; <<NO ROOM>>                                11180000
        @STTPTR:=TOS;                                                   11185000
        <<INSERT STT DATA>>                                             11190000
        STTPTR(DBSAT):=SLNR;   <<SATISFIER TYPE>>                       11195000
        STTPTR(DBPLABEL):=SLPLABEL;     <<SATISFIER PLABEL>>            11200000
      END; <<WHILE>>                                                    11205000
    <<BUILD SEG ENTRY IN DATA BASE>>                                    11210000
    <<FOR SATISFIER               >>                                    11215000
    BLDSEGENTRY(SLNR,SLSEGNR);                                          11220000
    IF < THEN GO TO NFG; <<NOROOM>>                                     11225000
    IF ALLOCPROC AND SLNR=0 AND SLP.(3:1)=1                             11230000
      THEN BEGIN                                                        11235000
             TOS:=ERR85; GO ABORT;                                      11240000
           END;                                                         11245000
    IF SLNR<>0 OR SLP.(3:1)=0 THEN                                      11250000
      BEGIN  <<MUST CHECK INDIRECT REFS>>                               11255000
        SETBIT(SEGS,SLSEGNR);  <<SET REF'ED BIT>>                       11260000
      END;                                                              11265000
  END; <<PARMS'MATCH>>                                                  11270000
$PAGE                                                                   11275000
SUBROUTINE PARMS'MISMATCH;                                              11280000
  <<PARMS OF SATISFIER DO NOT MATCH.  MOVE INFO TO >>                   11285000
  <<LOADMAP.                                       >>                   11290000
  BEGIN                                                                 11295000
    BINDINGERROR:=BINDINGERROR+1;                                       11300000
    MOVE BLINE := B4,(13),2;                                            11305000
    CASE PARMS OF                                                       11310000
       BEGIN                                                            11315000
       ;                                                                11320000
       MOVE * := B5,(13),2;                                             11325000
       MOVE * := B6,(25),2;                                             11330000
       MOVE * := B7,(15),2;                                             11335000
       END;                                                             11340000
    TOS := @UXNAME&LSL(1)+1;                                            11345000
    MOVE * := *,(UXNC),2;                                               11350000
    IF PARMS = 3 THEN <<ONE OF THE PARMS?>>                             11355000
       BEGIN                                                            11360000
       MOVE * := B8,(14);                                               11365000
       PRINTBITMAP(PARMS(1));                                           11370000
       IF < THEN GO NFG; <<ERROR?>>                                     11375000
       END                                                              11380000
    ELSE                                                                11385000
       BEGIN                                                            11390000
       DEL;  <<MOVE DEST>>                                              11395000
       PRINTLINE';                                                      11400000
       IF < THEN GO NFG; <<ERROR?>>                                     11405000
       END;                                                             11410000
  END; <<PARMS'MISMATCH>>                                               11415000
$PAGE                                                                   11420000
LOGICAL SUBROUTINE CHKALLOCATED;                                        11425000
  <<DETERMINE WHETHER SEGNR HAS ALREADY BEEN ALLOCATED>>                11430000
  BEGIN                                                                 11435000
    CHKALLOCATED:=FALSE;                                                11440000
    <<CHECK IF CURRENT SL HAS BEEN LOADED>>                             11445000
    TOS:=0;       <<LSEARCH RESULT>>                                    11450000
    TOS:=SLKEY(SLNR); <<SL KEY>>                                        11455000
    SAVESIR:=GETSIR(SEGTABSIR);                                         11460000
    SAVEDB:=EXCHANGEDB(SEGTABDST);                                      11465000
    IF LSEARCH(*,NORMAL,SLFILE) THEN                                    11470000
      BEGIN       <<SL EXISTS>>                                         11475000
        <<CHECK IF SEGNR HAS BEEN LOADED>>                              11480000
        TOS:=0;   <<TESTBIT RESULT>>                                    11485000
        TOS:=@ENTP2; <<ARRAY>>                                          11490000
        IF TESTBIT(*,SEGNR) THEN                                        11495000
          BEGIN   <<SEGNR HAS BEEN LOADED>>                             11500000
            <<CHECK IF SEGNR HAS BEEN ALLOCATED>>                       11505000
            <<FIND CORRECT SEGLIST ENTRY       >>                       11510000
            SI:=@ENTP3;                                                 11515000
            @ENTP3:=@ENTP3+ESLSEG'SL*3;                                 11520000
            WHILE (@ENTP3:=@ENTP3-3) >= SI DO                           11525000
              BEGIN  <<CHECK EACH SEGLIST ENTRY>>                       11530000
                IF ENTP3.(0:8) = SEGNR THEN                             11535000
                  BEGIN  <<FOUND CORRECT SEGLIST ENTRY>>                11540000
                    CHKALLOCATED:=ENTP3.(12:1);<<GET "A" BIT>>          11545000
                    RELSIR(SEGTABSIR,SAVESIR);                          11550000
                    EXCHANGEDB(SAVEDB);                                 11555000
                    RETURN;                                             11560000
                  END;                                                  11565000
              END; <<WHILE>>                                            11570000
          END;                                                          11575000
      END;                                                              11580000
    RELSIR(SEGTABSIR,SAVESIR);                                          11585000
    EXCHANGEDB(SAVEDB);                                                 11590000
  END; <<CHKALLOCATED>>                                                 11595000
$PAGE                                                                   11600000
  <<* * * INITIALIZE HIT/MISS COUNTERS * * *>>                          11605000
                                                                        11610000
  IF LOADCACHESEG<>0 THEN                                               11615000
    BEGIN                                                               11620000
      TOS:=@HITS;             <<TARGET>>                                11625000
      TOS:=LOADCACHESEG;      <<SOURCE SEGMENT>>                        11630000
      TOS:=CACHEHITS;         <<SOURCE>>                                11635000
      TOS:=4;                 <<LENGTH>>                                11640000
      ASSEMBLE(MFDS 4);       <<MOVE>>                                  11645000
    END;                                                                11650000
                                                                        11655000
  <<ALLOCATE SPACE FOR SLSEGS>>                                         11660000
  TOS:=(MLIBSEARCH+1)&LSL(4); <<16 WORDS/SL>>                           11665000
  MAKEROOMINDL(*);                                                      11670000
  IF < THEN GO TO NFG;  <<NO ROOM>>                                     11675000
  <<SETUP POINTERS TO SLSEGS>>                                          11680000
  SLNR:=MLIBSEARCH+1;                                                   11685000
  WHILE (SLNR:=SLNR-1) >= 0 DO                                          11690000
    BEGIN                                                               11695000
      TOS:=@DLAREA1-16;                                                 11700000
      SLSEGS(SLNR):=S0;                                                 11705000
      ASSEMBLE(DUP);                                                    11710000
      CLEARBITMAP(*);                                                   11715000
      @DLAREA1:=TOS;                                                    11720000
      SLPVINFO(SLNR):=0;                                                11725000
    END;                                                                11730000
  <<SEARCH EACH SL FOR SATISFIERS OF EXTERNALS>>                        11735000
  SLNR:=MLIBSEARCH+1;  <<SL COUNTER>>                                   11740000
  WHILE (SLNR:=SLNR-1) >= 0 AND                                         11745000
        @DLAVAIL <> @DLAREA2 DO                                         11750000
   BEGIN                                                                11755000
    CLEARBITMAP(SEGS);                                                  11760000
    IF SLNR = 0 AND       <<READY TO SEARCH SYS SL>>                    11765000
       PROGLOAD AND       <<LOADING A PROGRAM     >>                    11770000
       PSASTLT <> -1 THEN <<AND PROGRAM IS BEING TRACED>>               11775000
      BEGIN                                                             11780000
        <<INSERT EXTERNAL REFERENCE TO TRACE0'>>                        11785000
        MAKEROOMINDL(7);                                                11790000
        MOVE DLAVAIL:=TRACE0'EXT,(7);                                   11795000
        @DLAVAIL:=@DLAVAIL+7;                                           11800000
      END;                                                              11805000
                                                               <<06094>>11810000
      << DISMOUNT UNUSED MOUNTED VOL.      >>                  <<06094>>11815000
                                                               <<06094>>11820000
      IF SLNR < MLIBSEARCH THEN                                <<06094>>11825000
         IF SLPVINFO(SLNR+1) <> 0 THEN                         <<06094>>11830000
            BEGIN                                              <<06094>>11835000
               DISMOUNTVOLSET(SLPVINFO(SLNR+1),MPIN);          <<06094>>11840000
               SLPVINFO(SLNR+1):=0;                            <<06094>>11845000
            END;                                               <<06094>>11850000
                                                                        11855000
    <<* * * OPEN SL FILE * * *>>                                        11860000
                                                                        11865000
    XREG := SLNR;                                                       11870000
    IF <> THEN  <<PUBLIC OR GROUP SL>>                                  11875000
      BEGIN                                                             11880000
       IF XREG = 1 AND PSLFNAME = SSLFNAME,(11) THEN                    11885000
          GO ENDLOOP;  <<IGNORE PUBLIC SL?>>                            11890000
       TOS := 0;  <<FOR RESULT OF FOPEN>>                               11895000
       TOS := SLFNAME(XREG);  <<SL FILE NAME>>                          11900000
       SLFNUM(XREG):=FOPEN(*,%(2)10000000001,%(2)111110110);            11905000
       IF < THEN  <<ERROR?>>                                            11910000
          BEGIN                                                         11915000
          TOS := 0; FCHECK(0,S0);                                       11920000
          IF S0=51 OR S0=52 THEN                                        11925000
            BEGIN  <<NON-EXISTING SL>>                                  11930000
              DEL;                                                      11935000
              SLKEY(XREG):=0D;                                          11940000
              GO TO ENDLOOP;                                            11945000
            END;                                                        11950000
          MFERROR := TOS;  <<FILE SYS. ERROR NR'S>>                     11955000
          TOS := ERR50+SLNR;  <<ERROR NR.>>                             11960000
          GO ABORT                                                      11965000
          END;                                                          11970000
       ASSEMBLE(ADDS 4);                                                11975000
       FGETINFO(SLFNUM(XREG),,,,,,S1,,S0,,,,,,,,,,,DS3);                11980000
       IF TOS <> SLFILECODE THEN  <<TYPE SL?>>                          11985000
          BEGIN                                                         11990000
          INVALIDSL:                                                    11995000
          TOS := ERR28+XREG;                                            12000000
          GO ABORT                                                      12005000
          END;                                                          12010000
       BS2 := TOS;  <<INSERT LOG. DEV. NR.>>                            12015000
       SLKEY(XREG) := TOS;  <<SL FILE KEY>>                             12020000
       TOS := MOUNTVOLSET (SLFNUM (SLNR),MPIN);                         12025000
         IF < THEN  << MOUNT FAILURE >>                        <<06094>>12030000
            BEGIN                                              <<06094>>12035000
               SLPVINFO (SLNR) := 0;                           <<06094>>12040000
               TOS := ERR94 + SLNR;                            <<06094>>12045000
               GO ABORT;                                       <<06094>>12050000
            END                                                <<06094>>12055000
         ELSE                                                           12060000
            SLPVINFO(SLNR) := TOS;                                      12065000
      END;                                                              12070000
    FLOCK(SLFNUM(SLNR),TRUE);  <<GET FILE EXCLUSIVELY>>                 12075000
      FSETMODE(SLFNUM(XREG),2); <<WAIT UNTIL BUFFER FLUSHED>>  <<07301>>12080000
                                                                        12085000
    <<* * * ALLOCATE DL BUFFERS * * *>>                                 12090000
                                                                        12095000
    MAKEROOMINDL(128);                                                  12100000
    IF < THEN GO NFG;                                                   12105000
    TOS:=@DLAREA1-128;                                                  12110000
    SLREC1(XREG):=S0;                                                   12115000
    @DLAREA1:=TOS;                                                      12120000
    FREADDIR(SLFNUM(XREG),BUF1,P256,0D);  <<READ REC'S 0,1>>            12125000
    IF <> THEN GO IOERROR;  <<ERROR?>>                                  12130000
    IF SLID <> SLFILEID THEN GO INVALIDSL;  <<OLD VERSION?>>            12135000
    TOS:=SLREC1(XREG);                                                  12140000
    MOVE *:=BUF2,(128);  <<SAVE RECORD 1>>                              12145000
$PAGE                                                                   12150000
                                                                        12155000
    <<* * * TRY TO SATISFY EXTERNALS * * * >>                           12160000
                                                                        12165000
    SEARCHERR:=0; <<INIT ERROR FLAG>>                                   12170000
    @UXP := @DLAREA2;  <<INIT. UNSATIS. EXTN. POINTER>>                 12175000
    WHILE @UXP <> @DLAVAIL DO                                           12180000
     BEGIN                                                              12185000
      <<CYCLE THRU EACH UNSATISFIED ENTRY>>                             12190000
      EXTNPARMS;                                                        12195000
      IF UXP >= 0 AND                                                   12200000
         SEARCHSL(UXNAME,SEARCHERR) THEN                                12205000
        BEGIN                                                           12210000
          <<ENTRY IS UNSATISFIED AND    >>                              12215000
          <<SL HAS ENTRY PT OF SAME NAME>>                              12220000
          @SAVEUXP := @UXP;  <<SAVE ENTRY POINTER>>                     12225000
          WHILE @UXP <> @DLAVAIL DO                                     12230000
           BEGIN                                                        12235000
            <<CYCLE THRU EACH UNSATISFIED ENTRY FOR>>                   12240000
            <<ENTRIES OF THIS NAME--SATISFY AT ONCE>>                   12245000
            EXTNPARMS;                                                  12250000
            IF UXP >= 0 AND                                             12255000
               SAMENAME(UXNAME,SLNAME) THEN                             12260000
              BEGIN                                                     12265000
                <<UNSATISFIED ENTRY OF SAME NAME>>                      12270000
                <<CHECK IF PARAMETERS MATCH     >>                      12275000
                PARMCHECK(SLPARMS,UXPARMS,PARMS);                       12280000
                IF PARMS = 0                                            12285000
                  THEN PARMS'MATCH <<PARMS MATCH>>                      12290000
                  ELSE PARMS'MISMATCH;<<PARMS MISMATCH>>                12295000
                UXP.(0:1):=1;<<SET SAT. FLAG>>                          12300000
              END;                                                      12305000
            @UXP:=@UXP+UXNW; <<NEXT ENTRY>>                             12310000
           END; <<WHILE>>                                               12315000
          @UXP:=@SAVEUXP; <<RESTORE POINTER>>                           12320000
          EXTNPARMS;                                                    12325000
        END                                                             12330000
       ELSE IF SEARCHERR <> 0 THEN GO NFG;<<ERROR>>                     12335000
      @UXP:=@UXP+UXNW; <<NEXT ENTRY>>                                   12340000
     END; <<WHILE>>                                                     12345000
    <<REMOVE SATISFIED EXTERNALS FROM LIST>>                            12350000
    @UXP:=@DLAREA2;            <<SOURCE PTR>>                           12355000
    @PTEMP3:=@DLAREA2;         <<TARGET PTR>>                           12360000
    WHILE @UXP <> @DLAVAIL DO                                           12365000
     BEGIN                    <<EXAMINE ALL ENTRIES>>                   12370000
      EXTNPARMS;             <<SETUP SECONDARY PTRS>>                   12375000
      IF UXP >= 0 THEN                                                  12380000
        BEGIN                <<ENTRY NOT SATISFIED-SAVE>>               12385000
          TEMP2:=UXNW;       <<ENTRY LENGTH>>                           12390000
          IF @PTEMP3 <> @UXP THEN                                       12395000
            BEGIN            <<MOVE REQUIRED>>                          12400000
              MOVE PTEMP3:=UXP,(TEMP2);                                 12405000
            END;                                                        12410000
          @PTEMP3:=@PTEMP3+TEMP2; <<UPDATE TARGET>>                     12415000
          @UXP:=@UXP+TEMP2;       <<UPDATE SOURCE>>                     12420000
        END                                                             12425000
       ELSE                                                             12430000
        BEGIN                <<ENTRY SATISFIED-SKIP>>                   12435000
          @UXP:=@UXP+UXNW;   <<UPDATE SOURCE>>                          12440000
        END;                                                            12445000
     END; <<WHILE>>                                                     12450000
    @DLAVAIL:=@PTEMP3;         <<UPDATE AVAILABLE SPACE>>               12455000
                                                                        12460000
    <<* * * GET INDIRECTLY REFERENCED SEGMENTS * * *>>                  12465000
                                                                        12470000
    DRTRECD := 0D;  <<INIT. REC. NR.>>                                  12475000
    @PTEMP1:=SLSEGS(SLNR);                                              12480000
    SEGNR:=256;                                                         12485000
    WHILE (SEGNR:=SEGNR-1) >= 0 DO                                      12490000
     BEGIN                                                              12495000
      IF TESTBIT(SEGS,SEGNR) THEN                                       12500000
        BEGIN                   <<SEG DIRECTLY REF'ED>>                 12505000
          GETREFTABENT(SEGNR);                                          12510000
          IF < THEN GO NFG;  <<ERROR?>>                                 12515000
          <<IF ALLOCATE PROCEDURE CHECK IF SEGNR IS>>                   12520000
          <<ALREADY ALLOCATED                      >>                   12525000
          IF ALLOCPROC THEN                                             12530000
            BEGIN           <<ALLOCATE PROCEDURE>>                      12535000
              IF CHKALLOCATED THEN                                      12540000
                BEGIN       <<SEGNR ALREADY ALLOCATED>>                 12545000
                  TOS:=ERR84;                                           12550000
                  GO ABORT;                                             12555000
                END                                                     12560000
               ELSE                                                     12565000
                BEGIN       <<SEGNR NOT ALLOCATED>>                     12570000
                  <<FIND SEG ENTRY OF SEGNR IN SLDATABASE>>             12575000
                  @SEGPTR:=FINDSEGENTRY(SLNR,SEGNR);                    12580000
                  IF < THEN SUDDENDEATH(350);                           12585000
                  SEGPTR(DBLBIT):=1;<<SET BEING ALLOC FLAG>>            12590000
                END;                                                    12595000
            END;                                                        12600000
          <<GET BIT MAP OF ALL INDIRECTLY REF'ED SEGS>>                 12605000
          @PTEMP2:=@SLREFEDSEGS;                                        12610000
          XREG:=16;                                                     12615000
          WHILE (XREG:=XREG-1) >= 0 DO                                  12620000
            BEGIN                                                       12625000
              PTEMP1(XREG):=PTEMP1(XREG) LOR PTEMP2(XREG);              12630000
            END;                                                        12635000
        END;                                                            12640000
     END; <<WHILE>>                                                     12645000
                                                                        12650000
          <<* * * GET EXTERNALS OF SEGMENTS * * *>>                     12655000
                                                                        12660000
    <<EXTERNALS OF ALL DIRECTLY OR INDIRECTLY >>                        12665000
    <<REFERENCED SEGMENTS MUST BE CHECKED     >>                        12670000
    SEGNR:=256;                                                         12675000
    WHILE (SEGNR:=SEGNR-1) >= 0 DO                                      12680000
     BEGIN                                                              12685000
      TOS:=0; <<TESTBIT RESULT>>                                        12690000
      TOS:=SLSEGS(SLNR);                                                12695000
      TOS:=SEGNR;                                                       12700000
      IF TESTBIT(*,*) THEN                                              12705000
        BEGIN  <<SEG REF'ED DIRECTLY OR INDIRECTLY>>                    12710000
          <<BUILD SEG ENTRY IN DATA BASE >>                             12715000
          BLDSEGENTRY(SLNR,SEGNR);                                      12720000
          IF < THEN GO TO NFG;  <<NO ROOM>>                             12725000
          GETREFTABENT(SEGNR);                                          12730000
          IF < THEN GO NFG;  <<ERROR?>>                                 12735000
          IF NOT SLSATISFIEDSEG THEN                                    12740000
            BEGIN  <<UNSATISFIED EXTERNALS EXIST>>                      12745000
              TOS := SLFNUM(SLNR);                                      12750000
              TOS := (SLNRRECS-SLSLD.(2:7)-1)&LSL(7);                   12755000
              TOS := P256-SLSLD.(9:7);<<# WORDS OF SPACING>>            12760000
              ASSEMBLE(DDUP,ADD);                                       12765000
              MAKEROOMINDL(*);                                          12770000
              IF < THEN GO NFG;  <<ERROR?>>                             12775000
              TOS := TOS+@DLAVAIL;  <<BUFFER ADR.>>                     12780000
              ASSEMBLE(XCH,ZERO);                                       12785000
              TOS := SLSLD.(2:7)+SLSA+1;  <<REC. NR.>>                  12790000
              FREADDIR(*,*,*,*);                                        12795000
              IF <> THEN GO IOERROR;  <<ERROR?>>                        12800000
              <<EXAMINE EACH EXTERNAL REFERENCE>>                       12805000
              TOS := @DLAVAIL;  <<TARGET POINTER>>                      12810000
              TOS := @DLAVAIL+P256;  <<SOURCE POINTER>>                 12815000
              TOS := PS0;  <<FIRST WORD OF NAME>>                       12820000
              DO                                                        12825000
               BEGIN                                                    12830000
                 IF < THEN                                              12835000
                   BEGIN <<THIS EXTERNAL SATISFIED>>                    12840000
                     <<SKIP TO NEXT ENTRY>>                             12845000
                     TOS := TOS+TOS.(4:3)+2;                            12850000
                     ASSEMBLE(DDUP,ZROB);                               12855000
                     TOS := TOS+PARMLEN(*)                              12860000
                   END                                                  12865000
                  ELSE                                                  12870000
                   BEGIN <<THIS EXTERNAL UNSATISFIED>>                  12875000
                     <<BUILD UNSAT'ED ENTRY IN LIST>>                   12880000
                     TOS := TOS.(4:3)+1;                                12885000
                     ASSEMBLE(MOVE 1);  <<MOVE NAME>>                   12890000
                     PS1:=SLNR&LSL(12)+1;<<TYPE AND # REFS>>            12895000
                     ASSEMBLE(INCB,DDUP; ZROB,INCA);                    12900000
                     TOS := PARMLEN(*)+1;                               12905000
                     ASSEMBLE(MOVE 1)<<P-LABEL & PARM INFO>>            12910000
                   END;                                                 12915000
                 TOS := PS0;  <<NEXT FIRST WORD OF NAME>>               12920000
               END UNTIL =;                                             12925000
              DDEL;  <<1ST WORD NAME,SOURCE PTR>>                       12930000
              @DLAVAIL := TOS                                           12935000
            END;                                                        12940000
        END;                                                            12945000
     END; <<WHILE>>                                                     12950000
    SAVEREFTABBUF;  <<SAVE BUFFER>>                                     12955000
    IF < THEN GO NFG;  <<ERROR?>>                                       12960000
                                                                        12965000
ENDLOOP:                                                                12970000
   END;                                                                 12975000
                                                                        12980000
  <<* * * LIST UNSATISFIED EXTERNALS * * *>>                            12985000
                                                                        12990000
  IF @DLAVAIL <> @DLAREA2 THEN  <<REMAINING ENTRIES?>>                  12995000
    BEGIN                                                               13000000
     @UXP := @DLAREA2;  <<INIT. ENTRY POINTER>>                         13005000
     DO                                                                 13010000
      BEGIN                                                             13015000
        EXTNPARMS;                                                      13020000
         IF UXUTYPE = 15 THEN <<UNKNOWN PROCEDURE?>>                    13025000
           BEGIN                                                        13030000
           TOS := ERR41; GO ABORT                                       13035000
           END;                                                         13040000
        MOVE BLINE := "UNRESOLVED ",2;                                  13045000
        TOS := UXUTYPE;  <<EXTERNAL TYPE>>                              13050000
        ASSEMBLE(DDUP);                                                 13055000
        TYPESTRING(*,*);                                                13060000
        TOS := IF TOS = 3 THEN TOS+5 ELSE TOS+4;                        13065000
        MOVE * := "EXTERNAL ",2;                                        13070000
        TOS := @UXNAME&LSL(1)+1;                                        13075000
        MOVE * := *,(UXNC);                                             13080000
        PRINTLINE';                                                     13085000
        IF < THEN GO NFG;  <<ERROR?>>                                   13090000
        @UXP := @UXP+UXNW  <<NEXT ENTRY>>                               13095000
      END UNTIL @UXP = @DLAVAIL;                                        13100000
     BINDINGERROR := BINDINGERROR+1  <<SET FLAG>>                       13105000
    END;                                                                13110000
  TOS := BINDINGERROR;                                                  13115000
  IF <> THEN  <<BINDING ERROR?>>                                        13120000
     BEGIN                                                              13125000
     TOS := ERR27; GO ABORT                                             13130000
     END;                                                               13135000
  TOS := CCE;  <<OK CONDITION CODE>>                                    13140000
  GO GETOUT;                                                            13145000
                                                                        13150000
IOERROR:                                                                13155000
  FERROR(SLFNUM(SLNR));                                                 13160000
  GO NFG;                                                               13165000
                                                                        13170000
ABORT:                                                                  13175000
  MERROR := TOS;  <<STORE ERROR NR.>>                                   13180000
                                                                        13185000
NFG:                                                                    13190000
   SLNR := MLIBSEARCH;                                         <<06094>>13195000
   WHILE >= DO                                                 <<06094>>13200000
      BEGIN                                                    <<06094>>13205000
         IF SLPVINFO(SLNR) <> 0 THEN                           <<06094>>13210000
            DISMOUNTVOLSET(SLPVINFO(SLNR),MPIN);               <<06094>>13215000
         SLNR:=SLNR-1;                                         <<06094>>13220000
      END;                                                     <<06094>>13225000
  TOS := CCL;  <<ERROR CONDITION CODE>>                                 13230000
                                                                        13235000
GETOUT:                                                                 13240000
                                                                        13245000
  <<* * * STORE HIT/MISS COUNTERS IN CACHE * * *>>                      13250000
                                                                        13255000
  IF LOADCACHESEG<>0 THEN                                               13260000
    BEGIN                                                               13265000
      TOS:=LOADCACHESEG;       <<TARGET SEGMENT>>                       13270000
      TOS:=CACHEHITS;          <<TARGET>>                               13275000
      TOS:=@HITS;              <<SOURCE>>                               13280000
      TOS:=4;                  <<LENGTH>>                               13285000
      ASSEMBLE(MTDS 4);        <<MOVE>>                                 13290000
    END;                                                                13295000
                                                                        13300000
  @DLAVAIL := @DLAREA2;  <<RESET DL AVAILABLE POINTER>>                 13305000
  CONDCODE := TOS  <<STORE CONDITION CODE>>                             13310000
 END;                                                                   13315000
$PAGE                                                                   13320000
PROCEDURE INITSEGMAP(ALLOCFLAG);                                        13325000
  VALUE ALLOCFLAG;                                                      13330000
  LOGICAL ALLOCFLAG;                                                    13335000
  <<ALLOCATE SEGMAPDST (IF ALLOCFLAG=TRUE) AND>>                        13340000
  <<SET UP DST AND POINTERS INTO DST          >>                        13345000
  BEGIN                                                                 13350000
    INTEGER TEMP=Q+1;                                                   13355000
    INTEGER TEMP2=Q+2;                                                  13360000
    INTEGER P1DEL=Q+3;                                                  13365000
    INTEGER STTCOUNT=Q+4;                                               13370000
    INTEGER SEGMAPDEL=Q+5;                                              13375000
    INTEGER ARRAY WORKAREA(*)=Q+6;                                      13380000
                                                                        13385000
    <<INITIALIZE LOCAL VARIABLES>>                                      13390000
    TOS:=0D;      <<TEMP,TEMP2>>                                        13395000
    ASSEMBLE(DDUP,DUP); <<P1DEL,STTCOUNT,SEGMAPDEL>>                    13400000
    ASSEMBLE(DDUP); <<WORKAREA(0),WORKAREA(1)>>                         13405000
                                                                        13410000
    IF ALLOCFLAG THEN                                                   13415000
      BEGIN           <<ALLOCATE DST>>                                  13420000
        SEGMAPDST:=GETDATASEG(INITSEGMAPSIZE,MAXSEGMAPSIZE);            13425000
        IF <> THEN                                                      13430000
          BEGIN   <<ERROR>>                                             13435000
            MERROR:=ERR99;                                              13440000
            CONDCODE:=CCL;                                              13445000
            RETURN;                                                     13450000
          END;                                                          13455000
        SEGMAPSTTPOSITION:=(MAXMCSTIDX+1)&LSL(1);                       13460000
        SEGMAPLENGTH:=INITSEGMAPSIZE;                                   13465000
      END                                                               13470000
     ELSE                                                               13475000
      BEGIN           <<SEGMAP ALREADY EXISTS>>                         13480000
        <<GET HEADER ENTRY FROM DST>>                                   13485000
        TOS:=@WORKAREA;    <<TARGET>>                                   13490000
        TOS:=SEGMAPDST;    <<SOURCE DST>>                               13495000
        TOS:=0;            <<SOURCE OFFSET>>                            13500000
        TOS:=2;            <<COUNT>>                                    13505000
        ASSEMBLE(MFDS 4);                                               13510000
        SEGMAPLENGTH:=(DSTI(SEGMAPDST&LSL(2)).DSLEN-1)&LSL(2);          13515000
        <<DETERMINE IF PART 2 OF SEGMAP MUST MOVE FOR PART 1>>          13520000
        IF WORKAREA.(8:8) < MAXMCSTIDX THEN                             13525000
          BEGIN          <<PART 2 MUST BE MOVED>>                       13530000
            TEMP:=(MAXMCSTIDX+16)&LSL(1);<<NEW PART 1 LEN >>            13535000
            IF TEMP > 510 THEN TEMP:=510;                               13540000
            <<ALLOCATE ADDITIONAL SPACE FOR WORKAREA>>                  13545000
            TOS:=TEMP;                                                  13550000
            ASSEMBLE(ADDS 0);                                           13555000
            <<CLEAR REST OF WORKAREA>>                                  13560000
            WORKAREA(2):=0;                                             13565000
            MOVE WORKAREA(3):=WORKAREA(2),(TEMP-1);                     13570000
            <<GET PART 1 FROM SEGMAP>>                                  13575000
            TOS:=@WORKAREA(2);  <<TARGET>>                              13580000
            TOS:=SEGMAPDST;     <<SOURCE DST>>                          13585000
            TOS:=2;             <<SOURCE OFFSET>>                       13590000
            TOS:=WORKAREA.(8:8)&LSL(1); <<COUNT>>                       13595000
            ASSEMBLE(MFDS 4);                                           13600000
            <<ADJUST STT POINTER IN EACH ENTRY>>                        13605000
            P1DEL:=TEMP-WORKAREA.(8:8)&LSL(1);<<MOVE DISTANCE>>         13610000
            TEMP2:=WORKAREA.(8:8)&LSL(1)+3;                             13615000
            WHILE (TEMP2:=TEMP2-2) > 1 DO                               13620000
              BEGIN                                                     13625000
                IF WORKAREA(TEMP2) <> 0                                 13630000
                  THEN WORKAREA(TEMP2):=WORKAREA(TEMP2)+P1DEL;          13635000
              END; <<WHILE>>                                            13640000
            <<INSURE DST LENGTH IS SUFFICIENT>>                         13645000
            SEGMAPDEL:=WORKAREA(1)+P1DEL-SEGMAPLENGTH;                  13650000
            IF SEGMAPDEL > 0 THEN                                       13655000
              BEGIN              <<MUST EXPAND SEGMAP>>                 13660000
                SEGMAPLENGTH:=ALTDSEGSIZE(SEGMAPDST,SEGMAPDEL);         13665000
                IF <> THEN                                              13670000
                  BEGIN    <<ERROR>>                                    13675000
                    MERROR:=ERR99;                                      13680000
                    CONDCODE:=CCL;                                      13685000
                    RETURN;                                             13690000
                  END;                                                  13695000
              END;                                                      13700000
            <<MOVE PART 2 OF SEGMAP>>                                   13705000
            STTCOUNT:=(WORKAREA.(8:8)+1)&LSL(1)-WORKAREA(1);            13710000
            TOS:=SEGMAPDST;        <<TARGET DST>>                       13715000
            TOS:=WORKAREA(1)+P1DEL-1;<<TARGET OFFSET>>                  13720000
            TOS:=SEGMAPDST;        <<SOURCE DST>>                       13725000
            TOS:=WORKAREA(1)-1;    <<SOURCE OFFSET>>                    13730000
            TOS:=STTCOUNT;         <<NEGATIVE COUNT>>                   13735000
            ASSEMBLE(MDS 5);                                            13740000
            <<ADJUST SEGMAP HEADER>>                                    13745000
            WORKAREA(0):=TEMP&LSR(1); <<LEN PART 1>>           <<06539>>13750000
            WORKAREA(1):=WORKAREA(1)+P1DEL; <<MAP LENGTH>>              13755000
            <<MOVE NEW PART 1 TO SEGMAP>>                               13760000
            TOS:=SEGMAPDST;        <<TARGET DST>>                       13765000
            TOS:=0;                <<TARGET OFFSET>>                    13770000
            TOS:=@WORKAREA(0);     <<SOURCE>>                           13775000
            TOS:=TEMP+2;           <<COUNT>>                            13780000
            ASSEMBLE(MTDS 4);                                           13785000
                                                                        13790000
            SEGMAPSTTPOSITION:=WORKAREA(1);                             13795000
          END                                                           13800000
         ELSE                                                           13805000
          BEGIN          <<PART 2 DOES NOT HAVE TO MOVE>>               13810000
            SEGMAPSTTPOSITION:=WORKAREA(1);                             13815000
          END;                                                          13820000
      END;                                                              13825000
    CONDCODE:=CCE;                                                      13830000
  END; <<INITSEGMAP>>                                                   13835000
$PAGE                                                                   13840000
PROCEDURE ADDSEGDATA'SLDB;                                              13845000
  <<THIS PROCEDURE USES SL ENTRIES WITHIN THE LST>>                     13850000
  <<TO COMPLETE SLDATABASE SEG ENTRIES. NOTE THIS>>                     13855000
  <<PROCEDURE USES CONDITION CODE TO INDICATE AN >>                     13860000
  <<ERROR.                                       >>                     13865000
  BEGIN                                                                 13870000
    INTEGER TEMP  =Q+1,                                                 13875000
            WORKAREASPACE=Q+2;                                          13880000
    LOGICAL SLEXISTS=Q+3;                                               13885000
    INTEGER POINTER SEGPTR=Q+4,                                         13890000
                    SEGLISTPTR=Q+5,                                     13895000
                    SEGLIST=Q+6;                                        13900000
    INTEGER WORKAREA'DL=Q+7;                                            13905000
    INTEGER LPROCMTAB'DL=Q+8;                                           13910000
    INTEGER NUMBSLID=Q+9;                                               13915000
    INTEGER NUMBMCST=Q+10;                                              13920000
    DOUBLE POINTER SLIDPTR=Q+11;                                        13925000
    INTEGER POINTER MCSTLSPTR=Q+12;                                     13930000
    DOUBLE DTEMP=Q+13;                                                  13935000
    INTEGER ARRAY WORKAREA(*)=Q+15;                                     13940000
    DOUBLE ARRAY DWORKAREA(*)=WORKAREA;                                 13945000
                                                                        13950000
    DEFINE ACTIVE'LPROCS'= LPROCMASTERTAB(2).(8:8)#;                    13955000
                                                                        13960000
    <<LOCAL SL ENTRY DEFINITIONS>>                                      13965000
    DEFINE SEGLOGSEG = 0).(0:8#,   <<LOGSEG>>                           13970000
           SEGFLAGS= 0).(12:4#,    <<A,C,X,M BITS>>                     13975000
           SEGPHYCST = 2#;         <<PHYCST>>                           13980000
$PAGE                                                                   13985000
    LOGICAL SUBROUTINE SEGALLOCATED;                                    13990000
      <<DETERMINE WHETHER THE LOGICAL SEGMENT    >>                     13995000
      <<IN SLDATABASE SEG ENTRY HAS ALREADY BEEN >>                     14000000
      <<ALLOCATED A PHYSICAL CST BY EXAMINING THE>>                     14005000
      <<SL ENTRY IN THE LST.                     >>                     14010000
      BEGIN                                                             14015000
        SEGALLOCATED:=FALSE;    <<INITIALIZE>>                          14020000
        IF SLEXISTS THEN                                                14025000
          BEGIN                 <<SL ENTRY EXISTS>>                     14030000
            IF TESTBIT(WORKAREA(5),SEGPTR(DBLOGSEG)) THEN               14035000
              BEGIN             <<LOGSEG ALLOCATED>>                    14040000
                <<FIND SEGLIST ENTRY>>                                  14045000
                @SEGLIST:=@SEGLISTPTR;                                  14050000
                TEMP:=WORKAREA(4).(8:8);<<# SEGLIST ENTRIES>>           14055000
                WHILE (TEMP:=TEMP-1) >= 0 DO                            14060000
                  BEGIN                                                 14065000
                    IF SEGPTR(DBLOGSEG)=SEGLIST(SEGLOGSEG) THEN         14070000
                      BEGIN       <<FOUND ENTRY>>                       14075000
                        SEGALLOCATED:=TRUE;                             14080000
                        RETURN;                                         14085000
                      END                                               14090000
                     ELSE                                               14095000
                      BEGIN       <<WRONG ENTRY>>                       14100000
                        @SEGLIST:=@SEGLIST+3; <<NEXT ENTRY>>            14105000
                      END;                                              14110000
                  END; <<WHILE>>                                        14115000
                <<ALLOCATED BUT NO SEGLIST ENTRY>>                      14120000
                SUDDENDEATH(343);                                       14125000
              END;                                                      14130000
          END;                                                          14135000
      END; <<SEGALLOCATED>>                                             14140000
$PAGE                                                                   14145000
LOGICAL SUBROUTINE MATCHSLID;                                           14150000
  <<RETURN TRUE IF SLID IN MCSTLOGSEG ENTRY>>                           14155000
  <<MATCHES ONE OF THE SLKEYS BEING USED   >>                           14160000
  <<FOR THIS PROCEDURE LOAD                >>                           14165000
  BEGIN                                                                 14170000
    IF MCSTLSPTR(TEMP).(8:8) < 14 THEN                                  14175000
      BEGIN  <<SL SEG--CHECK FOR SLID MATCH>>                           14180000
        DTEMP:=SLIDPTR(MCSTLSPTR(TEMP).(8:8)); <<GET SLID>>             14185000
        SLNR:=MLIBSEARCH+1;                                             14190000
        WHILE (SLNR:=SLNR-1) >= 0 DO                                    14195000
          BEGIN                                                         14200000
            IF DTEMP = SLKEY(SLNR) THEN                                 14205000
              BEGIN               <<FOUND MATCH>>                       14210000
                MATCHSLID:=TRUE;                                        14215000
                RETURN;                                                 14220000
              END;                                                      14225000
          END; <<WHILE>>                                                14230000
      END;                                                              14235000
    MATCHSLID:=FALSE;                                                   14240000
  END; <<MATCHSLID>>                                                    14245000
$PAGE                                                                   14250000
    <<INITIALIZE LOCAL VARIABLES>>                                      14255000
    TOS:=0D;     <<TEMP,WORKAREASPACE>>                                 14260000
    ASSEMBLE(DDUP);<<SLEXISTS,SEGPTR>>                                  14265000
    TOS:=@WORKAREA+21; <<SEGLISTPTR>>                                   14270000
    ASSEMBLE(DUP);    <<SEGLIST>>                                       14275000
    TOS:=0D;          <<WORKAREA'DL,LPROCMTAB'DL>>                      14280000
    ASSEMBLE(DDUP,DDUP);<<NUMBSLID,NUMBMCST>>                           14285000
                        <<SLIDPTR,MCSTLSPTR>>                           14290000
    ASSEMBLE(DDUP);   <<DTEMP>>                                         14295000
                                                                        14300000
    IF PROGLOAD THEN                                                    14305000
      BEGIN         <<LOAD/ALLOCATE PROGRAM>>                          14310000
        <<ALLOCATE SPACE FOR MAPPED CST INDEX TABLE>>                   14315000
        MAKEROOMINDL(16);                                               14320000
        IF < THEN GO TO ERROR; <<NO ROOM>>                              14325000
        TOS:=@DLAREA1-16;                                               14330000
        @MCSTTAB:=S0;                                                   14335000
        @DLAREA1:=TOS;                                                  14340000
      END                                                               14345000
     ELSE                                                               14350000
      BEGIN         <<LOAD/ALLOCATE PROCEDURE>>                         14355000
        <<ALLOCATE SPACE FOR MAX SIZE LOADPROC MASTER>>                 14360000
        IF LOGICALMAPPING THEN                                          14365000
          BEGIN     <<MAPPING FIRMWARE PRESENT>>                        14370000
            MAKEROOMINDL(576);                                          14375000
            IF < THEN GO TO ERROR; <<NO ROOM>>                          14380000
            TOS:=@DLAREA1-576;                                          14385000
          END                                                           14390000
         ELSE                                                           14395000
          BEGIN     <<MAPPING FIRMWARE NOT PRESENT>>                    14400000
            MAKEROOMINDL(66);                                           14405000
            IF < THEN GO TO ERROR;                                      14410000
            TOS:=@DLAREA1-66;                                           14415000
          END;                                                          14420000
        @LPROCMASTERTAB:=S0;                                            14425000
        @DLAREA1:=TOS;                                                  14430000
        @MCSTTAB:=@LPROCMASTERTAB(19);                                  14435000
      END;                                                              14440000
    <<INITIALIZE DL RELATIVE VARIABLES>>                                14445000
    WORKAREA'DL:=@WORKAREA-@DLAREA2; <<DL RELATIVE>>                    14450000
    LPROCMTAB'DL:=@LPROCMASTERTAB-@DLAREA2; <<DL RELATIVE>>             14455000
    <<INITIALIZE MCSTTAB>>                                              14460000
    TOS:=@MCSTTAB;                                                      14465000
    CLEARBITMAP(*);                                                     14470000
    <<CHECK IF FURTHER MCSTTAB INITIALIZATION REQUIRED>>                14475000
    IF PROGLOAD THEN                                                    14480000
      BEGIN          <<LOAD/ALLOCATE PROGRAM>>                          14485000
        IF LOGICALMAPPING THEN                                          14490000
          BEGIN                                                         14495000
            <<MAPPED FIRMWARE--EACH PROG SEG IS MAPPED>>                14500000
            <<SET INDEX FOR EACH PROGRAM SEG>>                          14505000
            TEMP:=NPA+1;                                                14510000
            TOS:=@MCSTTAB;                                              14515000
            WHILE (TEMP:=TEMP-1) > 0 DO                                 14520000
              BEGIN                                                     14525000
                ASSEMBLE(DUP);       <<MCSTTAB PTR>>                    14530000
                SETBIT(*,TEMP);                                         14535000
              END; <<WHILE>>                                            14540000
            ASSEMBLE(DEL);           <<MCSTTAB PTR>>                    14545000
          END;                                                          14550000
      END                                                               14555000
     ELSE                                                               14560000
      BEGIN                <<LOAD/ALLOCATE PROCEDURE>>                  14565000
        IF NOT(ALLOCPROC) THEN                                          14570000
          BEGIN  <<USE LOADPROCMASTER ON LOAD PROCEDURE ONLY>>          14575000
            <<FIND LOADPROC MASTER ENTRY>>                              14580000
            TOS:=0;        <<LSEARCH RESULT>>                           14585000
            TOS:=DOUBLE(MPIN); <<KEY>>                                  14590000
            EXCHANGEDB(SEGTABDST);                                      14595000
            IF LSEARCH(*,NORMAL,LOADPROCMASTER) THEN                    14600000
              BEGIN        <<ENTRY EXISTS>>                             14605000
                NUMBSLID:=ESLID'LPROC; <<# SLID ENTRIES>>               14610000
                NUMBMCST:=EMCSTLS'LPROC;<<# MCSTLOGSEG ENTRIES>         14615000
                                                                        14620000
                <<MOVE LOADPROCMASTER FROM LST TO STACK>>               14625000
                <<ALLOW FOR EXPANSION OF SLID ARRAY>>                   14630000
                TOS:=LPROCMTAB'DL;  <<TARGET>>                          14635000
                TOS:=@ENTP;         <<SOURCE>>                          14640000
                TOS:=35+NUMBSLID&LSL(1); <<COUNT>>                      14645000
                ASSEMBLE(MVBL 3); <<MOVE DB TO DL>>                     14650000
                <<MOVE MCSTLOGSEG ARRAY>>                               14655000
                TOS:=LPROCMTAB'DL+64; <<TARGET>>                        14660000
                TOS:=@ENTP3;          <<SOURCE>>                        14665000
                TOS:=(NUMBMCST+1)&LSL(1); <<COUNT>>                     14670000
                ASSEMBLE(MVBL 3); <<MOVE DB TO DL>>                     14675000
                                                                        14680000
                EXCHANGEDB(0);                                          14685000
                @SLIDPTR:=@LPROCMASTERTAB(35);                          14690000
                @MCSTLSPTR:=@LPROCMASTERTAB(64);                        14695000
                <<INCREMENT COUNT OF ACTIVE LOADPROC'S>>                14700000
                ACTIVE'LPROCS':=ACTIVE'LPROCS'+1;                       14705000
                                                                        14710000
                <<EXAMINE EACH VALID MAPPED CST # TO  >>                14715000
                <<DETERMINE IF ITS CORRESPONDING SEGMENT >>             14720000
                <<WAS REF'ED BY THIS LOADPROC            >>             14725000
                TEMP:=(NUMBMCST+1)&LSL(1);                              14730000
                WHILE (TEMP:=TEMP-2) > 0 DO                             14735000
                  BEGIN                                                 14740000
                    TOS:=0;           <<TESTBIT RESULT>>                14745000
                    TOS:=@MCSTTAB;    <<BIT  MAP>>                      14750000
                    IF TESTBIT(*,TEMP&LSR(1)) AND                       14755000
                       MATCHSLID THEN                                   14760000
                      BEGIN           <<VALID MCST ENTRY>>              14765000
                        @SEGPTR:=FINDSEGENTRY(SLNR,                     14770000
                               MCSTLSPTR(TEMP).(0:8));                  14775000
                        IF = THEN                                       14780000
                          BEGIN  <<THIS MAPPED CST NEEDED >>            14785000
                                 <<FOR LOADPROC           >>            14790000
                            SEGPTR(DBMCST):=TEMP&LSR(1);                14795000
                            SEGPTR(DBREFFLAG):=1;                       14800000
                          END;                                          14805000
                      END;                                              14810000
                  END; <<WHILE>>                                        14815000
              END                                                       14820000
             ELSE                                                       14825000
              BEGIN           <<LOADPROC MASTER NOT FOUND>>             14830000
                SUDDENDEATH(348);                                       14835000
              END;                                                      14840000
          END;                                                          14845000
      END;                                                              14850000
    <<COMPLETE EACH SEG ENTRY IN SLDATABASE>>                           14855000
    SLNR:=MLIBSEARCH+1;                                                 14860000
    WHILE (SLNR:=SLNR-1) >= 0 DO                                        14865000
      BEGIN                      <<CYCLE THRU EACH SL>>                 14870000
        NSLA(SLNR):=0;           <<# SEGS ALLOCATED>>                   14875000
        IF SLDATABASE(SLNR) <> 0 THEN                                   14880000
          BEGIN                  <<REF'ED SEGS IN THIS SL>>             14885000
            <<FIND SL ENTRY IN LST>>                                    14890000
            TOS:=0;              <<LSEARCH RESULT>>                     14895000
            TOS:=SLKEY(SLNR);    <<SLFILE ID>>                          14900000
            EXCHANGEDB(SEGTABDST);                                      14905000
            IF LSEARCH(*,NORMAL,SLFILE) THEN                            14910000
              BEGIN              <<SL ENTRY EXISTS>>                    14915000
                SLEXISTS:=TRUE;                                         14920000
                SR:=ENTRYLENGTH;                                        14925000
                IF SR > WORKAREASPACE THEN                              14930000
                  BEGIN  <<MORE SPACE NEEDED FOR WORKAREA>>             14935000
                    TOS:=SR-WORKAREASPACE;                              14940000
                    ASSEMBLE(ADDS 0);                                   14945000
                    WORKAREASPACE:=SR;                                  14950000
                  END;                                                  14955000
                <<MOVE SL ENTRY TO STACK>>                              14960000
                TOS:=WORKAREA'DL; <<TARGET>>                            14965000
                TOS:=@ENTP;          <<SOURCE>>                         14970000
                TOS:=SR;             <<COUNT>>                          14975000
                ASSEMBLE(MVBL 3);    <<MOVE DB TO DL>>                  14980000
                <<SL ENTRY NOW EXISTS ON STACK>>                        14985000
              END                                                       14990000
             ELSE                                                       14995000
              BEGIN              <<SL ENTRY NON-EXISTENT>>              15000000
                SLEXISTS:=FALSE;                                        15005000
              END;                                                      15010000
            EXCHANGEDB(0);       <<DB BACK TO STACK>>                   15015000
            <<COMPLETE EACH SEG ENTRY IN SLDATABASE FOR SLNR>>          15020000
            @SEGPTR:=SLDATABASE(SLNR);                                  15025000
            WHILE @SEGPTR <> 0 DO                                       15030000
              BEGIN              <<CYCLE THRU EACH SEG ENTRY>>          15035000
                IF SEGALLOCATED THEN                                    15040000
                  BEGIN          <<SEG ALREADY ALLOCATED>>              15045000
                    SEGPTR(DBFLAGS):=SEGLIST(SEGFLAGS);                 15050000
                    SEGPTR(DBPHYCST):=SEGLIST(SEGPHYCST);               15055000
                    IF SEGPTR(DBMAPFLAG) = 0 AND                        15060000
                       SEGPTR(DBREFFLAG) = 0 THEN                       15065000
                      BEGIN  <<MAPPED AND NOT REF'ED BEFORE>>           15070000
                        TOS:=0; <<NEXTBIT RESULT>>                      15075000
                        TOS:=@MCSTTAB; <<BIT ARRAY>>                    15080000
                        TOS:=NEXTBIT(*);<<GET MAP INDEX>>               15085000
                        IF S0 = 0 THEN                                  15090000
                          BEGIN <<NONE AVAILABLE>>                      15095000
                            TOS:=ERR100;                                15100000
                            GO ABORT;                                   15105000
                          END;                                          15110000
                        SEGPTR(DBMCST):=TOS;                            15115000
                        NEEDSEGMAP:=TRUE;                               15120000
                      END;                                              15125000
                  END                                                   15130000
                 ELSE                                                   15135000
                  BEGIN           <<SEG NOT ALLOCATED>>                 15140000
                    IF LOGICALMAPPING AND                      <<06281>>15145000
                       LOADDOMAIN = PHYDOMAIN AND              <<06281>>15150000
                       PROCLOAD THEN                           <<06281>>15155000
                          TOS := GET'PHY'CST                   <<06281>>15160000
                    ELSE                                       <<06281>>15165000
                       TOS := GETENTRY(1);                     <<06281>>15170000
                    IF S0 = 0 THEN                                      15175000
                      BEGIN       <<INSUFFICIENT CST'S>>                15180000
                        TOS:=ERR65;                                     15185000
                        GO ABORT;                                       15190000
                      END;                                              15195000
                    CSTSALLOCATED:=1;                                   15200000
                    NSLA(SLNR):=NSLA(SLNR)+1;<<# SEGS ALLOC>>           15205000
                    SEGPTR(DBPHYCST):=TOS;                              15210000
                    SEGPTR(DBMAPFLAG):=LOADDOMAIN;                      15215000
                    SEGPTR(DBNEWFLAG):=1;                               15220000
                    IF SEGPTR(DBMAPFLAG) = 0 THEN                       15225000
                      BEGIN        <<MAPPED CST>>                       15230000
                        TOS:=0; <<NEXTBIT RESULT>>                      15235000
                        TOS:=@MCSTTAB; <<BIT ARRAY>>                    15240000
                        TOS:=NEXTBIT(*);<<GET MAP INDEX>>               15245000
                        IF S0 = 0 THEN                                  15250000
                          BEGIN    <<NONE AVAILABLE>>                   15255000
                            TOS:=ERR100;                                15260000
                            GO ABORT;                                   15265000
                          END;                                          15270000
                        SEGPTR(DBMCST):=TOS;                            15275000
                        NEEDSEGMAP:=TRUE;                               15280000
                      END;                                              15285000
                  END;                                                  15290000
                @SEGPTR:=SEGPTR(SEGNEXT); <<NEXT SEG ENTRY>>            15295000
              END; <<WHILE>>                                            15300000
          END;                                                          15305000
      END; <<WHILE>>                                                    15310000
    <<DETERMINE MAX MAPPED INDEX USED>>                                 15315000
    IF LOGICALMAPPING THEN                                              15320000
      BEGIN               <<MAPPING FIRMWARE PRESENT>>                  15325000
        MAXMCSTIDX:=256;                                                15330000
        DO BEGIN                                                        15335000
             MAXMCSTIDX:=MAXMCSTIDX-1;                                  15340000
             TOS:=0;                                                    15345000
             TOS:=@MCSTTAB;                                             15350000
           END UNTIL TESTBIT(*,MAXMCSTIDX) OR                           15355000
                     MAXMCSTIDX = 0;                                    15360000
      END                                                               15365000
     ELSE                                                               15370000
      BEGIN               <<NO MAPPING FIRMWARE>>                       15375000
        MAXMCSTIDX:=0;                                                  15380000
      END;                                                              15385000
    IF NEEDSEGMAP AND NOT(ALLOCPROC) THEN                               15390000
      BEGIN           <<SEGMAP REQUIRED>>                               15395000
        IF PROGLOAD                                                     15400000
          THEN INITSEGMAP(TRUE) <<ALLOCATE SEGMAP>>                     15405000
          ELSE INITSEGMAP(FALSE);<<SETUP SEGMAP>>                       15410000
        IF < THEN GO TO ERROR;                                          15415000
      END                                                      <<07301>>15420000
    ELSE                                                       <<07301>>15425000
      IF SEGMAPDST <> 0 THEN                                   <<07301>>15430000
        BEGIN                                                  <<07301>>15435000
          EXCHANGEDB(SEGMAPDST);                               <<07301>>15440000
          TOS:=SEGMAP(1);                                      <<07301>>15445000
          EXCHANGEDB(0);                                       <<07301>>15450000
          SEGMAPSTTPOSITION := SEGMAPLENGTH := TOS;            <<*7598>>15455000
        END;                                                   <<07301>>15460000
    CONDCODE:=CCE;               <<OK CODE>>                            15465000
    RETURN;                                                             15470000
ABORT:                                                                  15475000
    MERROR:=TOS;                                                        15480000
ERROR:                                                                  15485000
    CONDCODE:=CCL;                                                      15490000
  END; <<ADDSEGDATA'SLDB>>                                              15495000
$PAGE                                                                   15500000
PROCEDURE LOADEXTERNALS;                                                15505000
  <<LOAD THE LIBRARY SEGMENTS SPECIFIED BY SLDATABASE>>                 15510000
  <<NOTE THIS PROCEDURE USES CONDITION CODE TO INDICATE>>               15515000
  <<AN ERROR.                                          >>               15520000
  BEGIN                                                                 15525000
    INTEGER POINTER SEGPTR;                                             15530000
$PAGE                                                                   15535000
    SUBROUTINE LOADSEG;                                                 15540000
      <<CALL LOADSEGMENT FOR THE CURRENT SEG>>                          15545000
      BEGIN                                                             15550000
        GETREFTABENT(SEGPTR(DBLOGSEG)); <<READ REF TAB>>                15555000
        TOS:=SLFNUM(SLNR);              <<SL FILE ID>>                  15560000
        TOS:=SEGPTR(DBLOGSEG);          <<LOG SEG #>>                   15565000
        TOS:=SLNR;                      <<SL TYPE>>                     15570000
        TOS:=RTDP;               <<SEG LEN,SEG ADDR>>                   15575000
        TOS:=@SEGPTR;                   <<SEGPTR>>                      15580000
        TOS:=SLCAP(SLNR);               <<SL CAPABILITY>>               15585000
        TOS:=TRUE;                      <<PRIV MODE>>                   15590000
        LOADSEGMENT(*,*,*,*,*,*,*,*);                                   15595000
        IF < THEN GO TO LOADERROR;                                      15600000
      END; <<LOADSEG>>                                                  15605000
$PAGE                                                                   15610000
    <<LOAD SEGMENTS FROM EACH SL>>                                      15615000
    SLNR:=MLIBSEARCH+1;                                                 15620000
    WHILE (SLNR:=SLNR-1) >= 0 DO                                        15625000
      BEGIN                     <<EACH SL>>                             15630000
        DRTRECD:=0D;                                                    15635000
        @SEGPTR:=SLDATABASE(SLNR);                                      15640000
        WHILE @SEGPTR <> 0 DO                                           15645000
          BEGIN                 <<EACH SEG ENTRY>>                      15650000
            <<LOADSEG MUST BE CALLED FOR EACH SEG THAT IS:>>            15655000
            <<1. NEWLY ALLOCATED  OR                      >>            15660000
            <<2. LOGICAL MAPPING FIRMWARE IS PRESENT AND  >>            15665000
            <<   SEG IS LOGICALLY MAPPED AND              >>            15670000
            <<   SEG HAS NOT BEEN PREVIOUSLY LOADED FOR   >>            15675000
            <<       THIS PROCESS                         >>            15680000
            IF SEGPTR(DBNEWFLAG) = 1 OR                                 15685000
               LOGICALMAPPING        AND                                15690000
               SEGPTR(DBMAPFLAG) = 0 AND                                15695000
               SEGPTR(DBREFFLAG) = 0 THEN                               15700000
              BEGIN             <<MUST LOAD SEGMENT>>                   15705000
                LOADSEG;                                                15710000
              END;                                                      15715000
            @SEGPTR:=SEGPTR(SEGNEXT); <<NEXT ENTRY>>                    15720000
          END; <<WHILE>>                                                15725000
        SAVEREFTABBUF;                                                  15730000
      END; <<WHILE>>                                                    15735000
    << UPDATE SEGMAPDST FOR THE SL SEGS>>                               15740000
    IF SEGMAPDST <> 0 THEN                                              15745000
      BEGIN               <<SEGMAPDST EXISTS>>                          15750000
        TOS:=SEGMAPSTTPOSITION; <<LENGTH OF MAP>>                       15755000
        EXCHANGEDB(SEGMAPDST);                                          15760000
        SEGMAP(1):=TOS;                                                 15765000
        EXCHANGEDB(0);                                                  15770000
        IF PROCLOAD THEN                                                15775000
          BEGIN         <<LOAD/ALLOCATE PROCEDURE>>                     15780000
            <<ADJUST FINAL SEGMAP SIZE>>                                15785000
            ALTDSEGSIZE(SEGMAPDST,SEGMAPSTTPOSITION+2                   15790000
                                   -SEGMAPLENGTH);                      15795000
          END;                                                          15800000
      END;                                                              15805000
    CONDCODE:=CCE;                                                      15810000
    RETURN;                                                             15815000
ABORT:                                                                  15820000
    MERROR:=TOS;                                                        15825000
LOADERROR:                                                              15830000
    CONDCODE:=CCL;                                                      15835000
  END;                                                                  15840000
$PAGE                                                                   15845000
PROCEDURE LOADSEGMENT(FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD,                15850000
                SEGPTR,CAPABILITY,PRIVMODE);                            15855000
  <<LOADS THE SPECIFIED SEGMENT.  NOTE THIS PROCEDURE >>                15860000
  <<USES THE CONDITION CODE TO INDICATE AN ERROR>>                      15865000
  VALUE FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD,CAPABILITY,                   15870000
           PRIVMODE,SEGPTR;                                             15875000
  INTEGER FNUM,SEGNR,SEGTYPE,SEGLEN,SEGRECD;                            15880000
  LOGICAL CAPABILITY,PRIVMODE;                                          15885000
  INTEGER POINTER SEGPTR;                                               15890000
  OPTION UNCALLABLE;                                                    15895000
  BEGIN                                                                 15900000
    DOUBLE SEGDESCRIP = SEGLEN;                                         15905000
    INTEGER TEMP1   :=0,                                                15910000
            NUMBEXT :=0,                                                15915000
            STTNR   :=0,                                                15920000
            SAT'SLNR:=0,                                                15925000
            SAT'LOGSEGNR:=0,                                            15930000
            SAT'PLABEL:=0,                                              15935000
            STTWORK1:=0,                                                15940000
            STTWORK2:=0,                                                15945000
            TEMPSEGMAPDST:=0,                                           15950000
            TEMPSEGMAPDEL:=0,                                           15955000
            TEMPSEGMAPLEN:=0,                                           15960000
            TEMPSEGMAPVDS:=0,                                           15965000
            SEGLEN' ,                                                   15970000
            STTRECD ;                                                   15975000
    INTEGER POINTER SAT'SEGPTR,                                         15980000
                    STTPTR,                                             15985000
                    STT,                                                15990000
                    STT2,                                               15995000
                    STTSEC;                                             16000000
    INTEGER TEMPDB;                                            <<*7547>>16005000
                                                               <<*7547>>16010000
    BYTE POINTER STTMAP;                                                16015000
    <<NOTE:   STORESTTSEC & STTBUF MUST !ALWAYS! BE THE>>               16020000
    <<      LAST TWO LOCAL VARIABLES DEFINED!          >>               16025000
    LOGICAL STORESTTSEC;                                                16030000
    INTEGER ARRAY STTBUF(*) =STORESTTSEC+1;                             16035000
    DEFINE PROGSEG = SEGTYPE=14#,                                       16040000
           SLSEG = SEGTYPE <> 14#;                                      16045000
$PAGE                                                                   16050000
SUBROUTINE CHKSEGMAPSIZE;                                               16055000
  <<INSURE SEGMAP IS LARGE ENOUGH>>                                     16060000
  BEGIN                                                                 16065000
    TOS:=SEGMAPSTTPOSITION+NUMBEXT+1;                                   16070000
    IF S0 <= 0 THEN                                                     16075000
      BEGIN        <<TOO BIG>>                                          16080000
        TOS:=ERR101;                                                    16085000
        GO ABORT;                                                       16090000
      END;                                                              16095000
    IF TOS > SEGMAPLENGTH THEN                                          16100000
      BEGIN        <<MUST EXPAND SEGMAP>>                               16105000
        TEMPSEGMAPDEL:=32760-SEGMAPLENGTH; <<MAX DELTA>>                16110000
        IF TEMPSEGMAPDEL > 1024 THEN                                    16115000
          BEGIN  <<USE DELTA=1024>>                                     16120000
            TEMPSEGMAPDEL:=1024;                                        16125000
          END;                                                          16130000
        IF TEMPSEGMAPDEL < NUMBEXT+1 THEN                               16135000
          BEGIN  <<SEGMAP TOO BIG>>                                     16140000
            TOS:=ERR101;                                                16145000
            GO ABORT;                                                   16150000
          END;                                                          16155000
        TEMPSEGMAPLEN:=ALTDSEGSIZE(SEGMAPDST,TEMPSEGMAPDEL);            16160000
        IF < THEN                                                       16165000
          BEGIN   <<ERROR--SEGMAP LOCKED OR FROZEN>>                    16170000
            TOS:=ERR102;                                                16175000
            GO ABORT;                                                   16180000
          END;                                                          16185000
        IF > THEN                                                       16190000
          BEGIN     <<ERROR--EXCEEDED VDS>>                             16195000
            <<GET NEW DATA SEG WITH MORE VDS>>                          16200000
            TEMPSEGMAPLEN:=SEGMAPLENGTH+TEMPSEGMAPDEL;                  16205000
            TEMPSEGMAPVDS:=((SEGMAPLENGTH+4095)&LSR(12))                16210000
                              &LSL(12);                                 16215000
            TEMPSEGMAPDST:=GETDATASEG(TEMPSEGMAPLEN,                    16220000
                                       TEMPSEGMAPVDS);                  16225000
            IF <> THEN                                                  16230000
              BEGIN    <<UNABLE TO GET NEW SEGMAP>>                     16235000
                TOS:=ERR99;                                             16240000
                GO ABORT;                                               16245000
              END;                                                      16250000
            <<MOVE SEGMAP DATA TO NEW DST>>                             16255000
            TOS:=TEMPSEGMAPDST; <<TARGET DST>>                          16260000
            TOS:=0;             <<TARGET OFFSET>>                       16265000
            TOS:=SEGMAPDST;     <<SOURCE DST>>                          16270000
            TOS:=0;             <<SOURCE OFFSET>>                       16275000
            TOS:=SEGMAPSTTPOSITION; <<COUNT>>                           16280000
            ASSEMBLE(MDS 5);                                            16285000
            <<RELEASE OLD SEGMAP DST>>                                  16290000
            IF PROGLOAD THEN                                            16295000
              BEGIN         <<LOAD/ALLOCATE PROGRAM>>                   16300000
                RELDATASEG(SEGMAPDST); <<RELEASE CURRENT DST>>          16305000
              END                                                       16310000
             ELSE                                                       16315000
              BEGIN         <<LOAD/ALLOCATE PROCEDURE>>                 16320000
                <<SAVE CURRENT DST IF THIS IS 1ST DST SWITCH>>          16325000
                IF OLDSEGMAPDST = 0                                     16330000
                  THEN OLDSEGMAPDST:=SEGMAPDST                          16335000
                  ELSE RELDATASEG(SEGMAPDST);                           16340000
                NEWSEGMAPFLAG:=1; <<SET FLAG FOR DST SWITCH>>           16345000
              END;                                                      16350000
            SEGMAPDST:=TEMPSEGMAPDST;  <<NEW DST>>                      16355000
          END;                                                          16360000
        SEGMAPLENGTH:=TEMPSEGMAPLEN;  <<NEW LENGTH>>                    16365000
      END;                                                              16370000
    END; <<CHKSEGMAPSIZE>>                                              16375000
$PAGE                                                                   16380000
SUBROUTINE STORESTT;                                                    16385000
<<WRITE STT BACK TO DISC>>                                              16390000
  BEGIN                                                                 16395000
    TOS:=FNUM;                                                          16400000
    TOS:=@STTBUF;                                                       16405000
    TOS:=P384;                                                          16410000
IF SLSEG THEN TOS:=TOS+128; <<SL SEG>>                                  16415000
    TOS:=0;                                                             16420000
    TOS:=STTRECD;                                                       16425000
    IF < THEN                                                           16430000
      BEGIN      <<SPECIAL CASE>>                                       16435000
        S3:=S3+128; <<ADJ BUF ADDR>>                                    16440000
        S2:=S2-128; <<ADJ COUNT>>                                       16445000
        TOS:=TOS+1; <<ADJ REC #>>                                       16450000
      END;                                                              16455000
    IF PROGSEG THEN                                                     16460000
      BEGIN                                                             16465000
        <<INSURE WRITE OF STT DOES NOT INCLUDE >>                       16470000
        <<PROG FILE HEADER RECORDS             >>                       16475000
        WHILE S0 <= ((28+NPA+(NPA+1)&LSR(1))/128) DO                    16480000
          BEGIN                                                         16485000
            <<ADJUST WRITE PARAMETERS>>                                 16490000
            S3:=S3+128;    <<BUFFER ADDRESS>>                           16495000
            S2:=S2-128;    <<WORD COUNT    >>                           16500000
            TOS:=TOS+1;    <<RECORD #      >>                           16505000
          END; <<WHILE>>                                                16510000
      END;                                                              16515000
    FWRITEDIR(*,*,*,*); <<WRITE STT>>                                   16520000
    IF <> THEN GO IOERROR; <<ERROR>>                                    16525000
  END; <<STORESTT>>                                                     16530000
$PAGE                                                                   16535000
SUBROUTINE COUNTEXT;                                                    16540000
<<COUNT # OF EXTERNAL STT ENTRIES IN CURRENT STT>>                      16545000
  BEGIN                                                                 16550000
    NUMBEXT:=0; <<COUNT OF EXT STT>>                                    16555000
    TEMP1:=STT.(8:8); <<# STT>>                                         16560000
    TOS:=@STT; <<PTR TO STT>>                                           16565000
    WHILE (TEMP1:=TEMP1-1) >=0 DO                                       16570000
      BEGIN <<CYCLE THRU STT ENTRIES>>                                  16575000
        TOS:=TOS-1; <<PTR TO STT ENTRY>>                                16580000
        IF PS0 < 0                                                      16585000
          THEN NUMBEXT:=NUMBEXT+1;                                      16590000
      END;                                                              16595000
    ASSEMBLE(DEL); <<PTR TO STT>>                                       16600000
  END; <<COUNTEXT>>                                                     16605000
$PAGE                                                                   16610000
SUBROUTINE GETNUMBSTT;                                                  16615000
<<CONVERT TO NEW FORMAT IF NECESSARY>>                                  16620000
<<DETERMINE NUMBER OF INTERNAL AND  >>                                  16625000
<<EXTERNAL STT ENTRIES              >>                                  16630000
  BEGIN                                                                 16635000
    IF PROGSEG THEN                                                     16640000
      BEGIN         <<LOADING PROG SEG>>                                16645000
        TOS:=@PROGREC0+(NPA+57)&LSR(1);<<PTR TO SEG DESC>>              16650000
        IF PS0(SEGNR).PROGEXTSTT=1 THEN                                 16655000
          BEGIN  <<STT IN MAPPING FORMAT>>                              16660000
            <<# EXTERNAL STT=#STT-# INTERNAL STT>>                      16665000
            NUMBEXT:=STT.(8:8)-STT.(0:8);                               16670000
            STTNR:=STT.(0:8); << # INTERNAL STT'S>>                     16675000
            IF LOGICALMAPPING THEN                                      16680000
              BEGIN  <<MAPPING FIRMWARE PRESENT>>                       16685000
                <<LEAVE STT IN PRESENT FORM>>                           16690000
                ASSEMBLE(DEL); <<PTR TO DESCRIPTOR>>                    16695000
              END                                                       16700000
             ELSE                                                       16705000
              BEGIN  <<NO MAPPING FIRMWARE>>                            16710000
                <<CONVERT STT AND SEG DESCRIPTOR BACK>>                 16715000
                STT.(0:8):=%100; <<SET UNCALLABLE BIT>>                 16720000
                PS0(SEGNR).PROGEXTSTT:=0; <<CLEAR FLAG>>                16725000
                ASSEMBLE(DEL); <<PTR TO DESCRIPTOR>>                    16730000
                STORESTT;      <<WRITE UPDATED STT>>                    16735000
                TOS:=PROGFNUM; <<WRITE UPDATED SEG>>                    16740000
                TOS:=@PROGREC0;<< DESCRIPTOR      >>                    16745000
                TOS:=((28+NPA+(NPA+1)&LSR(1)+127)/128)*128;             16750000
                TOS:=0D;                                                16755000
                FWRITEDIR(*,*,*,*);                                     16760000
              END;                                                      16765000
          END                                                           16770000
         ELSE                                                           16775000
          BEGIN  <<STT NOT IN MAPPING FORMAT>>                          16780000
            COUNTEXT; <<COUNT # EXTERNAL STT'S>>                        16785000
            STTNR:=STT.(8:8)-NUMBEXT; <<# INTERNAL STT'S>>              16790000
            IF LOGICALMAPPING THEN                                      16795000
              BEGIN  <<MAPPING FIRMWARE PRESENT>>                       16800000
                <<CONVERT STT TO MAPPING FORMAT>>                       16805000
                STT.(0:8):=STTNR;                                       16810000
                <<INIT STT HEAD = #INT STT,#STT>>                       16815000
                <<WRITE UPDATED STT BACK TO DISC>>                      16820000
                STORESTT;                                               16825000
                PS0(SEGNR).PROGEXTSTT:=1; <<SET INIT FLAG>>             16830000
                ASSEMBLE(DEL); <<PTR TO DESCRIPTOR>>                    16835000
                <<WRITE UPDATED PROGREC0 BACK TO DISC>>                 16840000
                TOS:=PROGFNUM;                                          16845000
                TOS:=@PROGREC0;                                         16850000
                TOS:=((28+NPA+(NPA+1)&LSR(1)+127)/128)*128;             16855000
                TOS:=0D;                                                16860000
                FWRITEDIR(*,*,*,*);                                     16865000
              END                                                       16870000
             ELSE                                                       16875000
              BEGIN  <<NO MAPPING FIRMWARE>>                            16880000
                <<LEAVE STT IN PRESENT FORM>>                           16885000
                ASSEMBLE(DEL);  <<PTR TO DESCRIPTOR>>                   16890000
              END;                                                      16895000
          END;                                                          16900000
      END                                                               16905000
     ELSE                                                               16910000
      BEGIN         <<LOADING SL SEG>>                                  16915000
        IF REFTAB'EXTSTT = 1 THEN                                       16920000
          BEGIN  <<STT IN MAPPING FORMAT>>                              16925000
            <<# EXTERNAL STT = # STT - # INTERNAL STT>>                 16930000
            NUMBEXT:=STT.(8:8)-STT.(0:8);                               16935000
            STTNR:=STT.(0:8); <<# INTERNAL STT'S>>                      16940000
            <<IF MAPPING FIRMWARE PRESENT LEAVE STT ALONE>>             16945000
            <<IF NO MAPPING FIRMWARE CONVERT STT BACK    >>             16950000
            IF NOT LOGICALMAPPING THEN                                  16955000
              BEGIN  <<NO MAPPING FIRMWARE>>                            16960000
                REFTAB'EXTSTT:=0;  <<CLEAR FLAG>>                       16965000
                RTMODIFIED:=1;           <<REFTAB MODIFIED>>            16970000
                STT.(0:8):=%100;         <<SET UNCALLABLE BIT>>         16975000
                STORESTT;                <<WRITE UPDATED STT>>          16980000
              END;                                                      16985000
          END                                                           16990000
         ELSE                                                           16995000
          BEGIN  <<STT IN NON-MAPPING FORMAT>>                          17000000
            COUNTEXT;  <<COUNT # EXTERNAL STT'S>>                       17005000
            STTNR:=STT.(8:8)-NUMBEXT; <<# INTERNAL STT'S>>              17010000
            <<IF NO MAPPING FIRMWARE LEAVE STT ALONE>>                  17015000
            <<IF MAPPING FIRMWARE PRESENT CONVERT STT>>                 17020000
            IF LOGICALMAPPING THEN                                      17025000
              BEGIN  <<MAPPING FIRMWARE PRESENT>>                       17030000
                REFTAB'EXTSTT:=1; <<SET FLAG>>                          17035000
                RTMODIFIED:=1;          <<REFTAB MODIFIED>>             17040000
                STT.(0:8):=STTNR;                                       17045000
                STORESTT;               <<WRITE UPDATED STT>>           17050000
              END;                                                      17055000
          END;                                                          17060000
      END;                                                              17065000
  END; <<GETNUMBSTT>>                                                   17070000
$PAGE                                                                   17075000
SUBROUTINE FINDSATISFIER;                                               17080000
<<LOCATE THE SATISFIER FOR THE CURRENT EXTERNAL STT>>                   17085000
<<SAT'SEGPTR WILL BE POINTING TO THE DATA BASE SEG >>                   17090000
<<ENTRY.  SAT'SLNR WILL BE SL OF SATISFIER.        >>                   17095000
<<SAT'PLABEL WILL BE THE PLABEL OF THE SATISFIER.  >>                   17100000
  BEGIN                                                                 17105000
    IF SLSEG THEN                                                       17110000
      BEGIN         <<LOADING SL SEGMENT>>                              17115000
        SAT'LOGSEGNR:=STTMAP(STTNR);                                    17120000
      END                                                               17125000
     ELSE                                                               17130000
      BEGIN         <<LOADING PROGRAM SEGMENT>>                         17135000
        IF LASTPROGLOADLOGICAL THEN                                     17140000
          BEGIN     <<PROG LAST LOADED LOGICALLY>>                      17145000
            IF STT2 > 0 AND                                             17150000
               STT2.(8:8) <= NPA THEN                                   17155000
              BEGIN <<SATISFIER IS IN PROG FILE>>                       17160000
                SAT'LOGSEGNR:=STT2.(8:8)-1;                             17165000
              END                                                       17170000
             ELSE                                                       17175000
              BEGIN <<SATISFIER IS NOT IN PROG FILE>>                   17180000
                SAT'LOGSEGNR:=255;                                      17185000
              END;                                                      17190000
          END                                                           17195000
         ELSE                                                           17200000
          BEGIN     <<PROG LAST LOADED PHYSICALLY>>                     17205000
            SAT'LOGSEGNR:=STTMAP(STT2.(8:8));                           17210000
          END;                                                          17215000
      END;                                                              17220000
    IF SAT'LOGSEGNR <> 255 THEN                                         17225000
      BEGIN     <<SATISFIER IS INTERNAL TO PROG/SL>>                    17230000
        SAT'SLNR:=SEGTYPE; <<SATISFIER SOURCE>>                         17235000
        SAT'PLABEL:=SAT'LOGSEGNR; <<SAT SEG #>>                         17240000
        SAT'PLABEL.(1:7):=STT2.(1:7); <<SAT STT #>>                     17245000
      END                                                               17250000
     ELSE                                                               17255000
      BEGIN     <<SATISFIER IS EXTERNAL TO PROG/SL>>                    17260000
        <<AN STT ENTRY SHOULD EXIST GIVING THE >>                       17265000
        <<SATISFIER OF THIS EXTERNAL           >>                       17270000
        @STTPTR:=FINDSTTENTRY(SEGPTR,STTNR,STTPTR);                     17275000
        IF < THEN                                                       17280000
          BEGIN          <<SATISFIER NOT FOUND>>                        17285000
            TOS:=ERR28+(IF SEGTYPE=14 THEN 3 ELSE SEGTYPE);             17290000
            GO ABORT;                                                   17295000
          END;                                                          17300000
        SAT'SLNR:=STTPTR(DBSAT); <<SATISFIER SOURCE>>                   17305000
        SAT'PLABEL:=STTPTR(DBPLABEL); <<SATISFIER PLABEL>>              17310000
      END;                                                              17315000
  END;  <<FINDSATISFIER>>                                               17320000
$PAGE                                                                   17325000
    <<INITIALIZE LOCAL VARIABLES>>                                      17330000
                                                                        17335000
    SEGLEN':=SEGLEN-1;                                                  17340000
    STTRECD:=SEGLEN'.(2:7)+SEGRECD-2;                                   17345000
    @SAT'SEGPTR:=0;                                                     17350000
    @STTPTR:=0;                                                         17355000
    @STT:=SEGLEN'.(9:7)+@STTBUF+P256;                                   17360000
    @STT2:=@STT;                                                        17365000
    @STTSEC:=@STTBUF+512;                                               17370000
    @STTMAP:=(@STT+1)&LSL(1);                                           17375000
    STORESTTSEC:=FALSE;                                                 17380000
    TOS:=768;             <<SPACE FOR STT,STTMAP,STTSEC>>               17385000
    ASSEMBLE(ADDS 0);     <<STTBUF>>                                    17390000
                                                                        17395000
    IF PROGSEG THEN @STTMAP:=@PROGMAP;                                  17400000
                                                                        17405000
                                                                        17410000
    <<* * * LOAD STT * * *>>                                            17415000
                                                                        17420000
    TOS := FNUM;                                                        17425000
    TOS := @STTBUF;                                                     17430000
    TOS := P384;                                                        17435000
    IF SLSEG THEN TOS:=TOS+128; <<SL SEG>>                              17440000
    TOS := 0; TOS := STTRECD;                                           17445000
    IF < THEN  <<SPECIAL CASE?>>                                        17450000
       BEGIN                                                            17455000
       S3 := S3+128;  <<ADJ. BUFFER ADR.>>                              17460000
       S2 := S2-128;  <<ADJ. COUNT>>                                    17465000
       TOS := TOS+1  <<ADJ. REC. NR.>>                                  17470000
       END;                                                             17475000
    FREADDIR(*,*,*,*);  <<LOAD STT>>                                    17480000
    IF <> THEN GO IOERROR;  <<ERROR?>>                                  17485000
                                                                        17490000
    <<* * * REPAIR STT * * *>>                                          17495000
                                                                        17500000
    GETNUMBSTT;  <<GET # OF EXTERNAL AND INTERNAL STT'S>>               17505000
                                                                        17510000
    <<CYCLE THRU EACH EXTERNAL STT>>                                    17515000
    << .FIND SATISFIER FOR EXTERNAL>>                                   17520000
    << .BUILD SATISFIED STT        >>                                   17525000
    << .IF LOGICAL MAPPING THEN    >>                                   17530000
    <<     BUILD SECONDARY MAP STT >>                                   17535000
    << .WRITE REPAIRED STT TO DISC >>                                   17540000
    << .IF LOGICAL MAPPING WRITE   >>                                   17545000
    <<     SECONDARY STT TO MAP    >>                                   17550000
    << .INITIALIZE CST ENTRY       >>                                   17555000
                                                                        17560000
    STORESTTSEC:=FALSE;                                                 17565000
    @STTPTR:=0;                                                         17570000
    TEMP1:=NUMBEXT;                                                     17575000
    @STT2:=@STT-STTNR; <<PTR TO EXTERNAL STT>>                          17580000
    WHILE (TEMP1:=TEMP1-1) >= 0 DO                                      17585000
      BEGIN            <<EACH EXTERNAL STT>>                            17590000
        STTNR:=STTNR+1;<<STT #>>                                        17595000
        @STT2:=@STT2-1;<<PTR TO STT>>                                   17600000
        FINDSATISFIER; <<SATISFY EXTERNAL STT>>                         17605000
        <<FIND SEG ENTRY IN DATA BASE FOR SATISFIER>>                   17610000
        @SAT'SEGPTR:=FINDSEGENTRY(SAT'SLNR,                             17615000
                           SAT'PLABEL.(8:8));                           17620000
        IF < THEN                                                       17625000
          BEGIN      <<SATISFIER NOT FOUND>>                            17630000
            TOS:=ERR28+(IF SEGTYPE=14 THEN 3 ELSE SEGTYPE);             17635000
            GO ABORT;                                                   17640000
          END;                                                          17645000
        IF LOGICALMAPPING THEN                                          17650000
          BEGIN      <<MAPPING FIRMWARE PRESENT>>                       17655000
            <<BUILD STT ENTRY FOR CODE SEGMENT AND>>                    17660000
            <<FOR STT LIST IN SEGMENT MAP         >>                    17665000
            IF PROGSEG THEN                                             17670000
              BEGIN         <<LOADING PROGRAM SEGMENT>>                 17675000
                STTWORK1:=SAT'PLABEL;                                   17680000
                STTWORK1.(0:1):=SAT'SEGPTR(DBMAPFLAG);                  17685000
                IF SAT'SEGPTR(DBMAPFLAG) = 0                            17690000
                  THEN STTWORK1.(8:8):=SAT'SEGPTR(DBMCST)               17695000
                  ELSE STTWORK1.(8:8):=SAT'SEGPTR(DBPHYCST);            17700000
              END                                                       17705000
             ELSE                                                       17710000
              BEGIN         <<LOADING SL SEGMENT>>                      17715000
                IF SEGPTR(DBMAPFLAG) = 1 THEN                           17720000
                  BEGIN     <<LOADING SEG IN PHY DOMAIN>>               17725000
                    STTWORK1:=SAT'PLABEL;                               17730000
                    STTWORK1.(0:1):=SAT'SEGPTR(DBMAPFLAG);              17735000
                    STTWORK1.(8:8):=SAT'SEGPTR(DBPHYCST);               17740000
                  END                                                   17745000
                 ELSE                                                   17750000
                  BEGIN     <<LOADING SEG IN MAPPED DOMAIN>>            17755000
                    STTWORK1:=SAT'PLABEL;                               17760000
                    STTWORK1.(0:1):=0;                                  17765000
                    STTWORK1.(8:8):=0;                                  17770000
                    STTWORK2:=STTWORK1;                                 17775000
                    IF SAT'SEGPTR(DBMAPFLAG)=0 THEN                     17780000
                      BEGIN <<SAT IS LOGICALLY MAPPED>>                 17785000
                        STTWORK2.(8:8):=SAT'SEGPTR(DBMCST);             17790000
                      END                                               17795000
                     ELSE                                               17800000
                      BEGIN <<SAT IS PHYSICALLY MAPPED>>                17805000
                        STTWORK2.(0:1):=1;                              17810000
                        STTWORK2.(8:8):=SAT'SEGPTR(DBPHYCST);           17815000
                      END;                                              17820000
                    STORESTTSEC:=TRUE;                                  17825000
                  END;                                                  17830000
              END;                                                      17835000
          END                                                           17840000
         ELSE                                                           17845000
          BEGIN      <<MAPPING FIRMWARE NOT PRESENT>>                   17850000
            STTWORK1:=SAT'PLABEL;                                       17855000
            STTWORK1.(0:1):=1;                                          17860000
            STTWORK1.(8:8):=SAT'SEGPTR(DBPHYCST);                       17865000
          END;                                                          17870000
        STT2:=STTWORK1;  <<SATISFIED EXTERNAL STT>>                     17875000
        IF STORESTTSEC THEN STTSEC(TEMP1):=STTWORK2;                    17880000
      END; <<WHILE>>                                                    17885000
    <<WRITE REPAIRED STT TO DISC IF SEG IS NEWLY ALLOCATED>>            17890000
    IF SEGPTR(DBNEWFLAG) = 1 THEN STORESTT;                             17895000
    <<CONSTRUCT SEGMENT MAP>>                                           17900000
    IF SEGMAPDST <> 0 AND                                               17905000
       SEGPTR(DBMAPFLAG) = 0 THEN                                       17910000
      BEGIN                 <<SEGMENT MAP REQUIRED>>                    17915000
        <<BUILD PART 2 OF MAP>>                                         17920000
        IF STORESTTSEC THEN                                             17925000
          BEGIN            <<SECONDARY STT INFO REQUIRED>>              17930000
            STTSEC(NUMBEXT):=NUMBEXT;                                   17935000
            CHKSEGMAPSIZE; <<CHECK SIZE OF SEGMAP>>                     17940000
            TOS:=SEGMAPDST;                                             17945000
            TOS:=SEGMAPSTTPOSITION;                                     17950000
            TOS:=@STTSEC;                                               17955000
            TOS:=NUMBEXT+1;                                             17960000
            ASSEMBLE(MTDS 4);                                           17965000
            SEGMAPSTTPOSITION:=SEGMAPSTTPOSITION+NUMBEXT+1;             17970000
          END;                                                          17975000
        <<CONSTRUCT PART 1 OF SEGMENT MAP>>                             17980000
        STTSEC(0):=SEGPTR(DBPHYCST);                                    17985000
        STTSEC(1):=IF STORESTTSEC                                       17990000
                     THEN SEGMAPSTTPOSITION-1                           17995000
                     ELSE 0;                                            18000000
        TOS:=SEGMAPDST;                                                 18005000
        TOS:=SEGPTR(DBMCST)&LSL(1);                                     18010000
        TOS:=@STTSEC;                                                   18015000
        TOS:=2;                                                         18020000
        ASSEMBLE(MTDS 2);                                               18025000
      END;                                                              18030000
    <<INITIALIZE CST ENTRY>>                                            18035000
    IF SEGPTR(DBNEWFLAG) = 1 THEN                                       18040000
      BEGIN                      <<SEGMENT NEWLY ALLOCATED>>            18045000
        IF PROGSEG THEN                                                 18050000
          BEGIN         <<PROG SEG TO BE ALLOCATED>>                    18055000
            TOS:=CSTBX; <<CST BLK>>                                     18060000
            TOS:=SEGNR; <<LOG SEG NR>>                                  18065000
          END                                                           18070000
         ELSE                                                           18075000
          BEGIN         <<SL SEG TO BE ALLOCATED>>                      18080000
            TOS:=SEGPTR(DBPHYCST); <<CST #>>                            18085000
          END;                                                          18090000
        TOS := SEGLEN.(2:12);   << LENGTH/4 >>                          18095000
        TOS := PRIVMODE LAND LOGICAL(SEGLEN.(0:1));                     18100000
        IF LS0 AND NOT CAPABILITY THEN                                  18105000
          BEGIN << PRIV. MODE VIOLATION >>                              18110000
             TOS := ERR44;                                              18115000
             GO ABORT;                                                  18120000
          END;                                                          18125000
        TOS.(1:1) := TOS; << INSERT MODE BIT >>                         18130000
        TOS := 0;                                                       18135000
        TOS := FGETDISKADR(FNUM,DOUBLE(LOGICAL(SEGRECD)));              18140000
        TOS := TOS&TASL(8)&DLSR(8); << DISC ADDR TO S-2>>               18145000
        <<INSERT SYSTEM BIT (X) FROM FLAGS>>                            18150000
        TOS := SEGPTR(DBXBIT);                                          18155000
        IF PROGSEG                                                      18160000
          THEN PUTCSTBLOCK(*,*,*,*,*,*)                                 18165000
          ELSE PUTCST(*,*,*,*,*);                                       18170000
      END;                                                              18175000
    CONDCODE:=CCE;       <<OK CODE>>                                    18180000
    RETURN;                                                             18185000
ABORT:                                                                  18190000
    MERROR:=TOS;                                                        18195000
NFG:                                                                    18200000
    CONDCODE:=CCL;       <<ERROR CODE>>                                 18205000
    RETURN;                                                             18210000
IOERROR:                                                                18215000
    FERROR(FNUM);                                                       18220000
    CONDCODE:=CCL;       <<ERROR CODE>>                                 18225000
  END;                                                                  18230000
$PAGE                                                                   18235000
PROCEDURE ADDPROGDATA'SLDB;                                             18240000
  <<THIS PROCEDURE COMPLETES SLDATABASE SEG ENTRIES>>                   18245000
  <<FOR EACH PROGRAM SEGMENT.  NOTE THIS PROCEDURE >>                   18250000
  <<USES CONDITION CODE TO INDICATE AN ERROR       >>                   18255000
  BEGIN                                                                 18260000
    INTEGER INDEX;                                                      18265000
    INTEGER POINTER SEGPTR;                                             18270000
    INDEX:=NPA;                                                         18275000
    SLNR:=14;                                                           18280000
    WHILE (INDEX:=INDEX-1) >= 0 DO                                      18285000
      BEGIN               <<EACH PROGRAM SEG>>                          18290000
        @SEGPTR:=BLDSEGENTRY(SLNR,INDEX);                               18295000
        IF < THEN GO ERROR;                                             18300000
        SEGPTR(DBMCST):=INDEX+1;                                        18305000
        SEGPTR(DBNEWFLAG):=1; <<NEWLY ALLOCATED>>                       18310000
        IF LOGICALMAPPING THEN                                          18315000
          BEGIN          <<MAPPING FIRMWARE PRESENT>>                   18320000
            SEGPTR(DBPHYCST):=INDEX+1;                                  18325000
            SEGPTR(DBMAPFLAG):=0;                                       18330000
          END                                                           18335000
         ELSE                                                           18340000
          BEGIN          <<MAPPING FIRMWARE NOT PRESENT>>               18345000
            SEGPTR(DBPHYCST):=INDEX+%301;                               18350000
            SEGPTR(DBMAPFLAG):=1;                                       18355000
          END;                                                          18360000
      END; <<WHILE>>                                                    18365000
    <<ALLOCATE BLOCK OF CST'S IN CSTX AREA>>                            18370000
    CSTBX:=ALCSTBLOCK(NPA);                                             18375000
    IF < THEN                                                           18380000
      BEGIN     <<ERROR>>                                               18385000
        MERROR:=ERR65;                                                  18390000
        CONDCODE:=CCL;  <<ERROR CODE>>                                  18395000
        RETURN;                                                         18400000
      END;                                                              18405000
    CSTBLOCKALLOCATED:=1;                                               18410000
    CONDCODE:=CCE;      <<OK CODE>>                                     18415000
    RETURN;                                                             18420000
ERROR:                                                                  18425000
    CONDCODE:=CCL;      <<ERROR CODE>>                                  18430000
  END;                                                                  18435000
$PAGE                                                                   18440000
PROCEDURE LOADPROGRAM;                                                  18445000
   <<REPAIRS THE STT'S OF THE PROGRAM FILE AND LOADS THE >>             18450000
   <<SEGMENTS. ALSO UPDATES THE CST RE-MAPPING ARRAY IN  >>             18455000
   <<RECORD 0. NOTE THAT THIS PROCEDURE USES CONDITION>>                18460000
   <<CODE TO INDICATE AN ERROR>>                                        18465000
   OPTION UNCALLABLE;                                                   18470000
   BEGIN                                                                18475000
     BYTE POINTER BPLINE,                                               18480000
                  PROGREMAP;                                            18485000
     INTEGER POINTER SEGDESCRIP,                                        18490000
                     SEGPTR;                                            18495000
     INTEGER TEMP,                                                      18500000
             TEMP1;                                                     18505000
     DEFINE MAXSEGMENT = ABS(MAXCODE)#;                                 18510000
                                                                        18515000
     <<INITIALIZE LOCAL VARIABLES>>                                     18520000
                                                                        18525000
     @PROGREMAP:=@PROGREC0(28)&LSL(1);     <<REMAP ARRAY>>              18530000
     @SEGDESCRIP:=@PROGREC0+(NPA+57)&LSR(1);<<SEG DESC ARRAY>>          18535000
     IF PROGREMAP(0) = 1                                                18540000
       THEN LASTPROGLOADLOGICAL:=TRUE                                   18545000
       ELSE LASTPROGLOADLOGICAL:=FALSE;                                 18550000
     <<LASTPROGLOADLOGICAL CAN BE TRUE ONLY IF THE PROGRAM>>            18555000
     <<WERE LAST LOADED USING LOGICAL MAPPING FIRMWARE    >>            18560000
     <<                                                   >>            18565000
     TEMP1:=NPA;                                                        18570000
     WHILE (TEMP1:=TEMP1-1) >=0 DO                                      18575000
       BEGIN                                                            18580000
         <<VERIFY ALL PROGRAM SEGS ARE SMALLER>>                        18585000
         <<THAN MAX SEG SIZE                  >>                        18590000
         IF SEGDESCRIP(TEMP1).(2:14) > MAXSEGMENT THEN                  18595000
           BEGIN    <<TOO BIG>>                                         18600000
             TOS:=ERR33;                                                18605000
             GO ABORT;                                                  18610000
           END;                                                         18615000
         <<VERIFY THERE ARE NO PRIV MODE VIOLATIONS>>                   18620000
         IF SEGDESCRIP(TEMP1).(0:1) = 1 AND                             18625000
            NOT MPMODE                  AND                             18630000
            NOT LOGICAL(PPRIVMODE) THEN                                 18635000
           BEGIN                <<VIOLATION>>                           18640000
             TOS:=ERR39;                                                18645000
             GO ABORT;                                                  18650000
           END;                                                         18655000
       END; <<WHILE>>                                                   18660000
     <<BUILD PROGMAP FOR USE BY PROCEDURE LOADSEGMENT IF>>              18665000
     <<LASTPROGLOADLOGICAL = FALSE.                     >>              18670000
     IF NOT LASTPROGLOADLOGICAL THEN                                    18675000
       BEGIN                                                            18680000
         TOS:=128;                                                      18685000
         MAKEROOMINDL(*);                                               18690000
         IF < THEN GO TO ERROR;                                         18695000
         TOS:=@DLAREA1-128;                                             18700000
         @PROGMAP:=S0&LSL(1);    <<BYTE ADDR>>                          18705000
         @DLAREA1:=S0;                                                  18710000
         <<INITIALIZE EACH BYTE TO 255>>                                18715000
         PS0:=-1;     <<255 IN EACH BYTE>>                              18720000
         ASSEMBLE(DUP,INCB);                                            18725000
         TOS:=127;                                                      18730000
         ASSEMBLE(MOVE 3);                                              18735000
       END;                                                             18740000
     <<REBUILD PROGREMAP ARRAY AND IF NECESSARY>>                       18745000
     <<FILL IN PROGMAP ARRAY                   >>                       18750000
     SLNR:=14;                                                          18755000
     TEMP:=-1;                                                          18760000
     WHILE (TEMP:=TEMP+1) < NPA DO                                      18765000
       BEGIN                                                            18770000
         @SEGPTR:=FINDSEGENTRY(SLNR,TEMP);                              18775000
         IF < THEN SUDDENDEATH(341);                                    18780000
         IF NOT LASTPROGLOADLOGICAL                                     18785000
           THEN PROGMAP(PROGREMAP(TEMP)):=TEMP;                         18790000
         PROGREMAP(TEMP):=SEGPTR(DBPHYCST);                             18795000
         IF MLMAP THEN                                                  18800000
           BEGIN      <<LOAD MAP DESIRED>>                              18805000
             BLANKLINE;                                                 18810000
             IF < THEN GO TO ERROR;                                     18815000
             @BPLINE:=@BLINE;                                           18820000
             NTOA(SEGPTR(DBPHYCST),8,BPLINE(2));                        18825000
             @BPLINE:=@BPLINE+4;                                        18830000
             IF @BPLINE-@BLINE = 64 THEN                                18835000
               BEGIN            <<LINE FULL>>                           18840000
                 PRINTLINE;                                             18845000
                 IF < THEN GO ERROR; <<ERROR>>                          18850000
                 @BPLINE:=@BLINE;                                       18855000
               END;                                                     18860000
           END;                                                         18865000
       END; <<WHILE>>                                                   18870000
     IF MLMAP THEN                                                      18875000
       BEGIN      <<LOAD MAP DESIRED>>                                  18880000
         IF @BPLINE <> @BLINE THEN                                      18885000
            BEGIN                                                       18890000
            PRINTLINE;                                                  18895000
            IF < THEN GO ERROR; <<ERROR?>>                              18900000
            END;                                                        18905000
       END;                                                             18910000
                                                                        18915000
     <<***SAVE RECORD 0 AND GET STARTING CST NUMBER***>>                18920000
                                                                        18925000
     TOS:=PROGFNUM;                                                     18930000
     TOS:=@PROGREC0;                                                    18935000
     TOS:=((28+NPA+(NPA+1)&LSR(1)+127)&LSR(7))&LSL(7);                  18940000
     TOS:=0D;                                                           18945000
     FWRITEDIR(*,*,*,*);    <<WRITE REC 0,1>>                           18950000
     IF <> THEN GO IOERROR;  <<ERROR?>>                                 18955000
     MSTARTINGCST:=PROGREMAP(PSTARTINGSEG) CAT                          18960000
                          SEGDESCRIP(PSTARTINGSEG)(0:0:1);              18965000
                                                                        18970000
     <<* * * LOAD SEGMENTS * * *>>                                      18975000
                                                                        18980000
     SLNR:=14;                                                          18985000
     TEMP1:=PSEGMENTRECD;  <<FIRST SEG REC #>>                          18990000
     @SEGPTR:=SLDATABASE(SLNR);                                         18995000
     WHILE @SEGPTR <> 0 DO                                              19000000
       BEGIN                                                            19005000
         TEMP:=SEGPTR(DBLOGSEG);                                        19010000
         TOS:=PROGFNUM;    <<PROG FILE #>>                              19015000
         TOS:=TEMP;        <<SEG #>>                                    19020000
         TOS:=SLNR;        <<SEG TYPE>>                                 19025000
         TOS:=SEGDESCRIP(TEMP); <<SEG MODE AND SEG LEN>>                19030000
         TOS:=TEMP1;       <<SEG REC #>>                                19035000
         TOS:=@SEGPTR;     <<SEGPTR>>                                   19040000
         TOS:=USERCAP;     <<CAPABILITY>>                               19045000
         TOS:=NOT MPMODE;  <<PRIVMODE>>                                 19050000
         LOADSEGMENT(*,*,*,*,*,*,*,*);                                  19055000
         IF < THEN GO TO ERROR;                                         19060000
         TEMP1:=TEMP1+(SEGDESCRIP(TEMP).(2:14)+127)&LSR(7);             19065000
         @SEGPTR:=SEGPTR(SEGNEXT);                                      19070000
       END;                                                             19075000
     <<COMPLETE SEGMAP DST>>                                            19080000
     IF SEGMAPDST <> 0 THEN                                             19085000
      BEGIN                <<SEGMAP EXISTS>>                            19090000
        <<BUILD 2 WORD HEADER>>                                         19095000
        TOS:=SEGMAPSTTPOSITION; <<LENGTH OF MAP>>                       19100000
        TOS:=MAXMCSTIDX;        <<# MAPPED SEGS>>                       19105000
        EXCHANGEDB(SEGMAPDST);                                          19110000
        SEGMAP(0):=TOS;                                                 19115000
        SEGMAP(1):=TOS;                                                 19120000
        EXCHANGEDB(0);                                                  19125000
        <<ADJUST SIZE OF MAP>>                                          19130000
        ALTDSEGSIZE(SEGMAPDST,SEGMAPSTTPOSITION+2-                      19135000
                                 INITSEGMAPSIZE);                       19140000
      END;                                                              19145000
                                                                        19150000
     <<* * * MARK PROGRAM FILE AS LOADED * * *>>                        19155000
                                                                        19160000
     LOADBIT(PROGKEY,1,0); <<SET "LOADED" BIT>>                         19165000
     IF < THEN  <<ERROR?>>                                              19170000
        BEGIN                                                           19175000
        TOS := ERR72;                                                   19180000
        GO ABORT;                                                       19185000
        END;                                                            19190000
     PROGLOADBIT := 1;              <<SET LOAD BIT FLAG>>               19195000
     CONDCODE:=CCE;     <<OK CODE>>                                     19200000
     RETURN;                                                            19205000
IOERROR:                                                                19210000
     FERROR(PROGFNUM);                                                  19215000
     CONDCODE:=CCL;     <<ERROR CODE>>                                  19220000
     RETURN;                                                            19225000
ABORT:                                                                  19230000
     MERROR:=TOS;                                                       19235000
ERROR:                                                                  19240000
     CONDCODE:=CCL;                                                     19245000
   END;                                                                 19250000
$PAGE                                                                   19255000
PROCEDURE UPDATESEGTAB;                                                 19260000
   <<MAKES THE NECESSARY ENTRIES IN THE SEGMENT TABLE FOR >>            19265000
   <<THE SET OF LOADED AND REFERENCED SEGMENTS>>                        19270000
   OPTION UNCALLABLE;                                                   19275000
   BEGIN                                                                19280000
     INTEGER POSIT=Q+1,                                                 19285000
             NUMBSLINFO=Q+2,                                            19290000
             TEMP=Q+3,                                                  19295000
             LOGSEGNR=Q+4,                                              19300000
             SLLOADED=Q+5,                                              19305000
             TEMPMODE=Q+6,                                              19310000
             TEMPTYPE=Q+7,                                              19315000
             SLPVINFO'=Q+8,                                             19320000
             COMWORD =Q+9;                                              19325000
     DOUBLE TEMPKEY = Q+10,                                             19330000
            SLKEY'  = Q+12;                                             19335000
     DOUBLE LPROCKEY=SLKEY';                                            19340000
     INTEGER LPROCLEN=POSIT;                                            19345000
     INTEGER SLIDIDX=Q+14;                                              19350000
     INTEGER POINTER PSEGMAP=Q+15,                                      19355000
                     SEGPTR =Q+16,                                      19360000
                     STTPTR =Q+17;                                      19365000
     INTEGER POINTER MCSTLSPTR=Q+18;                                    19370000
     DOUBLE POINTER SLIDPTR=Q+19;                                       19375000
     INTEGER SAVEALLOCSEG =Q+20;                                        19380000
     INTEGER ARRAY WORKAREA(*)=Q+21;                                    19385000
     DEFINE MCOMMAND'=COMWORD.(0:2)#;                                   19390000
     DEFINE PROCLOAD' = LOGICAL(MCOMMAND')#,                            19395000
            ALLOCPROC'= MCOMMAND'=3#;                                   19400000
     DEFINE NUMBSLID = LPROCMASTERTAB(2).(0:8)#,                        19405000
            NUMBMCST = LPROCMASTERTAB(64).(8:8)#;                       19410000
$PAGE                                                                   19415000
SUBROUTINE INSERTSLINFO;                                                19420000
  <<INSERT SLINFO AREA INTO WORKAREA>>                                  19425000
  <<IF LOGICALMAPPING THEN ALSO BUILD              >>                   19430000
  <<  .PSEGMAP ARRAY (PROGLOAD)                    >>                   19435000
  <<  .MCSTREF ARRAY (PROCLOAD)                    >>                   19440000
  BEGIN                                                                 19445000
    IF SLDATABASE(SLNR) = 0 THEN RETURN;                                19450000
    TOS:=SLKEY(SLNR);                                                   19455000
    WORKAREA(POSIT+2):=TOS;  <<SLID>>                                   19460000
    WORKAREA(POSIT+1):=TOS;                                             19465000
    NUMBSLINFO:=NUMBSLINFO+1;                                           19470000
    WORKAREA(POSIT):=SLNR;   <<SL SEARCH SEQUENCE #>>                   19475000
    POSIT:=POSIT+3;                                                     19480000
    TOS:=SLSEGS(SLNR); <<SOURCE>>                                       19485000
    MOVE WORKAREA(POSIT):=*,(16); <<MOVE SLSEGS TO WORKAREA>>           19490000
    POSIT:=POSIT+16;                                                    19495000
    IF ALLOCPROC' THEN RETURN;                                          19500000
    IF PROCLOAD' THEN                                                   19505000
      BEGIN            <<LOAD/ALLOCATE PROCEDURE>>                      19510000
        <<INSERT SLKEY INTO LPROCMASTERTAB>>                            19515000
        SLIDIDX:=-1;                                                    19520000
        WHILE (SLIDIDX:=SLIDIDX+1) < NUMBSLID DO                        19525000
          BEGIN                                                         19530000
            IF SLIDPTR(SLIDIDX) = SLKEY(SLNR)                           19535000
              THEN GO FOUNDSLID; <<FOUND SLID IN ARRAY>>                19540000
          END; <<WHILE>>                                                19545000
        <<SLID NOT ALREADY IN ARRAY -INSERT IT>>                        19550000
        SLIDIDX:=NUMBSLID;                                              19555000
        NUMBSLID:=NUMBSLID+1;                                           19560000
        SLIDPTR(SLIDIDX):=SLKEY(SLNR);                                  19565000
FOUNDSLID:                                                              19570000
      END;                                                              19575000
    <<BUILD PSEGMAP OR MCSTREF ARRAY>>                                  19580000
    IF LOGICALMAPPING THEN                                              19585000
      BEGIN               <<MAPPING FIRMWARE PRESENT>>                  19590000
        @SEGPTR:=SLDATABASE(SLNR);                                      19595000
        WHILE @SEGPTR <> 0 DO                                           19600000
          BEGIN       <<CYCLE THRU REF'ED SEGS>>                        19605000
            IF SEGPTR(DBMAPFLAG) = 0 THEN                               19610000
              BEGIN   <<SEG LOGICALLY MAPPED>>                          19615000
                IF PROGLOAD THEN                                        19620000
                  BEGIN           <<LOAD/ALLOCATE PROGRAM>>             19625000
                    TOS:=NUMBSLINFO-1;<<CURR SLINFO INDEX>>             19630000
                    TOS.(0:8):=SEGPTR(DBLOGSEG);                        19635000
                    PSEGMAP(SEGPTR(DBMCST)):=TOS;                       19640000
                  END                                                   19645000
                 ELSE                                                   19650000
                  BEGIN           <<LOAD/ALLOCATE PROCEDURE>>           19655000
                    PSEGMAP(0):=PSEGMAP(0)+1;                           19660000
                    TOS:=SEGPTR(DBMCST);                                19665000
                    TOS.(0:1):=SEGPTR(DBNEWFLAG);                       19670000
                    PSEGMAP(PSEGMAP(0)):=TOS;                           19675000
                                                                        19680000
                    <<UPDATE MCSTLOGSEG ARRAY IN LPROCMTAB>>            19685000
                    IF SEGPTR(DBREFFLAG) = 0 THEN                       19690000
                      BEGIN        <<NEWLY REFERENCED SEG>>             19695000
                        <<CREATE NEW MCST ENTRY IN ARRAY>>              19700000
                        TOS:=SLIDIDX;                                   19705000
                        TOS.(0:8):=SEGPTR(DBLOGSEG);                    19710000
                        MCSTLSPTR(SEGPTR(DBMCST)&LSL(1)):=TOS;          19715000
                        MCSTLSPTR(XREG+1):=1; <<REFCOUNT>>              19720000
                      END                                               19725000
                     ELSE                                               19730000
                      BEGIN       <<ALREADY REFERENCED SEG>>            19735000
                        <<INCREMENT REFCOUNT>>                          19740000
                        MCSTLSPTR(XREG):=1+                             19745000
                           MCSTLSPTR(SEGPTR(DBMCST)&LSL(1)+1);          19750000
                      END;                                              19755000
                                                                        19760000
                  END;                                                  19765000
              END;                                                      19770000
            @SEGPTR:=SEGPTR(SEGNEXT);                                   19775000
          END; <<WHILE>>                                                19780000
      END;                                                              19785000
  END; <<INSERTSLINFO>>                                                 19790000
$PAGE                                                                   19795000
SUBROUTINE EXPANDSEGLIST;                                               19800000
  <<TEMP CONTAINS THE COUNT OF THE ADDITIONAL  >>                       19805000
  <<SEG LIST ENTRIES NEEDED                    >>                       19810000
  <<TEMP=0 IS RETURNED IF NO ROOM EXISTS       >>                       19815000
  BEGIN                                                                 19820000
    SJ:=TEMP*3;       <<EXTRA SPACE>>                                   19825000
    SK:=ENTRYLENGTH;  <<CURRENT LENGTH>>                                19830000
    SQ:=RLENGTH;      <<REGION SIZE>>                                   19835000
    SL:=@ENTP;        <<SAVE PTRS>>                                     19840000
    SM:=@ENTP1;                                                         19845000
    SN:=@ENTP2;                                                         19850000
    SI:=@ENTP3;                                                         19855000
    UNLINKLSTENTRY;   <<UNLINK CURRENT ENTRY>>                          19860000
    <<CREATE NEW ENTRY OF INCREASED SIZE>>                              19865000
    LCREATE(SJ+SK,SLFILE,NORMAL,0,SLKEY');                              19870000
    IF < THEN                                                           19875000
      BEGIN           <<ERROR-NO ROOM>>                                 19880000
        @ENTP:=SL;    <<RESTORE PTRS>>                                  19885000
        @ENTP1:=SM;                                                     19890000
        @ENTP2:=SN;                                                     19895000
        @ENTP3:=SI;                                                     19900000
        TEMP:=0;      <<ERROR FLAG>>                                    19905000
        LINKLSTENTRY; <<RELINK CURRENT ENTRY>>                          19910000
        RETURN;                                                         19915000
      END;                                                              19920000
    <<PTRS NOW POINT TO NEW ENTRY>>                                     19925000
    <<MOVE OLD ENTRY DATA TO NEW ENTRY>>                                19930000
    TOS:=@ENTP;       <<DESTINATION>>                                   19935000
    TOS:=SL;          <<SOURCE>>                                        19940000
    TOS:=SK;          <<LENGTH>>                                        19945000
    ASSEMBLE(MOVE 3); <<MOVE IT>>                                       19950000
    <<INITIALIZE NEW SEGLIST ENTRIES>>                                  19955000
    SM:=@ENTP3;       <<SAVE ENTP3>>                                    19960000
    SN:=TEMP;                                                           19965000
    @ENTP3:=@ENTP3+ESLSEG'SL*3;                                         19970000
    WHILE (SN:=SN-1) >= 0 DO                                            19975000
      BEGIN           <<EACH NEW SEGLIST ENTRY>>                        19980000
        ENTP3(0):=%177400; <<FREE>>                                     19985000
        ENTP3(1):=0;       <<REF COUNT>>                                19990000
        ENTP3(2):=0;       <<CST #>>                                    19995000
        @ENTP3:=@ENTP3+3;  <<NEXT>>                                     20000000
      END;<<WHILE>>                                                     20005000
    @ENTP3:=SM;       <<RESTORE ENTP3>>                                 20010000
    ESLSEG'SL:=ESLSEG'SL+TEMP; <<UPDATE COUNT>>                         20015000
    <<TURN OLD ENTRY INTO GARBAGE>>                                     20020000
    BUILDGARBAGE(SL-3,SQ);                                              20025000
  END; <<EXPANDSEGLIST>>                                                20030000
$PAGE                                                                   20035000
  <<INITIALIZE LOCAL VARIABLES>>                                        20040000
  ASSEMBLE(ADDS 20);  <<SPACE FOR LOCALS>>                              20045000
  TOS:=512;                                                             20050000
  ASSEMBLE(ADDS 0);   <<SPACE FOR WORKAREA>>                            20055000
  @PSEGMAP:=@WORKAREA(256);                                             20060000
  SAVEALLOCSEG:=0;                                                      20065000
  COMWORD:=LCTBUF;  <<COMMAND WORD>>                                    20070000
                                                                        20075000
  IF PROCLOAD' THEN                                                     20080000
    BEGIN           <<LOAD/ALLOCATE PROCEDURE>>                         20085000
      @SLIDPTR:=@LPROCMASTERTAB(35); <<SLID ARRAY>>                     20090000
      @MCSTLSPTR:=@LPROCMASTERTAB(64); <<MCSTLOGSEG ARRAY>>             20095000
      <<GET PLABEL OF LOADPROC SATISFIER>>                              20100000
      @SEGPTR:=FINDSEGENTRY(15,0);                                      20105000
      IF < THEN SUDDENDEATH(349);                                       20110000
      @STTPTR:=SEGPTR(STTNEXT); <<PTR TO STT ENTRY>>                    20115000
      @SEGPTR:=FINDSEGENTRY(STTPTR(DBSAT),                              20120000
                            STTPTR(DBPLABEL).(8:8));                    20125000
      IF < THEN SUDDENDEATH(349);                                       20130000
      MPLABEL:=STTPTR(DBPLABEL);                                        20135000
      MPLABEL.(0:1):=SEGPTR(DBMAPFLAG);                                 20140000
      IF SEGPTR(DBMAPFLAG) = 0                                          20145000
        THEN MPLABEL.(8:8):=SEGPTR(DBMCST)<<LOGICALLY MAPPED>>          20150000
        ELSE MPLABEL.(8:8):=SEGPTR(DBPHYCST);<<PHY. MAPPED>>            20155000
      <<CONSTRUCT EXTENSION ENTRY IN WORKAREA>>                         20160000
      IF ALLOCPROC'                                                     20165000
        THEN WORKAREA(3):=STTPTR(DBPLABEL).(8:8) <<LOGSEG #>>           20170000
        ELSE WORKAREA(3):=1; <<LOADPROC COUNT>>                         20175000
      WORKAREA(4):=MPLABEL;                                             20180000
      <<GET PROCEDURE NAME>>                                            20185000
      MOVE WORKAREA(5):=MPROCNAME',(MPROCNAME'.(4:3)+1);                20190000
      <<INSERT SLINFO AREAS INTO EXTENSION ENTRY>>                      20195000
      PSEGMAP(0):=0;                                                    20200000
      POSIT:=7+MPROCNAME'.(4:3); <<POSITION IN WORKAREA>>               20205000
      NUMBSLINFO:=0;                                                    20210000
      SLNR:=MLIBSEARCH+1;                                               20215000
      WHILE (SLNR:=SLNR-1) >= 0 DO                                      20220000
        INSERTSLINFO;                                                   20225000
      WORKAREA(6+MPROCNAME'.(4:3)):=NUMBSLINFO;                         20230000
      <<CREATE EXTENSION ENTRY IN LST>>                                 20235000
      TOS:=MPIN;                                                        20240000
      TOS:=MEXTENSION;                                                  20245000
      TEMPKEY:=TOS;          <<SAVE PARMS FOR LATER>>                   20250000
      TEMPMODE:=NORMAL;                                                 20255000
      TEMPTYPE:=EXTENSION;                                              20260000
    END ELSE                                                            20265000
    BEGIN       <<LOAD/ALLOCATE PROGRAM >>                              20270000
      <<CONSTRUCT PROGRAM FILE ENTRY IN WORKAREA>>                      20275000
      WORKAREA(3) := CSTBX;                                             20280000
      WORKAREA(4) := SEGMAPDST;                                         20285000
      WORKAREA(5) := 0;        <<SHARE COUNT>>                          20290000
      WORKAREA(7) := MPVINFO;  <<PV INFO>>                              20295000
      <<CONSTRUCT TRACE0' EXTERNAL LABEL>>                              20300000
      IF PSASTLT = -1 THEN                                              20305000
        BEGIN  <<PROGRAM NOT BEING TRACED>>                             20310000
          WORKAREA(8):=0;                                               20315000
        END                                                             20320000
       ELSE                                                             20325000
        BEGIN  <<PROGRAM BEING TRACED>>                                 20330000
          <<FIND TRACE0' SEG ENTRY>>                                    20335000
          @SEGPTR:=FINDSEGENTRY(15,0);                                  20340000
          IF < THEN SUDDENDEATH(349);                                   20345000
          @STTPTR:=SEGPTR(STTNEXT);                                     20350000
          <<FIND SATISFIER>>                                            20355000
          @SEGPTR:=FINDSEGENTRY(STTPTR(DBSAT),                          20360000
                      STTPTR(DBPLABEL).(8:8));                          20365000
          IF < THEN SUDDENDEATH(349);                                   20370000
          <<CONSTRUCT EXTERNAL LABEL>>                                  20375000
          WORKAREA(8):=STTPTR(DBPLABEL);                                20380000
          WORKAREA(8).(0:1):=SEGPTR(DBMAPFLAG);                         20385000
          IF SEGPTR(DBMAPFLAG) = 0                                      20390000
            THEN WORKAREA(8).(8:8):=SEGPTR(DBMCST)                      20395000
            ELSE WORKAREA(8).(8:8):=SEGPTR(DBPHYCST);                   20400000
        END;                                                            20405000
      <<INSERT SLINFO AREA INTO PROGRAM FILE ENTRY>>                    20410000
      POSIT:=9;  <<POSITION IN WORKAREA>>                               20415000
      NUMBSLINFO:=0;                                                    20420000
      SLNR:=MLIBSEARCH+1;                                               20425000
      WHILE (SLNR:=SLNR-1) >= 0 DO                                      20430000
        INSERTSLINFO;                                                   20435000
      TOS:=NUMBSLINFO;                                                  20440000
      TOS.(0:8):=NPA;                                                   20445000
      WORKAREA(6):=TOS;  <<# PROG SEGS,#SLINFO AREAS>>                  20450000
      PSEGMAP(0):=MAXMCSTIDX; <<# ENTRIES IN PSEGMAP>>                  20455000
      IF LOGICALMAPPING THEN                                            20460000
        BEGIN            <<INSERT PROG INFO IN PSEGMAP>>                20465000
          TEMP:=0;                                                      20470000
          WHILE (TEMP:=TEMP+1) <= NPA DO                                20475000
            BEGIN                                                       20480000
              PSEGMAP(TEMP):=(TEMP-1)&LSL(8)+14;                        20485000
            END; <<WHILE>>                                              20490000
        END;                                                            20495000
      <<CREATE USER ENTRY IN LST>>                                      20500000
      TEMPKEY:=PROGKEY;           <<SAVE PARMS FOR LATER>>              20505000
      TEMPMODE:=MPMODE;                                                 20510000
      TEMPTYPE:=PROGFILE;                                               20515000
    END;                                                                20520000
  TOS:=POSIT+PSEGMAP(0)+1;  <<LENGTH>>                                  20525000
  TOS:=TEMPTYPE;            <<TYPE>>                                    20530000
  TOS:=TEMPMODE;            <<MODE>>                                    20535000
  TOS:=MLIBSEARCH;          <<LIB>>                                     20540000
  TOS:=TEMPKEY;             <<KEY>>                                     20545000
  EXCHANGEDB(SEGTABDST);          <<DB TO LST>>                         20550000
  LCREATE(*,*,*,*,*);             <<CREATE USER ENTRY>>                 20555000
  IF < THEN GO NOROOM;            <<ERROR>>                             20560000
  TOS:=@ENTP;                     <<ENTRY>>                             20565000
  EXCHANGEDB(0);                  <<DB TO STACK>>                       20570000
  <<MOVE DATA TO ENTRY>>                                                20575000
  TOS:=SEGTABDST;                                                       20580000
  ASSEMBLE(XCH);                                                        20585000
  IF PROCLOAD' THEN                                                     20590000
    BEGIN                         <<PROCEDURE>>                         20595000
      TOS:=TOS+3;                 <<OFFSET INTO ENTRY>>                 20600000
      TOS:=@WORKAREA+3;           <<DATA>>                              20605000
      TOS:=POSIT-3;               <<COUNT>>                             20610000
    END ELSE                                                            20615000
    BEGIN                         <<PROGRAM>>                           20620000
      TOS:=TOS+3;                 <<OFFSET INTO ENTRY>>                 20625000
      TOS:=@WORKAREA+3;           <<DATA>>                              20630000
      TOS:=POSIT-3;               <<COUNT>>                             20635000
    END;                                                                20640000
  ASSEMBLE (MTDS 2);    <<MOVE SLINFO DATA>>                            20645000
  <<MOVE PSEGMAP ARRAY>>                                                20650000
  TOS:=@PSEGMAP;  <<SOURCE>>                                            20655000
  TOS:=PSEGMAP(0)+1; <<COUNT>>                                          20660000
  ASSEMBLE(MTDS 4);                                                     20665000
  <<UPDATE SL TABLES>>                                                  20670000
  SLNR:=MLIBSEARCH+1;                                                   20675000
  WHILE (SLNR:=SLNR-1) >=0 DO                                           20680000
   BEGIN                         <<CYCLE THRU EACH SL>>                 20685000
    IF NSLA(SLNR) <> 0 OR  <<SEGS LOADED?>>                             20690000
       ALLOCPROC' AND      <<OR ALLOCATE PROCEDURE?>>                   20695000
       SLNR = 0 THEN       <<AND SLNR=SYS SL?>>                         20700000
      BEGIN                     <<SEGS ALLOCATED>>                      20705000
        <<BUILD 2 WORD SEG LIST ENTRY FOR EACH  >>                      20710000
        <<LOADED SEGMENT                        >>                      20715000
        POSIT:=0;                                                       20720000
        @SEGPTR:=SLDATABASE(SLNR);                                      20725000
        WHILE @SEGPTR <> 0 DO                                           20730000
         BEGIN        <<CYCLE THRU REF'ED SEGS>>                        20735000
          IF SEGPTR(DBNEWFLAG) = 1 THEN                                 20740000
            BEGIN    <<SEG JUST ALLOCATED>>                             20745000
              TOS:=SEGPTR(DBFLAGS); <<A,C,X,M BITS>>                    20750000
              TOS.(0:8):=SEGPTR(DBLOGSEG); <<LOG SEG #>>                20755000
              WORKAREA(POSIT):=TOS;                                     20760000
              WORKAREA(POSIT+1):=SEGPTR(DBPHYCST);                      20765000
              POSIT:=POSIT+2;                                           20770000
            END;                                                        20775000
          IF ALLOCPROC' AND                                             20780000
             SEGPTR(DBLBIT)=1 THEN                                      20785000
            BEGIN        <<SEG IS BEING ALLOCATED>>                     20790000
              <<SAVE LOG SEG # FOR USE LATER>>                          20795000
              SAVEALLOCSEG:=SEGPTR(DBLOGSEG);                           20800000
              SAVEALLOCSEG.(0:1):=1;<<FORCE <> 0>>                      20805000
            END;                                                        20810000
          @SEGPTR:=SEGPTR(SEGNEXT);                                     20815000
         END; <<WHILE>>                                                 20820000
        <<UPDATE SL ENTRY IN LST>>                                      20825000
        SLLOADED:=0;                                                    20830000
        SLKEY':=SLKEY(SLNR);                                            20835000
        SLPVINFO':=SLPVINFO(SLNR);                                      20840000
        EXCHANGEDB(SEGTABDST);  <<DB TO LST>>                           20845000
        IF NOT LSEARCH(SLKEY',NORMAL,SLFILE) THEN                       20850000
          BEGIN                 <<SL ENTRY MUST BE CREATED>>            20855000
            TOS:=POSIT&LSR(1)+10; <<#SEG LIST ENTRIES>>                 20860000
            IF S0>255 THEN                                              20865000
              BEGIN               <<TOO MANY>>                          20870000
                ASSEMBLE(DEL);                                          20875000
                TOS:=255;                                               20880000
              END;                                                      20885000
            TOS:=TOS*3+21;        <<LENGTH OF ENTRY>>                   20890000
            LCREATE(*,SLFILE,NORMAL,0,SLKEY');                          20895000
            IF < THEN                                                   20900000
              BEGIN               <<ERROR NO ROOM>>                     20905000
                LSEARCH'(TEMPKEY,TEMPMODE,TEMPTYPE);           <<06541>>20910000
                LDELETE;  <<FIND USER ENTRY AND DELETE>>                20915000
                GO NOROOM;                                              20920000
              END;                                                      20925000
            LOADBIT(SLKEY',TRUE,SEGTABDST);                             20930000
            IF < THEN                                                   20935000
              BEGIN               <<ERROR>>                             20940000
                LSEARCH'(TEMPKEY,TEMPMODE,TEMPTYPE);           <<06541>>20945000
                LDELETE;  <<FIND USER ENTRY AND DELETE>>                20950000
                TOS:=ERR72;                                             20955000
                GO NFG;                                                 20960000
              END;                                                      20965000
            SLLOADED:=-1;         <<SL LOADED FLAG>>                    20970000
            <<INITIALIZE SL ENTRY>>                                     20975000
            TOS:=POSIT&LSR(1)+10;                                       20980000
            IF S0 > 255 THEN                                            20985000
              BEGIN                                                     20990000
                ASSEMBLE(DEL);                                          20995000
                ENTP(4):=255;                                           21000000
              END ELSE                                                  21005000
              BEGIN                                                     21010000
                ENTP(4):=TOS;                                           21015000
              END;                                                      21020000
            TOS:=@ENTP+5;          <<PTR TO SEG ARRAY>>                 21025000
            CLEARBITMAP(*);        <<CLEAR SEG ARRAY>>                  21030000
            <<SET ALL SEGLIST ENTRIES AS FREE>>                         21035000
            TEMP:=ENTP(4)*3;                                            21040000
            WHILE (TEMP:=TEMP-3) >=0 DO                                 21045000
              BEGIN                                                     21050000
                ENTP3(TEMP):=%177400;                                   21055000
                ENTP3(TEMP+1):=0;                                       21060000
                ENTP3(TEMP+2):=0;                                       21065000
              END;                                                      21070000
          END;                                                          21075000
        <<SL ENTRY EXISTS - UPDATE IT >>                                21080000
        EPVINFO'SL:=SLPVINFO';     <<PV INFO >>                         21085000
        <<INSURE SUFFICIENT FREE SEGLIST ENTRIES EXIST>>                21090000
        TEMP:=POSIT&LSR(1)-(ESLSEG'SL-EALLOCSEG'SL);<<#NEEDED>>         21095000
        IF TEMP > 0 THEN                                                21100000
          BEGIN              <<SEG LIST MUST BE EXPANDED>>              21105000
            IF ESLSEG'SL+TEMP+10 > 255                                  21110000
              THEN TEMP:=255-ESLSEG'SL                                  21115000
              ELSE TEMP:=TEMP+10;                                       21120000
            EXPANDSEGLIST;                                              21125000
            IF TEMP = 0 THEN                                            21130000
              BEGIN          <<ERROR NO ROOM>>                          21135000
                LSEARCH'(TEMPKEY,TEMPMODE,TEMPTYPE);           <<06541>>21140000
                LDELETE;  <<FIND USER ENTRY AND DELETE>>                21145000
                GO NOROOM;                                              21150000
              END;                                                      21155000
          END;                                                          21160000
        <<SUFFICIENT SEG LIST ENTRIES EXIST>>                           21165000
        <<ADD ALLOCATED SEG TO SEGLIST>>                                21170000
        SL:=@ENTP3;          <<SAVE POINTER>>                           21175000
        TEMP:=-2;                                                       21180000
        WHILE (TEMP:=TEMP+2) < POSIT DO                                 21185000
          BEGIN              <<CYCLE THRU WORKAREA>>                    21190000
            WHILE ENTP3.(0:8) <> 255                                    21195000
              DO @ENTP3:=@ENTP3+3;                                      21200000
            <<FOUND FREE ENTRY>>                                        21205000
            ENTP3(0):=WORKAREA(TEMP); <<LOGSEG,FLAGS>>                  21210000
            ENTP3(2):=WORKAREA(TEMP+1);<<CST #>>                        21215000
            <<SET ALLOCATED BIT IN SEG ARRAY>>                          21220000
            TOS:=@ENTP+5; <<PTR TO SEG ARRAY>>                          21225000
            TOS:=WORKAREA(TEMP).(0:8); <<LOG SEG #>>                    21230000
            SETBIT(*,*);  <<SET THE BIT>>                               21235000
            @ENTP3:=@ENTP3+3;                                           21240000
            <<INCREMENT # ALLOCATED SEGS IN SL>>                        21245000
            EALLOCSEG'SL:=EALLOCSEG'SL+1;                               21250000
          END; <<WHILE>>  <<NEXT WORKAREA ENTRY>>                       21255000
        IF ALLOCPROC' AND                                               21260000
           SAVEALLOCSEG <> 0 THEN                                       21265000
          BEGIN           <<ALLOCATE PROCEDURE AND>>                    21270000
                          <<SEG NEEDS "A" BIT SET>>                     21275000
            @ENTP3:=SL;   <<HEAD OF SEGLIST>>                           21280000
            WHILE ENTP3.(0:8) <> SAVEALLOCSEG.(8:8)                     21285000
              DO @ENTP3:=@ENTP3+3;                                      21290000
            <<FOUND SEGLIST ENTRY--SET "A" BIT>>                        21295000
            ENTP3.(12:1):=1;                                            21300000
          END;                                                          21305000
        @ENTP3:=SL;    <<RESTORE VALUE>>                                21310000
        <<LST HAS BEEN UPDATED FOR THIS SL>>                            21315000
        EXCHANGEDB(0);    <<DB TO STACK>>                               21320000
        NSLA(SLNR):=SLLOADED; <<SAVE FLAG>>                             21325000
      END;                                                     <<06094>>21330000
   END; <<WHILE>>  <<NEXT SL>>                                          21335000
  IF PROCLOAD' AND NOT(ALLOCPROC') THEN                                 21340000
    BEGIN          <<LOAD PROCEDURE>>                                   21345000
      <<UPDATE LOADPROCMASTER ENTRY IN LST>>                            21350000
      <<SET UP FOR SPLIT STACK OPERATIONS ON LOADPROCMASTER>>           21355000
      NUMBMCST:=MAXMCSTIDX;                                             21360000
      LPROCKEY:=DOUBLE(MPIN); <<KEY>>                                   21365000
      LPROCLEN:=35+(NUMBMCST+1)&LSL(1)+NUMBSLID&LSL(1);<<LGTH>>         21370000
      <<SETUP FOR MOVES IN SPLIT STACK>>                                21375000
      TOS:=@LPROCMASTERTAB(64)-@DLAREA2; <<DL RELATIVE>>                21380000
      TOS:=(NUMBMCST+1)&LSL(1); <<COUNT FOR MOVE 2>>                    21385000
      TOS:=@LPROCMASTERTAB-@DLAREA2; <<DL RELATIVE>>                    21390000
       TOS:=35+NUMBSLID&LSL(1);  <<COUNT FOR MOVE 1>>                   21395000
      EXCHANGEDB(SEGTABDST);                                            21400000
      <<FIND CURRENT  LOADPROCMASTER ENTRY IN LST>>                     21405000
      IF LSEARCH(LPROCKEY,NORMAL,LOADPROCMASTER) THEN                   21410000
        BEGIN     <<FOUND ENTRY>>                                       21415000
          IF RLENGTH < LPROCLEN+3 THEN                                  21420000
            BEGIN <<ENTRY TOO SMALL--CREATE NEW ONE>>                   21425000
              TEMP:=@ENTP;  <<SAVE PTR>>                                21430000
              LCREATE(LPROCLEN,LOADPROCMASTER,                          21435000
                               NORMAL,0,LPROCKEY);                      21440000
              IF < THEN                                                 21445000
                BEGIN    <<NO ROOM>>                                    21450000
                  LSEARCH'(TEMPKEY,TEMPMODE,TEMPTYPE);         <<06541>>21455000
                  LDELETE;                                              21460000
                  GO NOROOM;                                            21465000
                END;                                                    21470000
              TOS:=@ENTP;  <<SAVE PTR>>                                 21475000
              @ENTP:=TEMP; <<PTR TO OLD LOADPROCMASTER ENTRY>>          21480000
              LDELETE;                                                  21485000
              @ENTP:=TOS;<<RESTORE PTR TO NEW LOADPROCMASTER>>          21490000
            END;                                                        21495000
          <<MOVE LPROCMASTERTAB TO LST>>                                21500000
          TOS:=@ENTP;                                                   21505000
          ASSEMBLE(CAB,CAB); <<TARGET,SOURCE,COUNT>>                    21510000
          ASSEMBLE(MVLB 3);  <<MOVE MCSTIDX,SLID ARRAY>>                21515000
          TOS:=@ENTP+35+ESLID'LPROC&LSL(1);                             21520000
          ASSEMBLE(CAB,CAB); <<TARGET,SOURCE,COUNT>>                    21525000
          ASSEMBLE(MVLB 3);  <<MOVE MCSTLOGSEG ARRAY>>                  21530000
        END                                                             21535000
       ELSE                                                             21540000
        BEGIN     <<DID NOT FIND LOADPROCMASTER>>                       21545000
          SUDDENDEATH(348);                                             21550000
        END;                                                            21555000
    END                                                                 21560000
   ELSE                                                                 21565000
    BEGIN       <<LOAD/ALLOCATE PROGRAM OR ALLOCATE PROCEDURE>>         21570000
      EXCHANGEDB(SEGTABDST);                                            21575000
    END;                                                                21580000
                                                                        21585000
  <<UPDATE TABLES FOR USER ENTRY>>                                      21590000
  LSEARCH'(TEMPKEY,TEMPMODE,TEMPTYPE);                         <<06541>>21595000
  ADJREFCOUNTS(1); <<INCREMENT REF COUNTS>>                             21600000
  EXCHANGEDB(0);                                                        21605000
  TOS := CCE;  <<OK CONDITION CODE>>                                    21610000
  GO GETOUT;                                                            21615000
                                                                        21620000
  NOROOM:                                                               21625000
  TOS := ERR70;                                                         21630000
                                                                        21635000
  NFG:                                                                  21640000
  EXCHANGEDB(0);  <<RESET DB TO STACK>>                                 21645000
  MERROR := TOS;  <<ERROR NR.>>                                         21650000
                                                                        21655000
  TOS := CCL;  <<ERROR CONDITION CODE>>                                 21660000
                                                                        21665000
  GETOUT:                                                               21670000
  CONDCODE:=TOS; <<CONDITION CODE>>                                     21675000
 END;                                                                   21680000
$PAGE                                                                   21685000
PROCEDURE REL'RESOURCES;                                                21690000
  <<RELEASE RESOURCES ACQUIRED DURING ABORTED LOAD>>                    21695000
  BEGIN                                                                 21700000
    INTEGER POINTER SEGPTR;                                             21705000
    <<RELEASE ALLOCATED CST'S>>                                         21710000
    IF LOGICAL(CSTSALLOCATED) THEN                                      21715000
      BEGIN          <<CST'S WERE ALLOCATED>>                           21720000
        SLNR:=MLIBSEARCH+1;                                             21725000
        WHILE (SLNR:=SLNR-1) >= 0 DO                                    21730000
          BEGIN      <<EACH SL>>                                        21735000
            @SEGPTR:=SLDATABASE(SLNR);                                  21740000
            WHILE @SEGPTR <> 0 DO                                       21745000
              BEGIN                                                     21750000
                IF SEGPTR(DBNEWFLAG) = 1                                21755000
                  THEN RETURNENTRY(1,SEGPTR(DBPHYCST));                 21760000
                @SEGPTR:=SEGPTR(SEGNEXT);                               21765000
              END; <<WHILE>>                                            21770000
          END; <<WHILE>>                                                21775000
      END;                                                              21780000
                                                                        21785000
    <<RELEASE CST BLOCK>>                                               21790000
    IF LOGICAL(CSTBLOCKALLOCATED)                                       21795000
      THEN DEALCSTBLOCK(CSTBX);                                         21800000
                                                                        21805000
    <<RELEASE SEGMAP>>                                                  21810000
    IF SEGMAPDST <> 0 THEN                                              21815000
      BEGIN               <<DST EXISTS>>                                21820000
        IF PROGLOAD                                                     21825000
          THEN RELDATASEG(SEGMAPDST)                                    21830000
          ELSE IF NEWSEGMAPFLAG = 1                                     21835000
                 THEN RELDATASEG(SEGMAPDST);                            21840000
      END;                                                              21845000
                                                                        21850000
                                                                        21855000
    <<RESET PROGRAM LOADED FLAG>>                                       21860000
    IF LOGICAL(PROGLOADBIT)                                             21865000
      THEN LOADBIT(PROGKEY,0,0);                                        21870000
                                                                        21875000
    <<RESET SL LOADED FLAG - EXCEPT SYS SL>>                            21880000
    SLNR:=MLIBSEARCH+1;                                                 21885000
    WHILE (SLNR:=SLNR-1) > 0 DO                                         21890000
      BEGIN                                                             21895000
        IF NSLA(SLNR) = -1                                              21900000
          THEN LOADBIT(SLKEY(SLNR),0,0);                                21905000
      END; <<WHILE>>                                                    21910000
  END; <<REL'RESOURCES>>                                                21915000
$PAGE                                                                   21920000
PROCEDURE AWAKE'WAITING'PINS;                                           21925000
  <<AWAKE PINS WAITING FOR PROGRAM LOAD>>                               21930000
  BEGIN                                                                 21935000
    DOUBLE LCTDBACK',PROGKEY';                                          21940000
    INTEGER MPMODE',WAITINGPIN';                                        21945000
    <<GET DATA INTO LOCAL VARIABLES>>                                   21950000
    LCTDBACK':=LCTDBACK; <<STARTING CST & ERROR #>>                     21955000
    PROGKEY':=PROGKEY;     <<PROG FILE KEY         >>                   21960000
    MPMODE':=MPMODE;       <<PROG MODE             >>                   21965000
    EXCHANGEDB(SEGTABDST);                                              21970000
    WHILE LSEARCH(PROGKEY',MPMODE',WAITING) DO                          21975000
      BEGIN                                                             21980000
        <<FOUND PIN WAITING ON THIS PROG LOAD>>                         21985000
        WAITINGPIN':=EWAITINGPIN; <<PIN #>>                             21990000
        LDELETE;           <<DELETE WAITING ENTRY>>                     21995000
        <<CREATE LOADED ENTRY FOR WAITING PIN>>                         22000000
        LCREATE(5,LOADED,MPMODE',0,PROGKEY');                           22005000
        ENTDP2:=LCTDBACK';<<INSERT LOAD STATUS>>                        22010000
        UNIMPEDE(WAITINGPIN'*PCBSIZE); <<AWAKE PIN>>                    22015000
      END; <<WHILE>>                                                    22020000
    <<DELETE LOADING ENTRY FOR PIN WHICH STARTED PROG LOAD>>            22025000
    IF LSEARCH(PROGKEY',MPMODE',LOADING) THEN LDELETE;                  22030000
    EXCHANGEDB(0);                                                      22035000
  END; <<AWAKE'WAITING'PINS>>                                           22040000
PROCEDURE INIT'SEGTABDSTX;                                     <<06541>>22045000
                                                               <<06541>>22050000
<< THIS PROCEDURE INITIALIZES EXTRA DST. IT HAS THE SAME >>    <<06541>>22055000
<< FORMAT AS LST SO THAT ALL THE LST PROCEDURE CAN BE    >>    <<06541>>22060000
<< USED. THE EXTRA DST IS FOR EXTENSION ENTRIES ONLY.    >>    <<06541>>22065000
<< DB IS IN EXTRA DST WHILE THIS PROCEDURE IS CALLED.    >>    <<06541>>22070000
                                                               <<06541>>22075000
BEGIN                                                          <<06541>>22080000
   @DIR:=128+38;                                               <<06541>>22085000
   DIRLEN := DSTI(SEGTABDST'EX*4).(3:13)*4-38-128;             <<06541>>22090000
   @SBUF0 := 38;                                               <<06541>>22095000
   @ENTP := HDFWDLINK(GARBAGE) := HDBKWDLINK(GARBAGE)          <<06541>>22100000
         := @DIR+3;                                            <<06541>>22105000
   FWDLINK := BKWDLINK := 0;                                   <<06541>>22110000
   ETYPE := GARBAGE;                                           <<06541>>22115000
   RLENGTH := DIRLEN;                                          <<06541>>22120000
END;                                                           <<06541>>22125000
<<----------------------------------------->>                           22130000
<<                                         >>                           22135000
<<        MAIN PROGRAM                     >>                           22140000
<<                                         >>                           22145000
<<----------------------------------------->>                           22150000
                                                                        22155000
$PAGE                                                                   22160000
    TURNOFFTRAPS;                                                       22165000
    PUSH(DL);                                                           22170000
    DLSZE := TOS;                                                       22175000
    <<GET POINTER TO LCT>>                                              22180000
    TOS:=@LCTOFFSET;       <<RECEIVE LCT OFFSET>>                       22185000
    TOS:=SEGTABDST;        <<LST>>                                      22190000
    TOS:=LCTPTR;           <<OFFSET TO LCTPTR>>                         22195000
    TOS:=1;                <<1 WORD>>                                   22200000
    ASSEMBLE(MFDS 4);                                                   22205000
    <<MOVE INFO FROM LCT TO LCTBUF>>                                    22210000
    TOS:=@LCTBUF;         <<RECEIVE REQUEST>>                           22215000
    TOS:=SEGTABDST;        <<LST>>                                      22220000
    TOS:=LCTOFFSET;        <<OFFSET TO LCT IN LST>>                     22225000
    TOS:=LCTLENGTH;       <<TRANSFER SIZE>>                             22230000
    ASSEMBLE(MFDS 4);                                                   22235000
                                                                        22240000
    << OPEN THE SYSTEM SL >>                                            22245000
                                                                        22250000
    TOS := 0D;                                                          22255000
    TOS := ABS(SSLKEYA);                                                22260000
    TOS := ABS(XREG:=XREG+1);  <<SYSTEM SL KEY>>                        22265000
    SLKEY(0):=DS1;                                                      22270000
    S2 := BS1;   <<EXTRACT THE LOGICAL DEVICE>>                         22275000
    BS1 := 0;                                                           22280000
    SLFNUM(0):=FOPENDA(*,*,%(2)111110110);                              22285000
    IF  <>  THEN                                                        22290000
       BEGIN                                                            22295000
         FERROR(0);                                                     22300000
         GO RETURNLCT;                                                  22305000
       END;                                                             22310000
                                                                        22315000
    << GET AN EXTRA DST FOR LST EXTENSION >>                   <<06541>>22320000
    << SIZE OF THE XDST IS THE SAME AS LST>>                   <<06541>>22325000
                                                               <<06541>>22330000
    TOS := 0;                                                  <<06541>>22335000
    TOS := DSTI(SEGTABDST*4).(3:13)*4;  << LST SIZE >>         <<06541>>22340000
    TOS := DSTI(SEGTABDST*4+1).(9:7)*%1000; << LST VM >>       <<06541>>22345000
    TOS := GETDATASEGC(*,*);                                   <<06541>>22350000
    SEGTABDST'EX := TOS;                                       <<06541>>22355000
    EXCHANGEDB(SEGTABDST'EX);                                  <<06541>>22360000
    INIT'SEGTABDSTX;                                           <<06541>>22365000
    EXCHANGEDB(0);                                             <<06541>>22370000
                                                                        22375000
    << OPEN THE LOADLIST FILE >>                                        22380000
                                                                        22385000
RETRYLIST:                                                              22390000
    LISTFNUM := FOPEN(LISTDESIG,%2001,%304);                            22395000
    IF  <  THEN                                                         22400000
       BEGIN  << ERROR, OR MUST BUILD THE FILE >>                       22405000
         FCHECK(LISTFNUM,LISTFNUM);                                     22410000
         IF  <>  OR  LISTFNUM <> 52  THEN                               22415000
            BEGIN                                                       22420000
LISTERR:                                                                22425000
              TOS := ERR54;                                             22430000
              GO NFG;                                                   22435000
            END;                                                        22440000
         LISTFNUM := FOPEN(LISTDESIG,%2104,4,36);                       22445000
         IF  <>  THEN  GO LISTERR;                                      22450000
         FCLOSE(LISTFNUM,1,0);                                          22455000
         IF  <>  THEN  GO LISTERR;                                      22460000
         GO RETRYLIST;                                                  22465000
       END;                                                             22470000
    FGETINFO(LISTFNUM,,,,,,,,,,,,,,,,,,,LISTADDR);                      22475000
    IF  <>  THEN  GO LISTERR;                                           22480000
                                                                        22485000
    <<GET CACHE DATA SEGMENT>>                                          22490000
    LOADCACHESEG:=GETDATASEG(BUCKET0+NBUCKETS*BUCKETSIZE,0);            22495000
    INITLOADCACHE;                                                      22500000
ASSEMBLE(ADDS 1);                                              <<*7545>>22505000
RECEIVEMSG(4,1,%40000);                                        <<*7909>>22510000
IF TOS<>LOAD'MESSAGE THEN                                      <<*7545>>22515000
   SUDDENDEATH(347);                                           <<*7545>>22520000
                                                                        22525000
L:   <<  RESTART HERE >>                                                22530000
    PUSH( DL );                                                         22535000
    @DLAREA2 := S0;                                                     22540000
    @DLAVAIL := TOS;                                                    22545000
    @DLAREA1 := -SYSDL;                                                 22550000
                                                                        22555000
    <<* * * EXTRACT COMMAND FROM LCT * * *>>                            22560000
                                                                        22565000
    SAVESIR := GETSIR(SEGTABSIR);                              <<*8527>>22570000
    TOS:=@LCTBUF;         <<RECEIVE REQUEST>>                           22575000
    TOS:=SEGTABDST;        <<LST>>                                      22580000
    TOS:=LCTOFFSET;        <<OFFSET TO LCT IN LST>>                     22585000
    TOS:=LCTLENGTH;       <<TRANSFER SIZE>>                             22590000
    ASSEMBLE(MFDS 4);                                                   22595000
    RELSIR(SEGTABSIR,SAVESIR);                                 <<*8527>>22600000
                                                                        22605000
    <<INITIALIZE VARIABLES>>                                            22610000
                                                                        22615000
    PCBPT := MPIN * PCBSIZE;                                            22620000
    SAVESIR:=-1;                                                        22625000
    LISTFLAG:=FALSE;                                                    22630000
    LCTDBACK:=0D;                                                       22635000
    SLDATABASE(0):=0;                                                   22640000
    MOVE SLDATABASE(1):=SLDATABASE(0),(15);                             22645000
    SLDB'SEG'DIR(0):=0;                                                 22650000
    MOVE SLDB'SEG'DIR(1):=SLDB'SEG'DIR(0),(255);                        22655000
    GLOBALFLAGS:=0;                                                     22660000
    NSLA(0):=0;                                                         22665000
    MOVE NSLA(1):=NSLA(0),(15);                                         22670000
    NPA:=0;                                                             22675000
    OLDSEGMAPDST:=0;                                                    22680000
    SEGMAPDST := IF PROGLOAD OR ALLOCPROC THEN 0                        22685000
       ELSE SPCBMAPDST;                                                 22690000
    NEEDSEGMAP:=FALSE;                                                  22695000
    DRTRECD:=0D;                                                        22700000
    SLFNUM(1):=0;                                                       22705000
    MOVE SLFNUM(2):=SLFNUM(1),(14);                                     22710000
    PROGFNUM:=0;                                                        22715000
    LOADDOMAIN:=MLOADDOMAIN;                                            22720000
                                                                        22725000
    <<CLEAR LIST FILE>>                                                 22730000
                                                                        22735000
    CLEARLINE;                                                          22740000
    FCONTROL(LISTFNUM,5,LISTFLAG);                                      22745000
    IF  <>  THEN                                                        22750000
       BEGIN                                                            22755000
         TOS := ERR64;                                                  22760000
         GO NFG;                                                        22765000
       END;                                                             22770000
                                                                        22775000
    <<* * * PROCESS COMMAND * * *>>                                     22780000
                                                                        22785000
    IF PROCLOAD                                                         22790000
      THEN SATISFYPROC  <<SATISFY PROCEDURE EXTERNAL>>                  22795000
      ELSE SATISFYPROG; <<SATISFY PROGRAM EXTERNALS >>                  22800000
    IF < THEN GO RECOVER; <<ERROR>>                                     22805000
    SAVESIR:=GETSIR(SEGTABSIR);                                         22810000
    ADDSEGDATA'SLDB; <<COMPLETE SLDATABASE FOR SL SEGS>>                22815000
    IF < THEN GO RECOVER; <<ERROR>>                                     22820000
    LOADEXTERNALS;   <<LOAD SL SEGS>>                                   22825000
    IF < THEN GO RECOVER; <<ERROR>>                                     22830000
    IF PROGLOAD THEN                                                    22835000
      BEGIN          <<LOAD/ALLOCATE PROGRAM>>                          22840000
        ADDPROGDATA'SLDB; <<COMPLETE SLDATABASE FOR PROG SEGS>>         22845000
        IF < THEN GO RECOVER; <<ERROR>>                                 22850000
        LOADPROGRAM; <<LOAD PROGRAM SEGS>>                              22855000
        IF < THEN GO RECOVER; <<ERROR>>                                 22860000
      END;                                                              22865000
    UPDATESEGTAB;    <<UPDATE LOADER SEGMENT TABLE>>                    22870000
    IF < THEN GO RECOVER; <<ERROR>>                                     22875000
    IF PROCLOAD THEN                                           <<06541>>22880000
       BEGIN                                                   <<06541>>22885000
          TRANS'LST'TO'XDST;                                   <<06541>>22890000
          IF <> THEN                                           <<06541>>22895000
             BEGIN                                             <<06541>>22900000
               CSTSALLOCATED := 0;                                      22905000
                TOS:=ERR70;                                    <<06541>>22910000
                GO TO NFG;                                     <<06541>>22915000
             END;                                              <<06541>>22920000
       END;                                                    <<06541>>22925000
                                                                        22930000
RETURNLCT:                                                              22935000
                                                                        22940000
    <<WAKE UP WAITING PROCESSES>>                                       22945000
    IF PROGLOAD THEN                                                    22950000
      BEGIN         <<LOAD/ALLOCATE PROGRAM>>                           22955000
        AWAKE'WAITING'PINS;                                             22960000
      END;                                                              22965000
                                                                        22970000
    <<RELEASE RESOURCES>>                                               22975000
                                                                        22980000
    IF SAVESIR <> -1 THEN RELSIR(SEGTABSIR,SAVESIR);                    22985000
    FUNLOCK(SLFNUM(0)); <<UNLOCK SYS SL>>                               22990000
                                                                        22995000
    <<CLOSE SL FILES EXCEPT SYS SL>>                                    23000000
    SLNR:=MLIBSEARCH+1;                                                 23005000
    WHILE (SLNR:=SLNR-1) > 0 DO                                         23010000
      BEGIN                                                             23015000
        IF SLFNUM(SLNR) <> 0 THEN FCLOSE(SLFNUM(SLNR),0,0);             23020000
      END; <<WHILE>>                                                    23025000
                                                                        23030000
    <<CLOSE PROGRAM FILE>>                                              23035000
    IF PROGFNUM <> 0 THEN FCLOSEDA(PROGFNUM,0,0);                       23040000
    IF PROCLOAD AND NEWSEGMAPFLAG = 1 THEN                              23045000
       BEGIN <<SEGMAPDST WAS SWITCHED DURING LOAD--UPDATE PCB>>         23050000
       ADJUSTLOCALITY(PCBPT,DOUBLE(OLDSEGMAPDST),0,1);         <<07300>>23055000
       RELDATASEG( OLDSEGMAPDST ); <<RELEASE OLD DST>>                  23060000
       SPCBMAPDST := SEGMAPDST;    <<UPDATE PCB>>                       23065000
       TOS := PCB(PCBPT+SLLIXWORDNUM);                                  23070000
       TOS := DOUBLE(SEGMAPDST);                               <<06641>>23075000
       SETSYSDB;                                                        23080000
       ADDTOLOCALITY( *, *, %400 );                                     23085000
       RESETDB( -1 );                                                   23090000
       END;                                                             23095000
                                                                        23100000
    <<* * * INSERT ANSWER IN LCT * * *>>                                23105000
                                                                        23110000
    LCTANSWER:=MFERROR;                                                 23115000
    LCTERROR:=MERROR;                                                   23120000
    LCTLISTFLAG:=LISTFLAG;                                              23125000
    LCTLMAPLDEV:=LISTADDR1.(0:8);  <<LDEV>>                             23130000
    LCTLMAPHIDA:=LISTADDR1.(8:8);  <<DISK>>                             23135000
    LCTLMAPLODA:=LISTADDR2;        <<ADDR>>                             23140000
                                                               <<*8527>>23145000
    SAVESIR := GETSIR(SEGTABSIR);                              <<*8527>>23150000
    TOS:=SEGTABDST;        <<LST>>                                      23155000
    TOS:=LCTOFFSET;        <<OFFSET TO LCT IN LST>>                     23160000
    TOS:=@LCTBUF;         <<ADDR OF LCTBUF>>                            23165000
    TOS:=LCTLENGTH;       <<TRANSFER SIZE>>                             23170000
    ASSEMBLE(MTDS 4);                                                   23175000
    RELSIR(SEGTABSIR,SAVESIR);                                 <<*8527>>23180000
                                                               <<*8527>>23185000
    IF LISTFLAG THEN FCONTROL(LISTFNUM,6,LISTFLAG);<< EOF >>            23190000
    ABSOLUTE(SYSWAITTODISPMSG).PHASETRANSFLAG := 1;            <<06094>>23195000
TOS:=LOAD'DONE'MESSAGE;                                        <<*7545>>23200000
AWAKE(WPROC,%20,0);                                            <<*7545>>23205000
SENDMSG(WPROC/PCBSIZE,4,1,%40000);                             <<*7909>>23210000
ASSEMBLE(ADDS 1);                                              <<*7545>>23215000
RECEIVEMSG(4,1,%40000);                                        <<*7909>>23220000
IF TOS<>LOAD'MESSAGE THEN                                      <<*7545>>23225000
   SUDDENDEATH(347);                                           <<*7545>>23230000
    PUSH(DL);                                                           23235000
    IF TOS <> DLSZE  THEN  DLSIZE(DLSZE);                               23240000
    GO L;  << PROCESS THE NEXT REQUEST >>                               23245000
    <<ERROR RECOVERY AND CLEANUP>>                                      23250000
NFG:                                                                    23255000
    MERROR:=TOS; <<ERROR #>>                                            23260000
RECOVER:                                                                23265000
    IF SAVESIR=-1 THEN SAVESIR:=GETSIR(SEGTABSIR);                      23270000
    REL'RESOURCES; <<RELEASE ACQUIRED RESOURCES>>                       23275000
    GO RETURNLCT; <<FINISH>>                                            23280000
    HELP;                                                               23285000
  END.                                                                  23290000
