         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$PAGE                                                          <<D1853>>00000500
       ERR103=103,  <<TOO MANY DYNAMIC LOADS ON PROCEDURE>>    <<S1744>>00560000
       ERR104=104,  <<UNABLE TO OBTAIN AN EXTRA DATA SEGMENT>> <<S1744>>00560100
$EDIT VOID=00560400                                            <<01958>>00560200
       ERR108=108,  <<I/O ERROR ON SHOWALLOCATE LIST FILE   >> <<S1744>>00560500
       ERR109=109,  <<FILE LABEL I/0 ERROR                  >> <<D1938>>00560600
       ERR1659=1659;<<THIS COMMAND REQUIRES OP CAPABILITY TO>> <<D1938>>00564000
                    <<DEALLOCATE PERMANENTLY ALLOCATED PROG >> <<D1938>>00565000
       DEFAULTDATASEG = %1110;  <<DEFAULT STACK SIZE ADDR  >>  <<.1157>>00835000
           <<** POINTER TO CSTX BLOCK TABLE NOT CSTX **    >>  <<S1744>>00850100
EQUATE MAX'CONCURRENT'PROG = 511; <<MAXIMUM NUMBER OF      >>  <<S1744>>00876000
                                  <<CONCURRENT LOADED PROGS>>  <<S1744>>00877000
EQUATE     CSTB'INDEX       = 1; <<CST BASE IN SYSGLOB      >> <<S1744>>00905100
                                                               <<S1744>>00905600
INTEGER POINTER                                                <<S1744>>00905700
           CSTBP      = CSTB'INDEX;                            <<S1744>>00905800
                        <<CST BASE PTR. IN THE SYSTEM TABLE  >><<S1744>>00905900
INTEGER ARRAY CSTX'TABLE (*) = DB + 0;                         <<S1744>>00906200
                                                               <<S1744>>00906400
<<-----------       EQUATES FOR CST ENTRY ZERO  ------------->><<S1744>>00906500
EQUATE CST'CONFIGURED = 0,  <<NUMBER CONFIGURED ENTRIES      >><<S1744>>00906600
       CST'ENTRY'LEN  = 1,  <<OFFSET INTO ENTRY 0 FOR ENTRY  >><<S1744>>00906700
                            <<LENGTH.                        >><<S1744>>00906800
       CST'FREE'OFFSET= 2,  <<NUMBER OF FREE ENTRIES         >><<S1744>>00906900
       CST'FIRST'FREE = 3;  <<DB-RELATIVE ADDR. OF 1ST FREE  >><<S1744>>00907000
                                                               <<S1744>>00907100
DEFINE DST'SEGSIZE = (3:13)#; << SIZE/4 OF THE DATA SEGMENT >> <<01958>>00907110
                                                               <<S1744>>00907120
DEFINE VMALLOCFIELD = (9:7)#;  << # OF VIRTUAL MEMORY PAGES >> <<01958>>00907123
                               << ALLOCATED TO THE SEGMENT. >> <<01958>>00907124
                                                               <<01958>>00907125
<<------------      EQUATES FOR THE ENTRY    ---------------->><<S1744>>00907130
EQUATE DST'ENTRY'SIZE = 4;   <<SIZE OF ENTRY IN DST          >><<S1744>>00907140
                                                               <<S1744>>00907150
                                                               <<01958>>00907160
EQUATE DST'FLAG'WORD = 1,    << WORD 1 OF THE DST ENTRY >>     <<01958>>00907170
       VMPAGESIZE    = 512;  << VM PAGE = 4*128 WORDS   >>     <<01958>>00907180
                                                               <<01958>>00907190
<<-----  MISCELANEOUS EQUATES FOR EXTRA DATA SEGMENTS ----->>  <<S1744>>00907200
EQUATE CSTX'DST = 4;                                           <<S1744>>00907300
$PAGE                                                          <<S1744>>00909990
INTEGER LOADER'AUX'INFO    = DB + 38;                          <<L2186>>01121000
DEFINE  LOADER'AUX'XDS     = LOADER'AUX'INFO.(1:15)#;          <<L2186>>01121100
DEFINE  SYS'AUTOALLOC'FLAG = LOADER'AUX'INFO.(0:1)#;           <<L2186>>01121200
INTEGER REFTABDST          = DB + 39;   << SL REFERENCE TABLE ><<L2186>>01122000
INTEGER CUR'NUM'LSTX'DSEGS = DB + 40;                          <<L2186>>01122100
INTEGER MAX'NUM'LSTX'DSEGS = DB + 41;                          <<L2186>>01122200
INTEGER PREV'LST           = DB + 42;   << LST DST # >>        <<L2186>>01122300
INTEGER THIS'LST           = DB + 43;   << LST DST # >>        <<L2186>>01122400
INTEGER NEXT'LST           = DB + 44;   << LST DST # >>        <<L2186>>01122500
INTEGER POINTER TEMP'EXT'ENTP  = DB + 45;                      <<L2186>>01122600
INTEGER POINTER TEMP'MAST'ENTP = DB + 46;                      <<L2186>>01122700
EQUATE LST'PRIMARY'DB'SIZE = 47;                               <<L2186>>01124000
DEFINE  IN'LST       = THIS'LST = SEGTABDST#;                  <<L2186>>01124100
       MSEARCHDOMAIN = LCTBUF.(7:1)#, <<LOADPROC SEARCH SEQ>>  <<L1608>>01186000
                                      <<LOGON/PROGRAM.     >>  <<L1608>>01187000
       INTEGER POINTER SL'INFO'AREA = SS;                      <<S1946>>01321000
                                                               <<L2186>>01366000
<< Maximum entry sizes (excluding headers): >>                 <<L2186>>01366010
<<------------------------------------------>>                 <<L2186>>01366020
                                                               <<L2186>>01366030
EQUATE                                                         <<L2186>>01366040
                                                               <<L2186>>01369500
   << ENTP thru PLABEL                                       5 <<L2186>>01369510
   << Procedure name                                         8 <<L2186>>01369520
   << word for # SL info areas                               1 <<L2186>>01369530
   << 1 system SL info area                                 35 <<L2186>>01369540
   << 2 regular SL info areas                               38 <<L2186>>01369550
   << Word for # MCST references                             1 <<L2186>>01369560
   << MCSTREF array (1 word per MCST ref)                  255 <<L2186>>01369570
   <<                                                      --- <<L2186>>01369580
   << Total                                                343 <<L2186>>01369590
   <<----------------------------------------------------------<<L2186>>01369600
                                                               <<L2186>>01369610
   EXTENSION'MAX      = 343,                                   <<L2186>>01369620
                                                               <<L2186>>01369630
   << ENTP thru MCST index table                            35 <<L2186>>01369640
   << Referenced SL array (5 entries max, 2 words/entry)    10 <<L2186>>01369650
   << word for # entries in MCST LOGSEG array                1 <<L2186>>01369660
   << Junk word                                              1 <<L2186>>01369670
   << MCST LOGSEG array (255 entries X 2 words/entry)      510 <<L2186>>01369680
   <<                                                      --- <<L2186>>01369690
   << Total                                                557 <<L2186>>01369700
   <<----------------------------------------------------------<<L2186>>01369710
                                                               <<L2186>>01369720
   LOADPROCMASTER'MAX = 557;                                   <<L2186>>01369730
                                                               <<L2186>>01369740
DEFINE HOME'LSTX    = ENTP(-6)#;                               <<L2186>>01379000
DEFINE HOME'OFFSET  = ENTP(-5)#;                               <<L2186>>01379100
DEFINE HOME'RLENGTH = ENTP(-4)#;                               <<L2186>>01379200
       EXSYS'SL=LOGICAL(ENTP.(2:1))#, <<EXTENDED SYS. SL FLAG>><<S1946>>01396000
       EXSYS'BITMAP = LOGICAL(SL'INFO'AREA.(0:1))#,            <<S1946>>01397000
                      <<EXPANDED BITMAP >>                     <<S1946>>01398000
EQUATE PERM'HEADER'LEN = 3;                                    <<L2186>>01403000
EQUATE TEMP'HEADER'LEN = 6;                                    <<L2186>>01403100
DEFINE                                                         <<L2186>>01403200
  TEMP'ENTRY=((ETYPE >= EXTENSION) LAND (THIS'LST=SEGTABDST))#;<<L2186>>01403300
DEFINE PERM'ENTRY = (NOT TEMP'ENTRY)#;                         <<L2186>>01403400
DEFINE HEADER'LEN=(IF PERM'ENTRY THEN PERM'HEADER'LEN          <<L2186>>01403500
                                 ELSE TEMP'HEADER'LEN)#;       <<L2186>>01403600
EQUATE ESLFIXED'SIZE = 6;                                      <<S1946>>01436000
       EALLOCSEG'SL= ENTP(4)#,      <<# ALLOCATED SEG IN SL>>  <<S1946>>01460000
       ESLSEG'SL   = ENTP(5)#,      <<# SEG LIST ENTRIES   >>  <<S1946>>01465000
       SLLOGSEGNR  = PTEMP2.(0:9)#, <<SL LOGICAL SEG NUMBER>>  <<S1946>>01475000
EQUATE ESLSEGLIST'ENTRY'SIZE = 3; <<SEGLIST ENTRY SIZE >>      <<S1946>>01491000
       EPAUTOALLOC = ENTP.(3:1)#, <<AUTO ALLOCATE BIT>>        <<S1946>>01516000
                                                               <<S1744>>01560100
EQUATE ESLINFO'AREA'SIZE  = 19;  <<SIZE OF SL INFO AREA    >>  <<S1946>>01561000
EQUATE EOFFSET'OF'FADDR   = 1;   <<OFFSET INTO SL INFO AREA>>  <<R1624>>01562000
                                 <<OF SL FILE ADDRESS.     >>  <<S1744>>01562100
EQUATE EXSLINFO'AREA'SIZE = 35;  <<SIZE OF EXPANDED SL INFO.>> <<S1946>>01563000
                                 <<AREA                     >> <<S1946>>01563100
EQUATE ESLBITMAP'SIZE = 16; <<SIZE OF GROUP,ACCT. SL BITMAP>>  <<S1946>>01564000
EQUATE EXSLBITMAP'SIZE = 32;  <<SIZE OF EXPANDED SL BITMAP >>  <<S1946>>01564500
EQUATE ESLSEGLIST'INDEX=22; <<DISPLACEMENT TO SEGLIST     >>   <<S1946>>01564600
                            << FOR GROUP AND ACCT SL ENTRY>>   <<S1946>>01564700
EQUATE EXSLSEGLIST'INDEX=38; <<DISPLACEMENT TO SEGLIST FOR >>  <<S1946>>01564800
                             <<SYSTEM SL ENTRY           >>    <<S1946>>01564900
                                                               <<S1744>>01564990
DEFINE E6'PROGKEY  = ENTDP1#;<<FILE DISC ADDR OF SHARER ENTRY>><<E2169>>01651000
DEFINE ESEARCHDOMAIN=ENTP.(3:1)#,  <<LOADPROC SEARCH DOMAIN>>  <<L1608>>01666000
       EEXT        = ENTP(2)#,     <<EXTENSION #           >>  <<L1608>>01670000
       ALLOC'PROC'LOG'SEG=ENTP(3).(7:9)#,  << LOG SEG # OF AN>><<S1946>>01686000
                                          <<ALLOCATE PROCEDURE><<S1946>>01687000
$PAGE                                                          <<01959>>01730001
<<-------------------------------------------------------->>   <<R1624>>01730100
<<                                                        >>   <<R1624>>01730200
<<  LOADER AUXILIARY DATA SEGEMENT                        >>   <<R1624>>01730300
<<                                                        >>   <<R1624>>01730400
<<  OVERVIEW: The loader auxiliary extra data segment is  >>   <<R1624>>01730600
<<    a multi table data segment.  Each table has a       >>   <<R1624>>01730700
<<    standard header and are linked together via a DB    >>   <<R1624>>01730800
<<    relative pointer in the header.  More tables within >>   <<R1624>>01730900
<<    the extra data segment may be added easily if needed>>   <<R1624>>01731000
<<                                                        >>   <<R1624>>01731100
<<  Loader Auxiliary extra data segment format:           >>   <<R1624>>01731200
$EDIT VOID=01737000                                            <<01959>>01731300
<<                   __________________                   >>   <<01959>>01731310
<<            --- 0 <    Table size    > --               >>   <<01959>>01731320
<<           I    1 <   Entry length   >  I               >>   <<01959>>01731330
<<           I    2 <   total # free   >  I               >>   <<01959>>01731340
<<  Table==> I    3 <     1st free     >  I ==> Table     >>   <<01959>>01731350
<<    one    I    4 <ptr. to next table>  I       header  >>   <<01959>>01731360
<<           I    5 <      unused      >  I               >>   <<01959>>01731370
<<           I    6 <      unused      >  I               >>   <<01959>>01731380
<<           I    7 <      unused      > --               >>   <<01959>>01731390
<<           I   10 <autoallocate table>                  >>   <<01959>>01731400
<<           I      <        .         >                  >>   <<01959>>01731410
<<            ---   <        .         >                  >>   <<01959>>01731420
<<                  <------------------>                  >>   <<01959>>01731430
<<  Table  -------- <   program        >                  >>   <<01959>>01731440
<<   two            <   name table     >                  >>   <<01959>>01731450
<<                  <                  >                  >>   <<01959>>01731460
<<                   ------------------                   >>   <<01959>>01731470
<<                                                        >>   <<01959>>01731480
<<  PROGRAM NAME TABLE:                                   >>   <<01959>>01731490
<<        ENTRY SIZE         ->  16                       >>   <<01959>>01731500
<<        NUMBER OF ENTRIES  ->  SIZE OF CST BLOCK TABLE  >>   <<01959>>01731510
<<                                                        >>   <<01959>>01731520
<<                   <----------------->                  >>   <<01959>>01731530
<<               0   <PROGRAM          >                  >>   <<01959>>01731540
<<               1   <         NAME    >                  >>   <<01959>>01731550
<<               2   <                 >                  >>   <<01959>>01731560
<<               3   <                 >                  >>   <<01959>>01731570
<<               4   <GROUP            >                  >>   <<01959>>01731580
<<               5   <         NAME    >                  >>   <<01959>>01731590
<<               6   <                 >                  >>   <<01959>>01731600
<<               7   <                 >                  >>   <<01959>>01731610
<<               10  < ACCOUNT         >                  >>   <<01959>>01731620
<<               11  <         NAME    >                  >>   <<01959>>01731630
<<               12  <                 >                  >>   <<01959>>01731640
<<               13  <                 >                  >>   <<01959>>01731650
<<               14  < HODA            >                  >>   <<01959>>01731660
<<               15  <       LODA      >                  >>   <<01959>>01731670
<<               16  <    UNUSED       >                  >>   <<01959>>01731680
<<               17  <    UNUSED       >                  >>   <<01959>>01731690
<<                   <----------------->                  >>   <<01959>>01731700
<<-------------------------------------------------------->>   <<01959>>01731710
                                                               <<01959>>01731720
$EDIT VOID=01731820                                            <<L2186>>01731730
                                                               <<01959>>01731830
<<========================================================>>   <<01959>>01731840
<<    LOADER AUXILIARY XDS VARIABLES AND DEFINITONS       >>   <<01959>>01731850
<<========================================================>>   <<01959>>01731860
                                                               <<01959>>01731870
INTEGER ARRAY LOADER'AUX'TABLE  (*) = DB + 0;                  <<01959>>01731880
                                                               <<01959>>01731890
EQUATE  LOADER'AUX'HEADER   = 8;  <<SIZE OF HEADER>>           <<01959>>01731900
                                                               <<01959>>01731910
<<........................................................>>   <<01959>>01731920
<<EQUATES TO ACCESS THE TABLE HEADER FROM A POINTER       >>   <<01959>>01731930
<< POINTING TO THE BASE OF THE TABLE.                     >>   <<01959>>01731940
<<........................................................>>   <<01959>>01731950
EQUATE  TABLE'SIZE   =  -8 ,                                   <<01959>>01731960
        ENTRY'LEN    =  -7 ,                                   <<01959>>01731970
        NUMB'FREE    =  -6 ,                                   <<01959>>01731980
        FIRST'FREE   =  -5 ,                                   <<01959>>01731990
        NEXT'TABLE   =  -4 ; <<POINTS TO BASE OF NEXT TABLE>>  <<01959>>01732000
                                                               <<01959>>01732010
<<      UNUSED       =  -3 ,                               >>  <<01959>>01732020
<<      UNUSED       =  -2 ,                               >>  <<01959>>01732030
<<      UNUSED       =  -1 ,                               >>  <<01959>>01732040
                                                               <<01959>>01732050
                                                               <<01959>>01732060
<<--------------------------------------------------------->>  <<01959>>01732070
<< AUTOALLOCATE RELATED VARIABLES AND DEFINITIONS          >>  <<01959>>01732080
<<                                                         >>  <<01959>>01732090
<< NOTE:  WE HAVE TAKEN ADVANTAGE OF THE FACT THAT THE     >>  <<01959>>01732100
<<        AUTOALLOCATE TABLE IS THE FIRST TABLE IN THE     >>  <<01959>>01732110
<<        LOADER AUXILIARY DATA SEGMENT.                   >>  <<01959>>01732120
<<                                                         >>  <<01959>>01732130
<< AN AUTOALLOCATED PROGRAM IS SPECIFIED BY:               >>  <<01959>>01732140
<<        ALLOCATE BIT = 1                                 >>  <<01959>>01732150
<<            (EPA IN THE LST PROGRAM ENTRY)               >>  <<01959>>01732160
<<        AUTOALLOCATE BIT = 1                             >>  <<01959>>01732170
<<            (EPAUTOALLOC IN THE LST PROGRAM ENTRY)       >>  <<01959>>01732180
<<--------------------------------------------------------->>  <<01959>>01732190
                                                               <<01959>>01732200
INTEGER ARRAY AUTOALLOC'TABLE (*) = DB + LOADER'AUX'HEADER;    <<01959>>01732210
                                                               <<01959>>01732220
INTEGER AUTOALLOC'TABSIZ   = DB + 0,  <<TABLE SIZE         >>  <<01959>>01732230
        AUTOALLOC'ENTRY'LEN= DB + 1,  <<ENTRY LENGTH       >>  <<01959>>01732240
        AUTOALLOC'FREE     = DB + 2,  <<TOTAL # FREE       >>  <<01959>>01732250
        AUTOALLOC'1ST'FREE = DB + 3;                           <<01959>>01732260
                                                               <<01959>>01732270
<<--------------------------------------------------------->>  <<01959>>01732280
<< PROGRAM NAME TABLE VARIABLES AND DEFINITIONS            >>  <<01959>>01732290
<<--------------------------------------------------------->>  <<01959>>01732300
<<#########################################################>>  <<01959>>01732310
<< PROGRAM NAME TABLE OVERVIEW                             >>  <<01959>>01732320
<<                                                         >>  <<01959>>01732330
<< This table was added as a supportability data structure.>>  <<01959>>01732340
<< It enables a person analyzing a dump to find out the    >>  <<01959>>01732350
<< names of the programs which are currently running on the>>  <<01959>>01732360
<< system.                                                 >>  <<01959>>01732370
<<                                                         >>  <<01959>>01732380
<< The table will be kept in the loader auxiliary data     >>  <<01959>>01732390
<< segment.  Each entry will be 16 words long and contain  >>  <<01959>>01732400
<< the fully qualified file name and the disc address.  The>>  <<01959>>01732410
<< table will be orginized the same as the CSTX block      >>  <<01959>>01732420
<< pointer table.                                          >>  <<01959>>01732430
<<                                                         >>  <<01959>>01732440
<< That is, all programs have a CSTX block index.  This    >>  <<01959>>01732450
<< index will be used to index into the program name table.>>  <<01959>>01732460
<< Thus the table is managed indirectly by the CSTX block  >>  <<01959>>01732470
<< table.  When a program is loaded the file name will     >>  <<01959>>01732480
<< be written to entry 0 in the procedure "LOADBIT".       >>  <<01959>>01732490
<< In the procedure "LOADPROGRAM"  of the LOAD PROCESS     >>  <<01959>>01732500
<< the file name will be moved to the entry indexed by     >>  <<01959>>01732510
<< the CSTX block index.  An entry is never removed or     >>  <<01959>>01732520
<< marked free in the program name table.  When a program  >>  <<01959>>01732530
<< is unloaded the CSTX block index is released but the    >>  <<01959>>01732540
<< entry in the program name table is left untouched.      >>  <<01959>>01732550
<<#########################################################>>  <<01959>>01732560
                                                               <<01959>>01732570
INTEGER POINTER PROGNAME'TABLE = DB + 4;                       <<01959>>01732580
                                                               <<01959>>01732590
EQUATE PCST'REMAP    = 28;      <<OFFSET TO CST REMAPPING  >>  <<11662>>01766000
DEFINE FLABEL'FOPTIONS       = FLABEL(36)#;                    <<R1624>>02066000
EQUATE FOPTIONS'TMPFILE'CODE = 2;   <<FOPTIONS DOMAIN FIELD>>  <<R1624>>02067000
                                                               <<R1624>>02068000
   OPTION FORWARD;                                             <<01957>>02170000
INTEGER PROCEDURE ALLOCATEPROG (PROGFNAME,HAS'OP);             <<D1938>>02190000
   VALUE      HAS'OP;                                          <<D1938>>02193000
   LOGICAL    HAS'OP;                                          <<D1938>>02197000
                                                               <<N2069>>02226000
INTRINSIC  DASCII;                                             <<N2069>>02227000
                                                               <<N2069>>02228000
INTEGER PROCEDURE DIRMATCH(DESIGNATOR,REALNAME);               <<S1744>>02301100
    VALUE DESIGNATOR,REALNAME;                                 <<S1744>>02301200
    BYTE POINTER DESIGNATOR,REALNAME;                          <<S1744>>02301300
    OPTION EXTERNAL,UNCALLABLE;                                <<S1744>>02301400
                                                               <<L2186>>02326000
INTEGER PROCEDURE GETDATASEGC (MEMSIZE, VDSIZE);               <<L2186>>02326100
  VALUE MEMSIZE, VDSIZE;                                       <<L2186>>02326200
  INTEGER MEMSIZE, VDSIZE;                                     <<L2186>>02326300
  OPTION EXTERNAL;                                             <<L2186>>02326400
   OPTION UNCALLABLE,FORWARD;                                  <<*2200>>02480000
INTEGER PROCEDURE DEALLOCATEPROG (PROGFNAME,HAS'OP);           <<D1938>>02520000
   VALUE      HAS'OP;                                          <<D1938>>02523000
   LOGICAL    HAS'OP;                                          <<D1938>>02527000
                                                               <<E2169>>03117000
procedure GET'PROGNAME (CSTX'BLK'INDEX, PRGNAME);              <<E2169>>03117100
   value       CSTX'BLK'INDEX;                                 <<E2169>>03117200
   integer     CSTX'BLK'INDEX;                                 <<E2169>>03117300
   byte array  PRGNAME;                                        <<E2169>>03117400
   option      forward;                                        <<E2169>>03117500
                                                               <<E2169>>03117600
PROCEDURE LCREATE'ENT (LENGTH, TYPE, PMODE, LIBRARY, KEY,      <<L2186>>03212000
                        LST'DST, LST'OFFSET);                  <<L2186>>03212100
   VALUE LENGTH,TYPE,PMODE,LIBRARY,KEY;                        <<L2186>>03212200
   INTEGER LENGTH, TYPE, PMODE, LIBRARY, LST'DST, LST'OFFSET;  <<L2186>>03212300
   DOUBLE KEY;                                                 <<L2186>>03212400
   OPTION FORWARD;                                             <<L2186>>03212500
PROCEDURE LCREATE'TEMP (LENGTH, TYPE, PMODE, LIBRARY, KEY);    <<L2186>>03215000
PROCEDURE LPURGE;                                              <<L2186>>03240000
PROCEDURE LSTEP (PROC,TABLE'LEN);                              <<S1946>>03535000
   VALUE TABLE'LEN;                                            <<S1946>>03536000
   INTEGER TABLE'LEN;                                          <<S1946>>03537000
LOGICAL PROCEDURE REQUESTSERVICE;                              <<S1744>>03671000
   OPTION EXTERNAL;                                            <<S1744>>03672000
LOGICAL PROCEDURE TEMP'FILE(DISC'ADDR);                        <<S1744>>03776100
    VALUE DISC'ADDR;                                           <<S1744>>03776200
    DOUBLE DISC'ADDR;                                          <<S1744>>03776300
    OPTION FORWARD;                                            <<S1744>>03776400
                                                               <<R1624>>03951000
PROCEDURE SETSECPTRS;                                          <<R1624>>03951100
   OPTION FORWARD,UNCALLABLE;                                  <<R1624>>03951200
                                                               <<R1624>>03951300
$PAGE                                                          <<R1624>>03951400
<<-------------------------------------------------------->>   <<R1624>>03951410
<<  This procedure is called to insert an entry into the  >>   <<R1624>>03951420
<<   LRU list of autoallocated programs which are not     >>   <<R1624>>03951430
<<   being referenced now.  (ex.  share count = 0)        >>   <<R1624>>03951440
<<                                                        >>   <<R1624>>03951450
<<  Parameters in:  The entry to insert into the          >>   <<R1624>>03951460
<<                  auto-allocate table is passed in      >>   <<R1624>>03951470
<<                  'ENTP' (DB+3) of the LST.             >>   <<R1624>>03951480
<<                                                        >>   <<R1624>>03951490
<< ****NOTE:  DB MUST BE AT THE LST (SEGTABDST) ON ENTRY  >>   <<R1624>>03951500
<<-------------------------------------------------------->>   <<R1624>>03951510
PROCEDURE ADD'AUTOALLOC'TABLE;                                 <<R1624>>03952110
  OPTION UNCALLABLE;                                           <<R1624>>03952111
                                                               <<R1624>>03952120
BEGIN                                                          <<R1624>>03952130
  INTEGER ENTRY'TO'INSERT; <<DB RELATIVE ADDR. OF THE PROG.>>  <<R1624>>03952140
                           <<ENTRY IN THE LST.             >>  <<R1624>>03952141
  INTEGER SAVEDB;                                              <<R1624>>03952150
                                                               <<R1624>>03952160
  ENTRY'TO'INSERT := @ENTP;                                    <<R1624>>03952170
  SAVEDB := EXCHANGEDB(LOADER'AUX'XDS);                        <<R1624>>03952180
                                                               <<R1624>>03952190
  AUTOALLOC'TABLE(AUTOALLOC'1ST'FREE) := ENTRY'TO'INSERT;      <<R1624>>03952200
  AUTOALLOC'1ST'FREE := AUTOALLOC'1ST'FREE + 1;                <<R1624>>03952210
  AUTOALLOC'FREE := AUTOALLOC'FREE -1;                         <<R1624>>03952220
                                                               <<R1624>>03952230
  EXCHANGEDB(SAVEDB);                                          <<R1624>>03952240
END;                                                           <<R1624>>03952250
                                                               <<R1624>>03952260
$PAGE                                                          <<R1624>>03953000
 <<-------------------------------------------------------->>  <<R1624>>03953010
 << This routine is called to remove an entry from the     >>  <<R1624>>03953020
 <<  Least Recently Used list of unused autoallocated      >>  <<R1624>>03953030
 <<  programs.  The entry to be removed is passed via the  >>  <<R1624>>03953040
 <<  'ENTP' of the LST.  A linear search is used to find   >>  <<R1624>>03953050
 <<  the entry to be deleted in the LRU list.              >>  <<R1624>>03953060
 <<                                                        >>  <<R1624>>03953070
 << If the entry passed is not found nothing is done.      >>  <<R1624>>03953071
 <<                                                        >>  <<R1624>>03953072
 << NOTE:   THIS ROUTINE ONLY REMOVES AN ENTRY FROM THE    >>  <<R1624>>03953073
 <<         AUTO-ALLOCATE TABLE.  OTHER ROUTINES ARE USED  >>  <<R1624>>03953074
 <<         TO CHECK IF THE PROGRAM NEEDS TO BE DEALLOCATED>>  <<R1624>>03953075
 <<                                                        >>  <<R1624>>03953076
 << NOTE:   DB MUST BE AT THE LST (SEGTABDST) ON ENTRY.    >>  <<R1624>>03953080
 <<-------------------------------------------------------->>  <<R1624>>03953090
PROCEDURE DELETE'AUTOALLOC'TABLE;                              <<R1624>>03953100
  OPTION UNCALLABLE;                                           <<R1624>>03953101
                                                               <<R1624>>03953110
BEGIN                                                          <<R1624>>03953120
  INTEGER ENTRY'TO'REMOVE;  <<ADDR. OF PROG. ENTRY IN LST>>    <<R1624>>03953130
  INTEGER SAVEDB,SEARCH'INDEX;                                 <<R1624>>03953140
                                                               <<R1624>>03953150
  ENTRY'TO'REMOVE := @ENTP; <<SAVE THE ADDR. OF THE PROG. >>   <<R1624>>03953160
                            <<ENTRY IN THE LST.           >>   <<R1624>>03953170
                                                               <<R1624>>03953180
$EDIT VOID=03953200                                            <<S1744>>03953190
                                                               <<R1624>>03953210
  SAVEDB := EXCHANGEDB(LOADER'AUX'XDS);                        <<R1624>>03953220
                                                               <<R1624>>03953230
  IF (AUTOALLOC'1ST'FREE > 0) THEN                             <<R1624>>03953240
    BEGIN  <<SOMETHING IN THE TABLE>>                          <<R1624>>03953250
    SEARCH'INDEX := AUTOALLOC'1ST'FREE - 1;                    <<R1624>>03953260
                    <<INITIALIZE INDEX TO SEARCH MRU -> LRU>>  <<R1624>>03953261
                                                               <<R1624>>03953270
    WHILE (SEARCH'INDEX >= 0) DO                               <<R1624>>03953280
      BEGIN              <<SEARCH TABLE UNTIL FIND ENTRY>>     <<R1624>>03953290
                                                               <<R1624>>03953300
      IF (AUTOALLOC'TABLE(SEARCH'INDEX) = ENTRY'TO'REMOVE) THEN<<R1624>>03953310
        BEGIN                                                  <<R1624>>03953320
        MOVE AUTOALLOC'TABLE(SEARCH'INDEX) :=                  <<R1624>>03953330
             AUTOALLOC'TABLE(SEARCH'INDEX + 1),                <<R1624>>03953340
             (AUTOALLOC'1ST'FREE - SEARCH'INDEX -1);           <<R1624>>03953350
                                                               <<R1624>>03953360
        AUTOALLOC'1ST'FREE := AUTOALLOC'1ST'FREE - 1;          <<R1624>>03953370
        AUTOALLOC'FREE := AUTOALLOC'FREE + 1;                  <<R1624>>03953380
        AUTOALLOC'TABLE(AUTOALLOC'1ST'FREE) := 0;              <<R1624>>03953390
        SEARCH'INDEX := 0;  << TO END THE LOOP>>               <<R1624>>03953400
        END; <<THEN FOUND ENTRY TO REMOVE>>                    <<R1624>>03953410
                                                               <<R1624>>03953420
      SEARCH'INDEX := SEARCH'INDEX -1;                         <<R1624>>03953430
      END; <<WHILE NOT DONE SEARCHING TABLE>>                  <<R1624>>03953440
    END;  <<THEN SOMETHING IN THE TABLE>>                      <<R1624>>03953450
                                                               <<R1624>>03953460
  EXCHANGEDB(SAVEDB);                                          <<R1624>>03953470
END;                                                           <<R1624>>03953480
                                                               <<R1624>>03953490
$PAGE                                                          <<R1624>>03954000
 <<-------------------------------------------------------- >> <<R1624>>03954100
 <<  Actually unloads the 'Least Recently Used' unreferenced>> <<R1624>>03954101
 <<   autoallocated program from the system because space   >> <<R1624>>03954102
 <<   is needed in a system table. (LST,CSTX,CSTXBLOCK)     >> <<R1624>>03954103
 <<                                                         >> <<R1624>>03954104
 << **NOTE:  This routine uses condition codes to indicate  >> <<R1624>>03954105
 <<          nothing was unloaded.                          >> <<R1624>>03954106
 <<-------------------------------------------------------- >> <<R1624>>03954107
PROCEDURE AUTO'DEALLOCATE;                                     <<R1624>>03954108
  OPTION UNCALLABLE;                                           <<R1624>>03954109
                                                               <<R1624>>03954110
BEGIN                                                          <<R1624>>03954120
  INTEGER LOCAL'CONDCODE;                                      <<R1624>>03954130
  INTEGER LRU'ENTRY;     <<ADDR. OF PROG. ENTRY IN LST>>       <<R1624>>03954140
  INTEGER SAVE'SEGTABSIR,SAVEDB;                               <<R1624>>03954150
                                                               <<R1624>>03954160
  SAVEDB := EXCHANGEDB(SEGTABDST); <<TO GET TO LOADER'AUX DST ><<R1624>>03954170
  EXCHANGEDB(LOADER'AUX'XDS);                                  <<R1624>>03954180
                                                               <<R1624>>03954190
  IF (AUTOALLOC'1ST'FREE > 0) THEN                             <<R1624>>03954200
    BEGIN  <<SOMETHING IS IN THE TABLE>>                       <<R1624>>03954210
    LRU'ENTRY := AUTOALLOC'TABLE(0);                           <<R1624>>03954220
                                                               <<R1624>>03954230
    MOVE AUTOALLOC'TABLE(0) := AUTOALLOC'TABLE(1),             <<R1624>>03954240
                              (AUTOALLOC'1ST'FREE - 1);        <<R1624>>03954260
    AUTOALLOC'1ST'FREE := AUTOALLOC'1ST'FREE - 1;              <<R1624>>03954270
    AUTOALLOC'TABLE(AUTOALLOC'1ST'FREE) := 0;                  <<R1624>>03954280
    AUTOALLOC'FREE := AUTOALLOC'FREE + 1;                      <<R1624>>03954290
                                                               <<R1624>>03954300
    SAVE'SEGTABSIR:=GETSIR(SEGTABSIR);                         <<R1624>>03954310
    EXCHANGEDB(SEGTABDST);                                     <<R1624>>03954320
    TOS:=@ENTP;        << AND SAVE POINTERS>>                  <<01957>>03954321
    TOS:=@ENTP1;                                               <<01957>>03954322
    TOS:=@ENTP2;                                               <<01957>>03954323
    TOS:=@ENTP3;                                               <<01957>>03954324
    @ENTP := LRU'ENTRY;                                        <<R1624>>03954330
    SETSECPTRS;             <<SET SECONDARY POINTERS IN LST  >><<R1624>>03954340
    EPA  := 0;              <<RESET ALLOCATE BIT             >><<R1624>>03954350
    EPAUTOALLOC := 0;       <<RESET AUTO'ALLOCATE BIT        >><<R1624>>03954360
    ADJREFCOUNTS(-1);       <<ACTUAL UNLOAD FROM SYSTEM      >><<R1624>>03954370
    @ENTP3:=TOS;                                               <<01957>>03954371
    @ENTP2:=TOS;            <<RESTORE PTRS TO ORIG ENTRY>>     <<01957>>03954372
    @ENTP1:=TOS;                                               <<01957>>03954373
    @ENTP:=TOS;                                                <<01957>>03954374
    RELSIR(SEGTABSIR,SAVE'SEGTABSIR);                          <<R1624>>03954380
                                                               <<R1624>>03954390
    LOCAL'CONDCODE := CCE;                                     <<R1624>>03954400
    END <<THEN>>                                               <<R1624>>03954410
    ELSE LOCAL'CONDCODE := CCG;  <<NOTHING UNLOADED >>         <<R1624>>03954420
                                                               <<R1624>>03954430
  EXCHANGEDB(SAVEDB);                                          <<R1624>>03954440
                                                               <<R1624>>03954450
  CONDCODE := LOCAL'CONDCODE;                                  <<R1624>>03954460
END;                                                           <<R1624>>03954470
$EDIT VOID=03957000                                            <<R1897>>03955000
$PAGE                                                          <<R1897>>03955010
<<--------------------------------------------------------->>  <<R1897>>03955020
<< Checks to see if the file can be unloaded due to it     >>  <<R1897>>03955030
<<  being auto-allocated and not being used.               >>  <<R1897>>03955040
<<                                                         >>  <<R1897>>03955050
<< If it is a program file:                                >>  <<R1897>>03955060
<<  If the file is not being referenced (share count = 0)  >>  <<R1897>>03955070
<<  and it is auto-allocated it will be unloaded.          >>  <<R1897>>03955080
<<                                                         >>  <<R1897>>03955090
<< If it is an SL file:                                    >>  <<R1897>>03955100
<<  All programs referencing this SL and are auto-allocated>>  <<R1897>>03955110
<<  that are not being used will be unloaded.  The SL is   >>  <<R1897>>03955120
<<  implicity unloaded when the last program referencing   >>  <<R1897>>03955130
<<  it is unloaded.                                        >>  <<R1897>>03955140
<<                                                         >>  <<R1897>>03955150
<< ....................................................... >>  <<R1897>>03955160
<< PARAMETERS IN:                                          >>  <<R1897>>03955170
<<   LDEV     - logical device where file resides          >>  <<R1897>>03955180
<<   FADDR    - logical sector address of file             >>  <<R1897>>03955190
<<   FILECODE - file type (program file or sl file)        >>  <<R1897>>03955200
<<   FLAGS    - 0 -> NEED TO GET THE LST SIR               >>  <<R1897>>03955210
<<              1 -> CALLING PROCEDURE HAS FILE INTEGRITY  >>  <<R1897>>03955220
<<                   SIR.  NEED TO RELEASE IT THEN GET THE >>  <<R1897>>03955230
<<                   LST SIR THEN THE FILE SIR TO GET THE  >>  <<R1897>>03955240
<<                   SIRS IN THE CORRECT ORDER.            >>  <<R1897>>03955250
<< NOTE:  The condition code is used to indicate if the    >>  <<R1897>>03955260
<<        file was unloaded or not.                        >>  <<R1897>>03955270
<<          CCE -> file unloaded    CCL -> not unloaded    >>  <<R1897>>03955280
<<--------------------------------------------------------->>  <<R1897>>03955290
PROCEDURE DEALLOC'IF'AUTOALLOC(LDEV,FADDR,FILECODE,FLAGS);     <<R1897>>03955300
   VALUE LDEV,FADDR,FILECODE,FLAGS;                            <<R1897>>03955310
   INTEGER LDEV,FILECODE,FLAGS;                                <<R1897>>03955320
   DOUBLE FADDR;                                               <<R1897>>03955330
   OPTION UNCALLABLE;                                          <<R1897>>03955340
                                                               <<R1897>>03955350
BEGIN                                                          <<R1897>>03955360
  INTEGER FADDRW1 = FADDR;                                     <<R1897>>03955370
  INTEGER FADDRW2 = FADDRW1 + 1;                               <<R1897>>03955380
  INTEGER SAVEDB;                                              <<R1897>>03955390
  INTEGER SAVE'SEGTABSIR:= -1;                                 <<R1897>>03955400
  INTEGER FILESYSSIR'INFO;                                     <<R1897>>03955410
  INTEGER LOCAL'CONDCODE:=CCL;                                 <<R1897>>03955420
  INTEGER NEXT'PROG'ENTRY; <<PTR. TO NEXT LINK IN LIST>>       <<R1897>>03955430
  INTEGER NUMB'SLINFO'AREA; <<NUMBER OF SL'S ASSOCIATED WITH>> <<R1897>>03955440
                            <<THIS PROGRAM ENTRY.           >> <<R1897>>03955450
  DOUBLE POINTER FADDR'IN'SLINFO;                              <<R1897>>03955460
                                                               <<R1897>>03955470
  LOGICAL CAN'UNLOAD'PROG;                                     <<R1897>>03955480
  INTEGER SAVE'ENTP,SAVE'ENTP1,SAVE'ENTP2,SAVE'ENTP3;          <<S1909>>03955481
                                                               <<R1897>>03955490
  FADDRW1.(0:8) := LDEV;    <<BUILD THE KEY FOR FINDING THE >> <<R1897>>03955500
                            <<ENTRY IN THE LST.             >> <<R1897>>03955510
  SAVEDB := EXCHANGEDB(SEGTABDST);                             <<R1897>>03955520
                                                               <<R1897>>03955530
  IF (SYS'AUTOALLOC'FLAG=1) THEN                               <<R1897>>03955540
  BEGIN                                                        <<R1897>>03955550
  IF (FILECODE  = PROGFILECODE) THEN                           <<R1897>>03955560
    BEGIN                                                      <<R1897>>03955570
    PDISABLE;                                                  <<R1897>>03955580
    SAVE'ENTP:=@ENTP;                                          <<S1909>>03955581
    SAVE'ENTP1:=@ENTP1;                                        <<S1909>>03955582
    SAVE'ENTP2:=@ENTP2;                                        <<S1909>>03955583
    SAVE'ENTP3:=@ENTP3;                                        <<S1909>>03955584
    IF LSEARCH(FADDR,NORMAL,PROGFILE) AND (EPAUTOALLOC = 1)    <<S1909>>03955590
       AND (ESHR = 0)                                          <<S1909>>03955600
      THEN CAN'UNLOAD'PROG := TRUE                             <<S1909>>03955610
      ELSE CAN'UNLOAD'PROG := FALSE;                           <<S1909>>03955611
    @ENTP:=SAVE'ENTP;                                          <<S1909>>03955617
    @ENTP1:=SAVE'ENTP1;                                        <<S1909>>03955618
    @ENTP2:=SAVE'ENTP2;                                        <<S1909>>03955620
    @ENTP3:=SAVE'ENTP3;                                        <<S1909>>03955621
    PENABLE;                                                   <<R1897>>03955622
                                                               <<R1897>>03955623
    IF CAN'UNLOAD'PROG THEN                                    <<R1897>>03955624
      BEGIN                                                    <<R1897>>03955625
      IF (FLAGS = 1) THEN                                      <<R1897>>03955626
        BEGIN                                                  <<R1897>>03955627
        RELSIR(FILESYSSIR,1);                                  <<R1897>>03955628
        SAVE'SEGTABSIR:=GETSIR(SEGTABSIR);                     <<R1897>>03955629
        FILESYSSIR'INFO:=GETSIR(FILESYSSIR);                   <<R1897>>03955630
        END                                                    <<R1897>>03955631
      ELSE                                                     <<R1897>>03955632
        SAVE'SEGTABSIR := GETSIR(SEGTABSIR);                   <<R1897>>03955633
                                                               <<R1897>>03955634
                                                               <<R1897>>03955635
      IF LSEARCH(FADDR,NORMAL,PROGFILE) AND (ESHR = 0) THEN    <<R1897>>03955636
        BEGIN       <<RESET PTRS. IN LST>>                     <<R1897>>03955637
                                                               <<R1897>>03955638
        EPA:=0;           <<RESET ALLOCATE BIT>>               <<R1897>>03955639
        EPAUTOALLOC:=0;   <<RESET AUTOALLOCATE BIT>>           <<R1897>>03955640
        DELETE'AUTOALLOC'TABLE;                                <<R1897>>03955641
        SETSECPTRS;             <<SET SECONDARY LST POINTERS >><<R1897>>03955642
        ADJREFCOUNTS(-1);           <<UNLOAD THE FILE        >><<R1897>>03955643
        LOCAL'CONDCODE := CCE;      <<UNLOADED THE FILE      >><<R1897>>03955644
        END  <<THEN ESHR = 0>>                                 <<R1897>>03955645
      ELSE LOCAL'CONDCODE := CCL; <<PROG. IS CURRENTLY     >>  <<R1897>>03955646
                                                               <<R1897>>03955647
      IF SAVE'SEGTABSIR <> -1                                  <<R1897>>03955648
        THEN RELSIR(SEGTABSIR,SAVE'SEGTABSIR);                 <<R1897>>03955649
                                                               <<R1897>>03955650
      END; <<CAN'UNLOAD'PROG>>                                 <<R1897>>03955651
    END <<THEN PROGRAM FILE>>                                  <<R1897>>03955652
                                                               <<R1897>>03955653
                                                               <<R1897>>03955654
 <<-------------------------------------------------------->>  <<R1897>>03955655
 <<ASSUME SL FILE.  THEREFORE SEARCH THROUGH ALL INACTIVE  >>  <<R1897>>03955920
 <<AUTOALLOCATED PROGRAMS AND UNLOAD ANY WHICH ARE         >>  <<R1897>>03955930
 <<REFERENCING THE SPECIFIED SL.                           >>  <<R1897>>03955940
 <<-------------------------------------------------------->>  <<R1897>>03955950
   ELSE                                                        <<R1897>>03955960
     BEGIN                                                     <<R1897>>03955970
     IF (FLAGS = 1) THEN                                       <<R1897>>03955980
       BEGIN                                                   <<R1897>>03955990
       RELSIR(FILESYSSIR,1);                                   <<R1897>>03956000
       SAVE'SEGTABSIR:=GETSIR(SEGTABSIR);                      <<R1897>>03956010
       FILESYSSIR'INFO:=GETSIR(FILESYSSIR);                    <<R1897>>03956020
       END                                                     <<R1897>>03956030
     ELSE                                                      <<R1897>>03956040
       SAVE'SEGTABSIR:=GETSIR(SEGTABSIR);                      <<R1897>>03956050
                                                               <<R1897>>03956060
                                                               <<R1897>>03956070
     @ENTP := HDFWDLINK(PROGFILE); <<GET HEAD OF LINK LIST>>   <<R1897>>03956080
                                                               <<R1897>>03956090
     WHILE (@ENTP <> 0) DO                                     <<R1897>>03956100
       BEGIN                                                   <<R1897>>03956110
       NEXT'PROG'ENTRY := FWDLINK;                             <<R1897>>03956120
       IF (ESHR = 0) AND (EPAUTOALLOC=1) THEN                  <<R1897>>03956130
       <<# PROCESSES USING IS ZERO AND IT IS AUTOALLOCTED>>    <<R1897>>03956140
                                                               <<R1897>>03956150
         BEGIN                                                 <<R1897>>03956160
         SETSECPTRS;      <<SET SECONDARY LST POINTERS>>       <<R1897>>03956170
         NUMB'SLINFO'AREA := ESLINFO'PROG;                     <<R1897>>03956180
           <<GET ADDRESS OF SL AREA IN PROG. ENTRY OF LST>>    <<S1946>>03956181
         @SL'INFO'AREA:=@ENTP2;                                <<S1946>>03956183
                                                               <<R1897>>03956190
     <<CHECK EACH SLINFO AREA IN THIS PROGRAM ENTRY>>          <<R1897>>03956200
     <<TO SEE IF IT REFERENCES THE SPECIFIED SL.   >>          <<R1897>>03956210
         WHILE (NUMB'SLINFO'AREA > 0) DO                       <<R1897>>03956220
           BEGIN                                               <<R1897>>03956230
           <<GET ADDRESS OF SL AREA IN PROG. ENTRY OF LST>>    <<R1897>>03956240
           << SL'INFO'AREA POINTS TO SLINFO AREA.       >>     <<S1946>>03956250
                                                               <<R1897>>03956260
           @FADDR'IN'SLINFO:=@SL'INFO'AREA+EOFFSET'OF'FADDR;   <<S1946>>03956270
           @SL'INFO'AREA:=@SL'INFO'AREA +                      <<S1946>>03956280
               (IF EXSYS'BITMAP THEN EXSLINFO'AREA'SIZE        <<S1946>>03956281
                ELSE ESLINFO'AREA'SIZE);                       <<S1946>>03956282
                                                               <<R1897>>03956290
           IF (FADDR'IN'SLINFO = FADDR) THEN                   <<R1897>>03956300
             BEGIN                                             <<R1897>>03956310
             NUMB'SLINFO'AREA := 0; <<TO END THE LOOP        >><<R1897>>03956320
             EPA := 0;              <<RESET ALLOCATE BIT     >><<R1897>>03956330
             EPAUTOALLOC := 0;      <<RESET AUTOALLOCATE BIT >><<R1897>>03956340
             DELETE'AUTOALLOC'TABLE;                           <<R1897>>03956350
             ADJREFCOUNTS(-1);      <<UNLOAD THIS PROG. FILE >><<R1897>>03956360
             END;<<THEN FOUND REFERENCE TO SPECIFIED SL      >><<R1897>>03956370
           NUMB'SLINFO'AREA := NUMB'SLINFO'AREA -1;            <<R1897>>03956380
           END; <<WHILE NUMB'SLINFO'AREA > 0>>                 <<R1897>>03956390
         END; <<THEN ESHR = 0>>                                <<R1897>>03956400
         @ENTP := NEXT'PROG'ENTRY;                             <<R1897>>03956410
       END; <<WHILE>>                                          <<R1897>>03956420
                                                               <<R1897>>03956421
                                                               <<R1897>>03956440
     <<CHECK TO SEE IF THE SL FILE WAS IMPLICITLY UNLOADED>>   <<R1897>>03956450
     IF LSEARCH(FADDR,NORMAL,SLFILE)                           <<R1897>>03956460
       THEN LOCAL'CONDCODE := CCL    <<FILE STILL LOADED>>     <<R1897>>03956470
     ELSE LOCAL'CONDCODE := CCE;   <<FILE WAS UNLOADED>>     ! <<R1897>>03956480
     IF SAVE'SEGTABSIR <> -1                                   <<R1897>>03956481
       THEN RELSIR(SEGTABSIR,SAVE'SEGTABSIR);                  <<R1897>>03956482
     END; <<ELSE ASSUME SL FILE >>                             <<R1897>>03956490
  END; <<SYS'AUTOALLOC'FLAG=1>>                                <<R1897>>03956500
  EXCHANGEDB(SAVEDB);                                          <<R1897>>03956510
  CONDCODE := LOCAL'CONDCODE;                                  <<R1897>>03956520
END; <<DEALLOC'IF'AUTOALLOC>>                                  <<R1897>>03956530
$PAGE                                                          <<R1897>>03957000
<<------------------------------------------------------->>    <<R1897>>03957010
<<  SETS THE SYSTEM WIDE AUTO ALLOCATE BIT, MSB WORD 38, >>    <<R1897>>03957020
<<  IN THE LST.                                          >>    <<R1897>>03957030
<<------------------------------------------------------->>    <<R1897>>03957040
PROCEDURE AUTOALLOC'ON;                                        <<R1897>>03957050
  OPTION UNCALLABLE;                                           <<R1897>>03957060
                                                               <<R1897>>03957070
BEGIN                                                          <<R1897>>03957080
  INTEGER SAVEDB;                                              <<R1897>>03957090
                                                               <<R1897>>03957100
  SAVEDB := EXCHANGEDB(SEGTABDST);                             <<R1897>>03957110
  IF (LOADER'AUX'XDS <> 0)                                     <<R1897>>03957120
    THEN SYS'AUTOALLOC'FLAG:= 1;                               <<R1897>>03957130
  EXCHANGEDB(SAVEDB);                                          <<R1897>>03957140
                                                               <<R1897>>03957150
END; <<AUTOALLOC'ON>>                                          <<R1897>>03957160
$PAGE                                                          <<R1624>>03959000
<<------------------------------------------------->>          <<R1624>>03959010
<<  RESETS THE SYSTEM WIDE AUTO ALLOCATE BIT       >>          <<R1624>>03959020
<<  MSB WORD 38 OF THE LST.  ALSO RESETS THE       >>          <<R1624>>03959030
<<  AUTO-ALLOCATE BITS IN ALL THE PROGRAM ENTRIES  >>          <<R1624>>03959040
<<  OF THE LST.  ANY PROGRAM WHICH IS NOT BEING    >>          <<R1624>>03959050
<<  REFERENCED IS ALSO UNLOADED.                   >>          <<R1624>>03959060
<<------------------------------------------------->>          <<R1624>>03959070
PROCEDURE AUTOALLOC'OFF;                                       <<R1624>>03959080
  OPTION UNCALLABLE;                                           <<R1624>>03959081
                                                               <<R1624>>03959082
BEGIN                                                          <<R1624>>03959090
  INTEGER SAVEDB,SAVE'SEGTABSIR;                               <<R1624>>03959100
  INTEGER NEXT'PROG'ENTRY;   <<NEXT PROG. ENTRY IN THE LST.>>  <<R1624>>03959110
  INTEGER NUMB'AUTOALLOC'PROG;   <<NUMBER OF ENTRIES IN THE>>  <<R1624>>03959120
                                 <<AUTOALLOCATE TABLE.     >>  <<R1624>>03959130
                                                               <<R1624>>03959140
  SAVE'SEGTABSIR := GETSIR(SEGTABSIR);                         <<R1624>>03959150
  SAVEDB := EXCHANGEDB(SEGTABDST);                             <<R1624>>03959160
  SYS'AUTOALLOC'FLAG := 0;                                     <<R1624>>03959170
                                                               <<R1624>>03959180
  @ENTP := HDFWDLINK(2);  <<HEAD POINTER OF PROG. ENTRIES>>    <<R1624>>03959190
                                                               <<R1624>>03959200
<<------------------------------------------------->>          <<R1624>>03959210
<< CHECK ALL PROGRAM ENTRIES IN THE LST.  RESET ALL>>          <<R1624>>03959220
<< AUTOALLOCATE FLAGS AND UNLOAD THE PROGRAM IF    >>          <<R1624>>03959230
<< NOBODY IS USING IT.                             >>          <<R1624>>03959240
<<------------------------------------------------->>          <<R1624>>03959250
  WHILE (@ENTP <> 0) DO                                        <<R1624>>03959260
    BEGIN                                                      <<R1624>>03959270
    NEXT'PROG'ENTRY := FWDLINK;     <<SAVE PTR. TO NEXT ENTRY>><<R1624>>03959280
    IF EPAUTOALLOC = 1 THEN                                    <<R1624>>03959290
      BEGIN       <<FILE IS AUTOALLOCATED. MUST DEALLOCATE IT>><<R1624>>03959300
      EPAUTOALLOC := 0;                                        <<R1624>>03959310
      EPA  := 0;                                               <<R1624>>03959320
      IF ESHR = 0 THEN     <<# PROCESSES SHARING = 0>>         <<R1624>>03959330
        BEGIN                 <<NO ONE USING IT SO UNLOAD IT.>><<R1624>>03959340
        SETSECPTRS;           <<SET SECONDARY POINTERS IN LST>><<R1624>>03959350
        ADJREFCOUNTS (-1);         <<ACTUALLY UNLOAD THE FILE>><<R1624>>03959360
        END; <<THEN ESHR = 0>>                                 <<R1624>>03959370
      END; <<THEN EPAUTOALLOC = 1>>                            <<R1624>>03959380
     @ENTP := NEXT'PROG'ENTRY;                                 <<R1624>>03959390
     END; <<WHILE @ENTP <> 0>>                                 <<R1624>>03959400
                                                               <<R1624>>03959410
<< ZERO OUT THE AUTOALLOCATE XDS>>                             <<R1624>>03959420
  EXCHANGEDB(LOADER'AUX'XDS);                                  <<R1624>>03959430
  NUMB'AUTOALLOC'PROG := AUTOALLOC'1ST'FREE - 1;               <<R1624>>03959440
  MOVE AUTOALLOC'TABLE(0) := 0;                                <<R1624>>03959460
  MOVE AUTOALLOC'TABLE(1) := AUTOALLOC'TABLE(0),               <<R1624>>03959470
                             (NUMB'AUTOALLOC'PROG);            <<R1624>>03959490
  AUTOALLOC'FREE := AUTOALLOC'TABSIZ;                          <<R1624>>03959500
  AUTOALLOC'1ST'FREE := 0;                                     <<R1624>>03959520
  EXCHANGEDB(SAVEDB);                                          <<R1624>>03959530
  RELSIR(SEGTABSIR,SAVE'SEGTABSIR);                            <<R1624>>03959540
END; <<AUTOALLOC'OFF>>                                         <<R1624>>03959550
                                                               <<R1624>>03959560
                                                               <<R1624>>03959570
$page                                                          <<D1853>>03959990
<<*****************************************************>>      <<D1853>>03960000
<< AUTODEALLOC'BY'NAME    1/23/86                      >>      <<D1853>>03960010
<<                                                     >>      <<D1853>>03960020
<< PURPOSE:                                            >>      <<D1853>>03960030
<<   Given a fileset this routine will search the LST  >>      <<D1853>>03960040
<<   and find any file name.group.account which matches>>      <<D1853>>03960050
<<   and is autoallocated and the share count is 0.    >>      <<D1853>>03960060
<<   Ounce a match satisfying the above conditions has >>      <<D1853>>03960070
<<   been found the file is unloaded from the system.  >>      <<D1853>>03960080
<<                                                     >>      <<D1853>>03960090
<<   Note: The only way the loader can find out the    >>      <<D1853>>03960100
<<         file name is to get the file label and see  >>      <<D1853>>03960110
<<         if the name in there matches the fileset    >>      <<D1853>>03960120
<<         specified.  Therefore, there is quite a bit >>      <<D1853>>03960130
<<         of I/O involved in this routine.            >>      <<D1853>>03960140
<<                                                     >>      <<D1853>>03960150
<<                                                     >>      <<D1853>>03960160
<< PARAMETERS IN:                                      >>      <<D1853>>03960170
<<   FILESET - 24 character byte array containing the  >>      <<D1853>>03960180
<<             fully qualified file name in the        >>      <<D1853>>03960190
<<             following format:                       >>      <<D1853>>03960200
<<                                                     >>      <<D1853>>03960210
<<                012345670123456701234567             >>      <<D1853>>03960220
<<                FILE    GROUP   ACCOUNT              >>      <<D1853>>03960230
<<                                                     >>      <<D1853>>03960240
<<             Wild cards may be specified as described>>      <<D1853>>03960250
<<             by the "DIRMATCH" routine.  Basically   >>      <<D1853>>03960260
<<               "@?" is not allowed "?@" is instead   >>      <<D1853>>03960270
<<                "@@@" must be condensed to "@".      >>      <<D1853>>03960280
<<*****************************************************>>      <<D1853>>03960290
<<                                                     >>      <<E2169>>03960295
<< LOADER PERFORMANCE ENHANCEMENTS:     4/23/86        >>      <<E2169>>03960296
<< ===============================                     >>      <<E2169>>03960297
<<                                                     >>      <<E2169>>03960298
<< The loader will NO longer need to get to the file   >>      <<E2169>>03960299
<< label to obtain the file name.  Instead, it now     >>      <<E2169>>03960300
<< accesses the PROGRAM NAME table in the LOADER AUX   >>      <<E2169>>03960301
<< XDS to obtain the file name.  As a result, many     >>      <<E2169>>03960302
<< physical I/O's will be saved with this new access   >>      <<E2169>>03960303
<< implementation.                                     >>      <<E2169>>03960304
<<                                                     >>      <<E2169>>03960305
<<*****************************************************>>      <<E2169>>03960306
                                                               <<E2169>>03960307
PROCEDURE AUTODEALLOC'BY'NAME(FILESET);                        <<D1853>>03960310
  BYTE ARRAY FILESET;                                          <<D1853>>03960320
  OPTION UNCALLABLE;                                           <<D1853>>03960330
                                                               <<D1853>>03960340
BEGIN                                                          <<D1853>>03960350
                                                               <<D1853>>03960360
                                                               <<E2169>>03960370
                                                               <<E2169>>03960380
                                                               <<E2169>>03960390
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>03960400
<<              LOCAL PROCEDURE DECLARATION                  >><<E2169>>03960401
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>03960410
                                                               <<E2169>>03960420
                                                               <<E2169>>03960430
INTEGER     SAVEDB,                                            <<E2169>>03960440
            SAVE'ECSTBLK,                                      <<E2169>>03960450
            SAVE'SEGTABSIR,                                    <<E2169>>03960460
            NEXT'ENTRY'ADDR;                                   <<E2169>>03960470
                                                               <<E2169>>03960480
BYTE ARRAY  PROGNAME(0:23) = Q;                                <<E2169>>03960490
                                                               <<E2169>>03960500
EQUATE      FNAME=0,       << INDEX INTO THE PROGRAM NAME   >> <<E2169>>03960510
            GROUP=8,       << ARRAY FOR THE PROGRAM NAME,   >> <<E2169>>03960520
            ACCT =16;      << GROUP, AND ACCOUNT.           >> <<E2169>>03960530
                                                               <<E2169>>03960540
                                                               <<D1853>>03960550
                                                               <<D1853>>03960560
                                                               <<D1853>>03960570
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<D1853>>03960580
<<                 START OF PROCEDURE BODY                   >><<D1853>>03960590
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<D1853>>03960600
                                                               <<D1853>>03960610
SAVE'SEGTABSIR := GETSIR(SEGTABSIR);     <<GET THE LST SIR>>   <<D1853>>03960620
                                                               <<D1853>>03960630
SAVEDB:=EXCHANGEDB(SEGTABDST);                                 <<D1853>>03960640
@ENTP:=HDFWDLINK(PROGFILE);  <<GET HEAD OF PROGRAM LINK LIST>> <<D1853>>03960650
                                                               <<D1853>>03960660
WHILE (@ENTP<>0)  DO                                           <<D1853>>03960670
  BEGIN                                                        <<D1853>>03960680
  NEXT'ENTRY'ADDR:=FWDLINK;  <<SAVE THE POINTER TO THE NEXT>>  <<D1853>>03960690
                             << ENTRY IN THE LST.          >>  <<D1853>>03960700
                                                               <<D1853>>03960710
 <<-------------------------------------------------------->>  <<D1853>>03960720
 << IF:   THE SHARE COUNT IS 0  (NOBODY USING THE PROGRAM) >>  <<D1853>>03960730
 <<       AND IT IS AUTOALLOCATED                          >>  <<D1853>>03960740
 <<                                                        >>  <<D1853>>03960750
 <<       THEN CHECK TO SEE IF IT RESIDES IN THE GROUP     >>  <<D1853>>03960760
 <<            OR ACCOUNT WHICH IS BEING DELETED.          >>  <<D1853>>03960770
 <<-------------------------------------------------------->>  <<D1853>>03960780
  IF (ESHR=0) AND (EPAUTOALLOC=1) THEN                         <<D1853>>03960790
    BEGIN                                                      <<D1853>>03960800
$edit void=03961330                                            <<E2169>>03960810
                                                               <<E2169>>03960820
    SETSECPTRS;  << SET THE SECONDARY POINTERS FOR THE >>      <<E2169>>03960830
                 << CURRENT PROGRAM ENTRY IN THE LST   >>      <<E2169>>03960840
    SAVE'ECSTBLK := ECSTBLK;<< SAVE CSTX BLOCK INDEX OF PROG >><<E2169>>03960850
    EXCHANGEDB(0);                                             <<E2169>>03960860
                                                               <<E2169>>03960870
    GET'PROGNAME (SAVE'ECSTBLK, PROGNAME);                     <<E2169>>03960880
                                                               <<E2169>>03960890
    << CHECK THE FILE NAME (IN THE PROGNAME ARRAY) WITH  >>    <<E2169>>03960900
    << THE FILE SET SPECIFIED TO DELETE TO SEE IF IT     >>    <<E2169>>03960910
    << SHOULD BE UNLOADED.                               >>    <<E2169>>03960920
                                                               <<E2169>>03960930
    IF (DIRMATCH (FILESET(FNAME),PROGNAME(FNAME)) = 0)  AND    <<E2169>>03960940
       (DIRMATCH (FILESET(GROUP),PROGNAME(GROUP)) = 0)  AND    <<E2169>>03960950
       (DIRMATCH (FILESET(ACCT), PROGNAME(ACCT) ) = 0)  THEN   <<E2169>>03960960
      BEGIN                                                    <<E2169>>03960970
        EXCHANGEDB(SEGTABDST);                                 <<E2169>>03960980
                                                               <<E2169>>03960990
        EPA := 0;            << RESET THE ALLOCATE BIT     >>  <<E2169>>03961000
        EPAUTOALLOC := 0;    << RESET THE AUTOALLOCATE BIT >>  <<E2169>>03961010
        DELETE'AUTOALLOC'TABLE;                                <<E2169>>03961020
                                                               <<E2169>>03961030
        << ACTUALLY UNLOAD THE PROGRAM.  THAT IS, DECREMENT  >><<E2169>>03961040
        << THE REFERENCE COUNTS IN ALL THE ASSOCIATED SEGMTS >><<E2169>>03961050
        << AND RELEASE THE CST, CSTX, LSTT, AND RELATED      >><<E2169>>03961060
        << TABLES ENTRIES FOR THIS PROGRAM.                  >><<E2169>>03961070
                                                               <<E2169>>03961080
        ADJREFCOUNTS(-1);     << REALLY UNLOAD THE PROGRAM   >><<E2169>>03961090
      END  << END OF IF DIRMATCH >>                            <<E2169>>03961100
     ELSE                                                      <<E2169>>03961110
        EXCHANGEDB(SEGTABDST);  << END OF ELSE DIRMATCH >>     <<E2169>>03961120
                                                               <<E2169>>03961130
    END;  << END OF IF (ESHR=0) AND (EPAUTOALLOC=1) THEN >>    <<E2169>>03961140
                                                               <<E2169>>03961150
  @ENTP := NEXT'ENTRY'ADDR;  << CURRENT POINTER GETS THE >>    <<E2169>>03961160
                             << NEXT ENTRY IN THE LST   >>     <<E2169>>03961170
                                                               <<E2169>>03961180
  END;  << END OF WHILE (@ENTP <> 0) >>                        <<E2169>>03961190
                                                               <<D1853>>03961340
RELSIR(SEGTABSIR,SAVE'SEGTABSIR);                              <<D1853>>03961350
EXCHANGEDB(SAVEDB);                                            <<D1853>>03961360
END; <<ADEALLOC'BY'GRPACCT>>                                   <<D1853>>03961370
$PAGE                                                          <<R1897>>03962000
LOGICAL PROCEDURE AUTOALLOCATE'IS'ON;                          <<R1897>>03962010
  OPTION  UNCALLABLE;                                          <<02202>>03962011
BEGIN                                                          <<R1897>>03962020
  INTEGER SAVEDB;                                              <<R1897>>03962030
                                                               <<R1897>>03962040
  SAVEDB:=EXCHANGEDB(SEGTABDST);                               <<R1897>>03962050
                                                               <<R1897>>03962060
  IF SYS'AUTOALLOC'FLAG = 1                                    <<R1897>>03962070
     THEN AUTOALLOCATE'IS'ON:=TRUE                             <<R1897>>03962080
     ELSE AUTOALLOCATE'IS'ON:=FALSE;                           <<R1897>>03962090
                                                               <<R1897>>03962100
  EXCHANGEDB(SAVEDB);                                          <<R1897>>03962110
END; <<AUTOALLOCATE'IS'ON>>                                    <<R1897>>03962120
$PAGE                                                          <<D1853>>03964990
   OPTION UNCALLABLE;                                          <<*2200>>04085000
$PAGE                                                          <<L2186>>04124000
$PAGE                                                          <<L2186>>04299000
$PAGE                                                          <<L2186>>04476000
PROCEDURE LINK'LSTX (NEW'LSTX);                                <<L2186>>04476010
                                                               <<L2186>>04476020
   VALUE NEW'LSTX;                                             <<L2186>>04476030
   INTEGER NEW'LSTX;                                           <<L2186>>04476040
                                                               <<L2186>>04476050
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>04476060
                                                               <<L2186>>04476070
<<-------------------------------------------------------------<<L2186>>04476080
<<                                                             <<L2186>>04476090
<<  Links a new LSTX data segment after the current LST/LSTX   <<L2186>>04476100
<<  data segment.  If this is the first LSTX data segment,     <<L2186>>04476110
<<  then it will be linked to SYSGLOB %226.                    <<L2186>>04476120
<<                                                             <<L2186>>04476130
<<  INPUT PARAMETERS:                                          <<L2186>>04476140
<<                                                             <<L2186>>04476150
<<     NEW'LSTX - The DST number of the new LSTX data segment. <<L2186>>04476160
<<                                                             <<L2186>>04476170
<<-------------------------------------------------------------<<L2186>>04476180
                                                               <<L2186>>04476190
BEGIN  << LINK'LSTX >>                                         <<L2186>>04476200
                                                               <<L2186>>04476210
INTEGER SAVE'THIS'LST;                                         <<L2186>>04476220
INTEGER SAVE'NEXT'LST;                                         <<L2186>>04476230
                                                               <<L2186>>04476240
   << Arm LSTX SYSGLOB cell if linking after LST. >>           <<L2186>>04476250
   <<--------------------------------------------->>           <<L2186>>04476260
                                                               <<L2186>>04476270
   IF IN'LST THEN                                              <<L2186>>04476280
      SEGTABDST'EX  := NEW'LSTX;                               <<L2186>>04476290
                                                               <<L2186>>04476300
   << Link new LSTX data segment after current one. >>         <<L2186>>04476310
   <<----------------------------------------------->>         <<L2186>>04476320
                                                               <<L2186>>04476330
   SAVE'THIS'LST := THIS'LST;                                  <<L2186>>04476340
   SAVE'NEXT'LST := NEXT'LST;                                  <<L2186>>04476350
                                                               <<L2186>>04476360
   NEXT'LST := NEW'LSTX;                                       <<L2186>>04476370
                                                               <<L2186>>04476380
   EXCHANGEDB (NEW'LSTX);                                      <<L2186>>04476390
   PREV'LST := SAVE'THIS'LST;                                  <<L2186>>04476400
   THIS'LST := NEW'LSTX;                                       <<L2186>>04476410
   NEXT'LST := SAVE'NEXT'LST;                                  <<L2186>>04476420
                                                               <<L2186>>04476430
   IF SAVE'NEXT'LST <> 0 THEN                                  <<L2186>>04476440
      BEGIN                                                    <<L2186>>04476450
      EXCHANGEDB (SAVE'NEXT'LST);                              <<L2186>>04476460
      PREV'LST := NEW'LSTX;                                    <<L2186>>04476470
      END;                                                     <<L2186>>04476480
                                                               <<L2186>>04476490
   EXCHANGEDB (SAVE'THIS'LST);                                 <<L2186>>04476500
                                                               <<L2186>>04476510
END;  << LINK'LSTX >>                                          <<L2186>>04476520
$PAGE                                                          <<L2186>>04476530
PROCEDURE UNLINK'LSTX;                                         <<L2186>>04476540
                                                               <<L2186>>04476550
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>04476560
                                                               <<L2186>>04476570
<<-------------------------------------------------------------<<L2186>>04476580
<<                                                             <<L2186>>04476590
<<  Unlinks the current LSTX data segment from the LSTX chain. <<L2186>>04476600
<<  Note:  It is the caller's responsibility to verify that    <<L2186>>04476610
<<         this is not the last LSTX data segment!  The loader <<L2186>>04476620
<<         won't work without at least 1.                      <<L2186>>04476630
<<                                                             <<L2186>>04476640
<<-------------------------------------------------------------<<L2186>>04476650
                                                               <<L2186>>04476660
BEGIN  << UNLINK'LSTX >>                                       <<L2186>>04476670
                                                               <<L2186>>04476680
INTEGER SAVE'PREV'LST;                                         <<L2186>>04476690
INTEGER SAVE'THIS'LST;                                         <<L2186>>04476700
INTEGER SAVE'NEXT'LST;                                         <<L2186>>04476710
                                                               <<L2186>>04476720
   SAVE'PREV'LST := PREV'LST;                                  <<L2186>>04476730
   SAVE'THIS'LST := THIS'LST;                                  <<L2186>>04476740
   SAVE'NEXT'LST := NEXT'LST;                                  <<L2186>>04476750
                                                               <<L2186>>04476760
   << Adjust SYSGLOB cell if this is first LSTX. >>            <<L2186>>04476770
   <<-------------------------------------------->>            <<L2186>>04476780
                                                               <<L2186>>04476790
   IF THIS'LST = SEGTABDST'EX THEN                             <<L2186>>04476800
      SEGTABDST'EX := NEXT'LST;                                <<L2186>>04476810
                                                               <<L2186>>04476820
   << Remove current LSTX from chain. >>                       <<L2186>>04476830
   <<--------------------------------->>                       <<L2186>>04476840
                                                               <<L2186>>04476850
   EXCHANGEDB (SAVE'PREV'LST);                                 <<L2186>>04476860
   NEXT'LST := SAVE'NEXT'LST;                                  <<L2186>>04476870
                                                               <<L2186>>04476880
   IF SAVE'NEXT'LST <> 0 THEN                                  <<L2186>>04476890
      BEGIN                                                    <<L2186>>04476900
      EXCHANGEDB (SAVE'NEXT'LST);                              <<L2186>>04476910
      PREV'LST := SAVE'PREV'LST;                               <<L2186>>04476920
      END;                                                     <<L2186>>04476930
                                                               <<L2186>>04476940
   EXCHANGEDB (SAVE'THIS'LST);                                 <<L2186>>04476950
                                                               <<L2186>>04476960
END;  << UNLINK'LSTX >>                                        <<L2186>>04476970
$PAGE                                                          <<L2186>>04476980
PROCEDURE CREATE'LSTX;                                         <<L2186>>04476990
                                                               <<L2186>>04477000
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>04477010
                                                               <<L2186>>04477020
<<-------------------------------------------------------------<<L2186>>04477030
<<                                                             <<L2186>>04477040
<<  Creates and initializes a new LSTX data segment, then      <<L2186>>04477050
<<  links it after the current LST/LSTX data segment.          <<L2186>>04477060
<<                                                             <<L2186>>04477070
<<  Space in the LSTX is allocated for :                       <<L2186>>04477080
<<     - The Primary DB area;                                  <<L2186>>04477090
<<     - The SBUF (which is used to store search names when    <<L2186>>04477100
<<       scanning LSTX entries);                               <<L2186>>04477110
<<     - The LSTX Directory.                                   <<L2186>>04477120
<<                                                             <<L2186>>04477130
<<  CONDITION CODE:                                            <<L2186>>04477140
<<                                                             <<L2186>>04477150
<<     CCE - No errors.                                        <<L2186>>04477160
<<     CCL - A new extra data segment couldn't be created.     <<L2186>>04477170
<<                                                             <<L2186>>04477180
<<-------------------------------------------------------------<<L2186>>04477190
                                                               <<L2186>>04477200
BEGIN  << CREATE'LSTX >>                                       <<L2186>>04477210
                                                               <<L2186>>04477220
INTEGER SAVE'DB;                                               <<L2186>>04477230
INTEGER NEW'DST;                                               <<L2186>>04477240
                                                               <<L2186>>04477250
   CONDCODE := CCE;                                            <<L2186>>04477260
                                                               <<L2186>>04477270
   NEW'DST := GETDATASEGC(                                     <<L2186>>04477280
      DSTI(SEGTABDST * 4    ).(3:13) * 4,      << LST size >>  <<L2186>>04477290
      DSTI(SEGTABDST * 4 + 1).(9:7) * %1000);  << LST VM >>    <<L2186>>04477300
                                                               <<L2186>>04477310
   IF <> THEN  << Can't get new dseg for some reason... >>     <<L2186>>04477320
      BEGIN                                                    <<L2186>>04477330
      CONDCODE := CCL;                                         <<L2186>>04477340
      RETURN;                                                  <<L2186>>04477350
      END;                                                     <<L2186>>04477360
                                                               <<L2186>>04477370
   << Initialize the new LSTX data segment.  Note: the data    <<L2186>>04477380
   << segment was created initialized to zero.                 <<L2186>>04477390
   <<--------------------------------------------------------- <<L2186>>04477400
                                                               <<L2186>>04477410
   SAVE'DB := EXCHANGEDB (NEW'DST);                            <<L2186>>04477420
                                                               <<L2186>>04477430
   << Allocate SBUF and Directory areas. >>                    <<L2186>>04477440
   <<------------------------------------>>                    <<L2186>>04477450
                                                               <<L2186>>04477460
   @SBUF0      := LST'PRIMARY'DB'SIZE;                         <<L2186>>04477470
   @DIR        := LST'PRIMARY'DB'SIZE + 128;                   <<L2186>>04477480
   DIRLEN      := DSTI(NEW'DST * 4).(3:13) * 4 - @DIR;         <<L2186>>04477490
                                                               <<L2186>>04477500
   << Initialize Directory. >>                                 <<L2186>>04477510
   <<----------------------->>                                 <<L2186>>04477520
                                                               <<L2186>>04477530
   @ENTP       := @DIR + PERM'HEADER'LEN;                      <<L2186>>04477540
   FWDLINK     := 0;                                           <<L2186>>04477550
   BKWDLINK    := 0;                                           <<L2186>>04477560
   RLENGTH     := DIRLEN;                                      <<L2186>>04477570
   ENTP        := GARBAGE;                                     <<L2186>>04477580
                                                               <<L2186>>04477590
   HDFWDLINK(GARBAGE)  := @ENTP;                               <<L2186>>04477600
   HDBKWDLINK(GARBAGE) := @ENTP;                               <<L2186>>04477610
                                                               <<L2186>>04477620
   << Update LSTX instrumentation data in LST. >>              <<L2186>>04477630
   <<------------------------------------------>>              <<L2186>>04477640
                                                               <<L2186>>04477650
   EXCHANGEDB (SEGTABDST);                                     <<L2186>>04477660
   CUR'NUM'LSTX'DSEGS := CUR'NUM'LSTX'DSEGS + 1;               <<L2186>>04477670
   IF CUR'NUM'LSTX'DSEGS > MAX'NUM'LSTX'DSEGS THEN             <<L2186>>04477680
      MAX'NUM'LSTX'DSEGS := CUR'NUM'LSTX'DSEGS;                <<L2186>>04477690
                                                               <<L2186>>04477700
   << Link this LSTX into the LST/LSTX chain. >>               <<L2186>>04477710
   <<----------------------------------------->>               <<L2186>>04477720
                                                               <<L2186>>04477730
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>04477740
   LINK'LSTX (NEW'DST);                                        <<L2186>>04477750
                                                               <<L2186>>04477760
END;  << CREATE'LSTX >>                                        <<L2186>>04477770
$PAGE                                                          <<L2186>>04477780
PROCEDURE DELETE'LSTX (DEAD'LSTX);                             <<L2186>>04477790
                                                               <<L2186>>04477800
   VALUE DEAD'LSTX;                                            <<L2186>>04477810
                                                               <<L2186>>04477820
   INTEGER DEAD'LSTX;                                          <<L2186>>04477830
                                                               <<L2186>>04477840
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>04477850
                                                               <<L2186>>04477860
<<-------------------------------------------------------------<<L2186>>04477870
<<                                                             <<L2186>>04477880
<<  Unlinks the passed LSTX data segment and returns it to     <<L2186>>04477890
<<  the system, unless it's the last one left, in which case   <<L2186>>04477900
<<  none of this will be done.                                 <<L2186>>04477910
<<                                                             <<L2186>>04477920
<<  CAUTION:  This procedure will return DB set to the same    <<L2186>>04477930
<<  data segment to which it was set upon entry.  Make sure    <<L2186>>04477940
<<  this is NOT the DEAD'LSTX which is to be returned to the   <<L2186>>04477950
<<  system!                                                    <<L2186>>04477960
<<                                                             <<L2186>>04477970
<<-------------------------------------------------------------<<L2186>>04477980
                                                               <<L2186>>04477990
BEGIN  << DELETE'LSTX >>                                       <<L2186>>04478000
                                                               <<L2186>>04478010
INTEGER SAVE'DB;                                               <<L2186>>04478020
                                                               <<L2186>>04478030
   SAVE'DB := EXCHANGEDB(DEAD'LSTX);                           <<L2186>>04478040
                                                               <<L2186>>04478050
   IF (THIS'LST = SEGTABDST'EX) AND (NEXT'LST = 0) THEN        <<L2186>>04478060
      BEGIN                                                    <<L2186>>04478070
      EXCHANGEDB (SAVE'DB);                                    <<L2186>>04478080
      RETURN;                                                  <<L2186>>04478090
      END;                                                     <<L2186>>04478100
                                                               <<L2186>>04478110
   UNLINK'LSTX;                                                <<L2186>>04478120
   EXCHANGEDB (SEGTABDST);                                     <<L2186>>04478130
   RELDATASEG (DEAD'LSTX);                                     <<L2186>>04478140
   CUR'NUM'LSTX'DSEGS := CUR'NUM'LSTX'DSEGS - 1;               <<L2186>>04478150
                                                               <<L2186>>04478160
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>04478170
                                                               <<L2186>>04478180
END;  << DELETE'LSTX >>                                        <<L2186>>04478190
$PAGE                                                          <<L2186>>04479900
          @ENTP2:=@ENTP1+ESLFIXED'SIZE-1;                      <<S1946>>04535000
          @ENTP3:=@ENTP2+(IF EXSYS'SL THEN EXSLBITMAP'SIZE     <<S1946>>04540000
                           ELSE ESLBITMAP'SIZE);               <<S1946>>04541000
          IF EXSYS'SL THEN                                     <<S1946>>04561000
             @ENTP3:=@ENTP2+ EXSLINFO'AREA'SIZE +              <<S1946>>04562000
             ((ESLINFO'PROG-1)*ESLINFO'AREA'SIZE)              <<S1946>>04563000
          ELSE                                                 <<S1946>>04564000
             @ENTP3:=@ENTP2+ESLINFO'PROG*ESLINFO'AREA'SIZE;    <<S1946>>04565000
          IF EXSYS'SL THEN                                     <<S1946>>04661000
             @ENTP3:=@ENTP2+ EXSLINFO'AREA'SIZE +              <<S1946>>04662000
             ((ESLINFO'EXT -1)*ESLINFO'AREA'SIZE)              <<S1946>>04663000
          ELSE                                                 <<S1946>>04664000
             @ENTP3:=@ENTP2+ESLINFO'EXT*ESLINFO'AREA'SIZE;     <<S1946>>04665000
$PAGE                                                          <<L2186>>04709000
$PAGE                                                          <<L2186>>04884000
        @ENTP := POSITION + PERM'HEADER'LEN;                   <<L2186>>04960000
            IF @ENTP - HEADER'LEN + RLENGTH = POSITION THEN    <<L2186>>05010000
                POSITION := @ENTP - HEADER'LEN;                <<L2186>>05025000
            IF POSITION + LENGTH + PERM'HEADER'LEN = @ENTP THEN<<L2186>>05045000
$PAGE                                                          <<L2186>>05104000
          6,  <<BASIC SL>>                                     <<S1946>>05135000
        <<1>> IF EXSYS'SL THEN                                 <<S1946>>05230000
                  TOS:=TOS+ESLSEG'SL *  ESLSEGLIST'ENTRY'SIZE  <<S1946>>05230500
                  + EXSLBITMAP'SIZE                            <<S1946>>05231000
             ELSE                                              <<S1946>>05232000
                TOS:=TOS+ESLSEG'SL* ESLSEGLIST'ENTRY'SIZE      <<S1946>>05233000
                      + ESLBITMAP'SIZE;                        <<S1946>>05234000
        <<2>> IF EXSYS'SL THEN                                 <<S1946>>05235000
                  TOS:=TOS+((ESLINFO'PROG-1)*ESLINFO'AREA'SIZE)<<S1946>>05236000
                  + EXSLINFO'AREA'SIZE+EMAPSIZE+1              <<S1946>>05237000
              ELSE                                             <<S1946>>05237500
                  TOS:=TOS+ESLINFO'PROG*ESLINFO'AREA'SIZE+     <<S1946>>05238000
                      EMAPSIZE+1;                              <<S1946>>05239000
        <<7>> IF EXSYS'SL THEN                                 <<S1946>>05260000
                TOS:=TOS+ENTP(4).(4:3)+((ESLINFO'EXT-1)*       <<S1946>>05261000
                      ESLINFO'AREA'SIZE)  + EXSLINFO'AREA'SIZE <<S1946>>05262000
                                     +EMAPSIZE+1               <<S1946>>05265000
              ELSE                                             <<S1946>>05266000
                TOS:=TOS+ENTP(4).(4:3)+(ESLINFO'EXT*           <<S1946>>05267000
                      ESLINFO'AREA'SIZE)  + EMAPSIZE+1;        <<S1946>>05268000
$PAGE                                                          <<L2186>>05289000
$PAGE                                                          <<L2186>>05384000
PROCEDURE LSTEP (PROC,TABLE'LEN);                              <<S1946>>05385000
   VALUE TABLE'LEN;                                            <<S1946>>05401000
   INTEGER TABLE'LEN;                                          <<S1946>>05402000
     XREG:=(TABLE'LEN*16) - 1;          <<NUM OF BITS>         <<S1946>>05420000
$EDIT VOID=05675000                                            <<L2186>>05470000
$PAGE                                                          <<L2186>>05471000
PROCEDURE LSTORE;                                              <<L2186>>05472000
                                                               <<L2186>>05473000
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>05474000
                                                               <<L2186>>05475000
<<-------------------------------------------------------------<<L2186>>05476000
<<                                                             <<L2186>>05477000
<<  Stores the contents of the current LST entry in its home   <<L2186>>05478000
<<  location in the LSTX and then deletes the entry in the     <<L2186>>05479000
<<  LST.  If the current LST entry doesn't have a home in the  <<L2186>>05480000
<<  LSTX (because it's a new entry), one will be created.  If  <<L2186>>05481000
<<  this operation fails for any reason, the current LST entry <<L2186>>05482000
<<  is preserved, and it is up to the caller to perform any    <<L2186>>05483000
<<  logical recovery.                                          <<L2186>>05484000
<<                                                             <<L2186>>05485000
<<  CONDITION CODE:                                            <<L2186>>05486000
<<                                                             <<L2186>>05487000
<<     CCE - No errors.                                        <<L2186>>05488000
<<     CCL - Couldn't move entry to LSTX.                      <<L2186>>05489000
<<                                                             <<L2186>>05490000
<<-------------------------------------------------------------<<L2186>>05491000
                                                               <<L2186>>05492000
BEGIN  << LSTORE >>                                            <<L2186>>05493000
                                                               <<L2186>>05494000
INTEGER SAVE'DB;                                               <<L2186>>05495000
INTEGER TRANSFER'COUNT;                                        <<L2186>>05496000
                                                               <<L2186>>05497000
   << Initialization. >>                                       <<L2186>>05498000
   <<----------------->>                                       <<L2186>>05499000
                                                               <<L2186>>05500000
   SAVE'DB        := EXCHANGEDB(SEGTABDST);                    <<L2186>>05501000
                                                               <<L2186>>05502000
   << If the current entry in the LST is permanent, then       <<L2186>>05503000
   << there's nothing to be done.                              <<L2186>>05504000
   <<----------------------------------------------------------<<L2186>>05505000
                                                               <<L2186>>05506000
   IF PERM'ENTRY THEN                                          <<L2186>>05507000
      BEGIN                                                    <<L2186>>05508000
      CONDCODE := CCE;                                         <<L2186>>05509000
      EXCHANGEDB (SAVE'DB);                                    <<L2186>>05510000
      RETURN;                                                  <<L2186>>05511000
      END;                                                     <<L2186>>05512000
                                                               <<L2186>>05513000
   << Prepare to move temporary LST entry to its home in the   <<L2186>>05514000
   << LSTX.                                                    <<L2186>>05515000
   <<----------------------------------------------------------<<L2186>>05516000
                                                               <<L2186>>05517000
   IF HOME'LSTX <> 0 THEN                                      <<L2186>>05518000
                                                               <<L2186>>05519000
      << Home entry exists; transfer size is based on size of  <<L2186>>05520000
      << home entry in case temporary entry was expanded by    <<L2186>>05521000
      << LCREATE'TEMP.                                         <<L2186>>05522000
      <<-------------------------------------------------------<<L2186>>05523000
                                                               <<L2186>>05524000
      TRANSFER'COUNT := HOME'RLENGTH - PERM'HEADER'LEN         <<L2186>>05525000
                                                               <<L2186>>05526000
   ELSE                                                        <<L2186>>05527000
                                                               <<L2186>>05528000
      << Home entry doesn't exist; create a new one in LSTX.   <<L2186>>05529000
      <<-------------------------------------------------------<<L2186>>05530000
                                                               <<L2186>>05531000
      BEGIN                                                    <<L2186>>05532000
                                                               <<L2186>>05533000
      << Make transfer count (and size of home entry) same as  <<L2186>>05534000
      << size of body of temporary entry.                      <<L2186>>05535000
      <<-------------------------------------------------------<<L2186>>05536000
                                                               <<L2186>>05537000
      TRANSFER'COUNT := RLENGTH - TEMP'HEADER'LEN;             <<L2186>>05538000
                                                               <<L2186>>05539000
      LCREATE'ENT (TRANSFER'COUNT, ETYPE, 0, 0, 0D,            <<L2186>>05540000
                    HOME'LSTX, HOME'OFFSET);                   <<L2186>>05541000
                                                               <<L2186>>05542000
      IF <> THEN                                               <<L2186>>05543000
         BEGIN                                                 <<L2186>>05544000
         CONDCODE := CCL;                                      <<L2186>>05545000
         EXCHANGEDB (SAVE'DB);                                 <<L2186>>05546000
         RETURN;                                               <<L2186>>05547000
         END;                                                  <<L2186>>05548000
                                                               <<L2186>>05549000
      END;                                                     <<L2186>>05550000
                                                               <<L2186>>05551000
   << Move LST entry to LSTX. >>                               <<L2186>>05552000
   <<------------------------->>                               <<L2186>>05553000
                                                               <<L2186>>05554000
   TOS := HOME'LSTX;                                           <<L2186>>05555000
   TOS := HOME'OFFSET;                                         <<L2186>>05556000
   TOS := SEGTABDST;                                           <<L2186>>05557000
   TOS := @ENTP;                                               <<L2186>>05558000
   TOS := TRANSFER'COUNT;                                      <<L2186>>05559000
   ASMB (MDS 5);                                               <<L2186>>05560000
                                                               <<L2186>>05561000
   << Delete current entry from Posting Directory. >>          <<L2186>>05562000
   <<---------------------------------------------->>          <<L2186>>05563000
                                                               <<L2186>>05564000
   LPURGE;                                                     <<L2186>>05565000
   CONDCODE := CCE;                                            <<L2186>>05566000
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>05567000
                                                               <<L2186>>05568000
END;  << LSTORE >>                                             <<L2186>>05569000
$EDIT VOID=05845000                                            <<L2186>>05680000
$PAGE                                                          <<L2186>>05681000
PROCEDURE TRANS'LSTX'TO'LST;                                   <<L2186>>05682000
                                                               <<L2186>>05683000
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>05684000
                                                               <<L2186>>05685000
<<-------------------------------------------------------------<<L2186>>05686000
<<                                                             <<L2186>>05687000
<<  Copies the current entry in the current LSTX to the LST.   <<L2186>>05688000
<<                                                             <<L2186>>05689000
<<  CONDITION CODE:                                            <<L2186>>05690000
<<                                                             <<L2186>>05691000
<<     CCE - No errors.                                        <<L2186>>05692000
<<     CCL - Entry couldn't be created in the LST.             <<L2186>>05693000
<<                                                             <<L2186>>05694000
<<-------------------------------------------------------------<<L2186>>05695000
                                                               <<L2186>>05696000
BEGIN  << TRANS'LSTX'TO'LST >>                                 <<L2186>>05697000
                                                               <<L2186>>05698000
INTEGER SAVE'DB;                                               <<L2186>>05699000
INTEGER ENTRY'TYPE;                                            <<L2186>>05700000
INTEGER SOURCE'OFFSET;                                         <<L2186>>05701000
INTEGER TRANSFER'COUNT;                                        <<L2186>>05702000
                                                               <<L2186>>05703000
   << Initialization >>                                        <<L2186>>05704000
   <<---------------->>                                        <<L2186>>05705000
                                                               <<L2186>>05706000
   SAVE'DB        := THIS'LST;                                 <<L2186>>05707000
   ENTRY'TYPE     := ETYPE;                                    <<L2186>>05708000
   SOURCE'OFFSET  := @ENTP;                                    <<L2186>>05709000
   TRANSFER'COUNT := RLENGTH - PERM'HEADER'LEN;                <<L2186>>05710000
                                                               <<L2186>>05711000
   << Create a new entry in the LST Directory. >>              <<L2186>>05712000
   <<------------------------------------------>>              <<L2186>>05713000
                                                               <<L2186>>05714000
   EXCHANGEDB (SEGTABDST);                                     <<L2186>>05715000
                                                               <<L2186>>05716000
   << Use reserved temporary entries if available. >>          <<L2186>>05717000
   <<---------------------------------------------->>          <<L2186>>05718000
                                                               <<L2186>>05719000
   IF ENTRY'TYPE = EXTENSION AND  << Try to use temp buffer:   <<L2186>>05720000
      @TEMP'EXT'ENTP <> 0 AND     << Buffer must be allocated  <<L2186>>05721000
      TEMP'EXT'ENTP = 0 AND       << Buffer must be available  <<L2186>>05722000
      TRANSFER'COUNT <= EXTENSION'MAX THEN << & big enough     <<L2186>>05723000
      BEGIN                                                    <<L2186>>05724000
      @ENTP   := @TEMP'EXT'ENTP;                               <<L2186>>05725000
      RLENGTH := TRANSFER'COUNT + TEMP'HEADER'LEN;             <<L2186>>05726000
      END                                                      <<L2186>>05727000
                                                               <<L2186>>05728000
   ELSE IF ENTRY'TYPE = LOADPROCMASTER AND  << Temp buf:       <<L2186>>05729000
           @TEMP'MAST'ENTP <> 0 AND         << Allocated?      <<L2186>>05730000
           TEMP'MAST'ENTP = 0 AND           << Available?      <<L2186>>05731000
                                            << Big enough?     <<L2186>>05732000
           TRANSFER'COUNT <= LOADPROCMASTER'MAX THEN           <<L2186>>05733000
      BEGIN                                                    <<L2186>>05734000
      @ENTP   := @TEMP'MAST'ENTP;                              <<L2186>>05735000
      RLENGTH := TRANSFER'COUNT + TEMP'HEADER'LEN;             <<L2186>>05736000
      END                                                      <<L2186>>05737000
                                                               <<L2186>>05738000
   ELSE                                                        <<L2186>>05739000
                                                               <<L2186>>05740000
      << Can't use temporary entries (not supposed to          <<L2186>>05741000
      << happen!) - try for dynamic temporary entry.           <<L2186>>05742000
      <<-------------------------------------------------------<<L2186>>05743000
                                                               <<L2186>>05744000
      BEGIN                                                    <<L2186>>05745000
      LCREATE'TEMP (TRANSFER'COUNT, ENTRY'TYPE, 0, 0, 0D);     <<L2186>>05746000
      IF <> THEN                                               <<L2186>>05747000
         BEGIN                                                 <<L2186>>05748000
         CONDCODE := CCL;                                      <<L2186>>05749000
         EXCHANGEDB (SAVE'DB);                                 <<L2186>>05750000
         RETURN;                                               <<L2186>>05751000
         END;                                                  <<L2186>>05752000
      END;                                                     <<L2186>>05753000
                                                               <<L2186>>05754000
   << Copy the LSTX entry to the LST Directory. >>             <<L2186>>05755000
   <<------------------------------------------->>             <<L2186>>05756000
                                                               <<L2186>>05757000
   TOS := SEGTABDST;                                           <<L2186>>05758000
   TOS := @ENTP;                                               <<L2186>>05759000
   TOS := SAVE'DB;                                             <<L2186>>05760000
   TOS := SOURCE'OFFSET;                                       <<L2186>>05761000
   TOS := TRANSFER'COUNT;                                      <<L2186>>05762000
   ASMB (MDS 5);                                               <<L2186>>05763000
                                                               <<L2186>>05764000
   SETSECPTRS;                                                 <<L2186>>05765000
   HOME'LSTX    := SAVE'DB;                                    <<L2186>>05766000
   HOME'OFFSET  := SOURCE'OFFSET;                              <<L2186>>05767000
   HOME'RLENGTH := TRANSFER'COUNT + PERM'HEADER'LEN;           <<L2186>>05768000
   CONDCODE     := CCE;                                        <<L2186>>05769000
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>05770000
                                                               <<L2186>>05771000
END;  << TRANS'LSTX'TO'LST >>                                  <<L2186>>05772000
$EDIT VOID=05905000                                            <<L2186>>05850000
$PAGE                                                          <<L2186>>05909000
$EDIT VOID=06180000                                            <<L2186>>06040000
$PAGE                                                          <<L2186>>06041000
LOGICAL PROCEDURE LSEARCH (KEY, PMODE, TYPE);                  <<L2186>>06042000
                                                               <<L2186>>06043000
   VALUE KEY, PMODE, TYPE;                                     <<L2186>>06044000
                                                               <<L2186>>06045000
   DOUBLE  KEY;                                                <<L2186>>06046000
   INTEGER PMODE;                                              <<L2186>>06047000
   INTEGER TYPE;                                               <<L2186>>06048000
                                                               <<L2186>>06049000
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>06050000
                                                               <<L2186>>06051000
<<-------------------------------------------------------------<<L2186>>06052000
<<  Searches LST/LSTX Directories for entry of specified KEY,  <<L2186>>06053000
<<  MODE and TYPE.  If found, entry is made present in LST,    <<L2186>>06054000
<<  where ENTP pointers are set.  If found in the LSTX, ENTP   <<L2186>>06055000
<<  pointers are set in the home LSTX data seg before copying  <<L2186>>06056000
<<  entry to LST.                                              <<L2186>>06057000
<<                                                             <<L2186>>06058000
<<  FUNCTIONAL RETURN:                                         <<L2186>>06059000
<<                                                             <<L2186>>06060000
<<    TRUE is returned if entry was found, otherwise FALSE.    <<L2186>>06061000
<<                                                             <<L2186>>06062000
<<-------------------------------------------------------------<<L2186>>06063000
                                                               <<L2186>>06064000
BEGIN  << LSEARCH >>                                           <<L2186>>06065000
                                                               <<L2186>>06066000
INTEGER SAVE'DB := 0;                                          <<L2186>>06067000
INTEGER CURRENT'LST;                                           <<L2186>>06068000
                                                               <<L2186>>06069000
   IF TYPE < EXTENSION THEN                                    <<L2186>>06070000
      CURRENT'LST := SEGTABDST                                 <<L2186>>06071000
   ELSE                                                        <<L2186>>06072000
      CURRENT'LST := SEGTABDST'EX;                             <<L2186>>06073000
                                                               <<L2186>>06074000
   WHILE CURRENT'LST <> 0 DO                                   <<L2186>>06075000
      BEGIN                                                    <<L2186>>06076000
                                                               <<L2186>>06077000
      << Aim DB at next LST/LSTX data segment to be scanned. >><<L2186>>06078000
      <<----------------------------------------------------->><<L2186>>06079000
                                                               <<L2186>>06080000
      IF SAVE'DB = 0 THEN                                      <<L2186>>06081000
         SAVE'DB := EXCHANGEDB(CURRENT'LST)                    <<L2186>>06082000
      ELSE                                                     <<L2186>>06083000
         EXCHANGEDB (CURRENT'LST);                             <<L2186>>06084000
                                                               <<L2186>>06085000
      << Look for the desired entry in this LST/LSTX data seg. <<L2186>>06086000
      <<-------------------------------------------------------<<L2186>>06087000
                                                               <<L2186>>06088000
      IF LSEARCH'(KEY, PMODE, TYPE) THEN                       <<L2186>>06089000
         BEGIN                                                 <<L2186>>06090000
         LSEARCH := TRUE;                                      <<L2186>>06091000
         IF NOT (IN'LST) THEN                                  <<L2186>>06092000
            BEGIN                                              <<L2186>>06093000
            TRANS'LSTX'TO'LST;                                 <<L2186>>06094000
            IF <> THEN                                         <<L2186>>06095000
               LSEARCH := FALSE;                               <<L2186>>06096000
            END;                                               <<L2186>>06097000
         EXCHANGEDB (SAVE'DB);                                 <<L2186>>06098000
         RETURN;                                               <<L2186>>06099000
         END;                                                  <<L2186>>06100000
                                                               <<L2186>>06101000
      << Try next LSTX data segment. >>                        <<L2186>>06102000
      <<----------------------------->>                        <<L2186>>06103000
                                                               <<L2186>>06104000
      IF TYPE < EXTENSION THEN                                 <<L2186>>06105000
         CURRENT'LST := 0                                      <<L2186>>06106000
      ELSE                                                     <<L2186>>06107000
         CURRENT'LST := NEXT'LST;                              <<L2186>>06108000
                                                               <<L2186>>06109000
      END;  << WHILE >>                                        <<L2186>>06110000
                                                               <<L2186>>06111000
                                                               <<L2186>>06112000
   << Entry not found. >>                                      <<L2186>>06113000
   <<------------------>>                                      <<L2186>>06114000
                                                               <<L2186>>06115000
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>06116000
   LSEARCH := FALSE;                                           <<L2186>>06117000
                                                               <<L2186>>06118000
END;  << LSEARCH >>                                            <<L2186>>06119000
$PAGE                                                          <<L2186>>06184000
PROCEDURE LCREATE'PERM (LENGTH, TYPE, PMODE, LIBRARY, KEY);    <<L2186>>06185000
   <<                                                          <<L2186>>06206000
   << Note that the LENGTH parameter does not include the      <<L2186>>06206100
   << entry's header, which varies depending on whether the    <<L2186>>06206200
   << entry is permanent or temporary.                         <<L2186>>06206300
   <<                                                          <<L2186>>06206400
$EDIT VOID=06285000                                            <<L2186>>06241000
     INTEGER RETRY := -1;                                      <<L2186>>06242000
     INTEGER EXCESS;                                           <<L2186>>06243000
     INTEGER REGION'LENGTH;                                    <<L2186>>06244000
     INTEGER CREATE'HEADER'LEN;                                <<L2186>>06245000
     LOGICAL LCREATE'T := TRUE;                                <<L2186>>06246000
     ENTRY LCREATE'TEMP;                                       <<L2186>>06247000
                                                               <<L2186>>06248000
     LCREATE'T := FALSE;                                       <<L2186>>06249000
     CREATE'HEADER'LEN := PERM'HEADER'LEN;                     <<L2186>>06250000
     GOTO RESTART;                                             <<L2186>>06251000
                                                               <<L2186>>06252000
LCREATE'TEMP:  << Creating temporary entry. >>                 <<L2186>>06253000
                                                               <<L2186>>06254000
     CREATE'HEADER'LEN := TEMP'HEADER'LEN;;                    <<L2186>>06255000
     @ENTP := HDFWDLINK(GARBAGE);                              <<L2186>>06310000
         IF ENWG >= LENGTH + CREATE'HEADER'LEN THEN            <<L2186>>06325000
             REGION'LENGTH := RLENGTH;                         <<L2186>>06338000
             EXCESS := ENWG - LENGTH - CREATE'HEADER'LEN;      <<L2186>>06340000
               BUILDGARBAGE (@ENTP - HEADER'LEN +              <<L2186>>06355000
                             CREATE'HEADER'LEN + LENGTH,       <<L2186>>06355100
                             EXCESS);                          <<L2186>>06355200
             @ENTP := @ENTP - HEADER'LEN + CREATE'HEADER'LEN;  <<L2186>>06377000
             RLENGTH := REGION'LENGTH - EXCESS;                <<L2186>>06380000
             IF LCREATE'T THEN                                 <<L2186>>06422000
               BEGIN                                           <<L2186>>06422100
               HOME'LSTX    := 0;                              <<L2186>>06422200
               HOME'OFFSET  := 0;                              <<L2186>>06422300
               HOME'RLENGTH := 0;                              <<L2186>>06422400
               END;                                            <<L2186>>06422500
     TOS:=THIS'LST;                                            <<L2186>>06515000
                                                               <<L2186>>06520000
     IF <> THEN                                                <<R1624>>06526000
       BEGIN                                                   <<R1624>>06527000
       IF IN'LST THEN                                          <<L2186>>06528000
         BEGIN              <<NO ROOM IN THE LST.            >><<R1624>>06529000
         AUTO'DEALLOCATE;   <<TRY DEALLOCATING FOR SPACE     >><<R1624>>06530000
         IF > THEN GO NFG;  <<NOTHING FOUND TO DEALLOCATE    >><<R1624>>06530100
         RETRY := -1;       <<IF AUTO'DEALLOCATE DID NOT     >><<R1624>>06530200
                            <<MAKE ENOUGH ROOM WILL TRY AGAIN>><<R1624>>06530300
         END <<THEN>>                                          <<R1624>>06530400
         ELSE GO NFG;       <<NO ROOM IN THE XLST.           >><<R1624>>06530500
       END  <<THEN>>                                           <<R1624>>06531000
                                                               <<R1624>>06531100
     ELSE                                                      <<R1624>>06532000
       BEGIN                                                   <<R1624>>06533000
       EXCESS:=TOS-@DIR-1-DIRLEN; <<WORDS ADDED>>              <<R1624>>06535000
       IF EXCESS <= 0 THEN GO NFG;<<NO EXPANSION>>             <<R1624>>06540000
       BUILDGARBAGE(@DIR(DIRLEN),EXCESS); <<NEW GARBAGE>>      <<R1624>>06545000
       DIRLEN:=DIRLEN+EXCESS; <<UPDATE DIR LENGTH>>            <<R1624>>06550000
       END;  <<ELSE>>                                          <<R1624>>06551000
                                                               <<R1624>>06552000
$PAGE                                                          <<L2186>>06592000
PROCEDURE LCREATE (LENGTH, TYPE, PMODE, LIBRARY, KEY);         <<L2186>>06592010
                                                               <<L2186>>06592020
   VALUE LENGTH, TYPE, PMODE, LIBRARY, KEY;                    <<L2186>>06592030
                                                               <<L2186>>06592040
   INTEGER LENGTH;                                             <<L2186>>06592050
   INTEGER TYPE;                                               <<L2186>>06592060
   INTEGER PMODE;                                              <<L2186>>06592070
   INTEGER LIBRARY;                                            <<L2186>>06592080
   DOUBLE  KEY;                                                <<L2186>>06592090
                                                               <<L2186>>06592100
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>06592110
                                                               <<L2186>>06592120
<<-------------------------------------------------------------<<L2186>>06592130
<<                                                             <<L2186>>06592140
<<  Creates a new entry in an appropriate LST/LSTX Directory.  <<L2186>>06592150
<<  This procedure insures that permanent LOADPROC entries are <<L2186>>06592160
<<  kept out of the LST Directory, and will support the migra- <<L2186>>06592170
<<  tion of non-LOADPROC entries out of the LST when the       <<L2186>>06592180
<<  required logic is added to the rest of the Loader code.    <<L2186>>06592190
<<                                                             <<L2186>>06592200
<<-------------------------------------------------------------<<L2186>>06592210
                                                               <<L2186>>06592220
BEGIN  << LCREATE >>                                           <<L2186>>06592230
                                                               <<L2186>>06592240
   IF IN'LST THEN                                              <<L2186>>06592250
      IF TYPE < EXTENSION THEN                                 <<L2186>>06592260
         BEGIN                                                 <<L2186>>06592270
                                                               <<L2186>>06592280
         << For non-LOADPROC entries in the LST, first try to  <<L2186>>06592290
         << create a new permanent entry.                      <<L2186>>06592300
         <<----------------------------------------------------<<L2186>>06592310
                                                               <<L2186>>06592320
         LCREATE'PERM (LENGTH, TYPE, PMODE, LIBRARY, KEY);     <<L2186>>06592330
                                                               <<L2186>>06592340
         << The following two lines are commented out until    <<L2186>>06592350
         << non-LOADPROC entries can migrate to the LSTX.      <<L2186>>06592360
         << When the LST Directory is full, they allow the     <<L2186>>06592370
         << creation of temporary nonLOADPROC LST entries      <<L2186>>06592380
         << which must be migrated later to an LSTX.           <<L2186>>06592390
         <<----------------------------------------------------<<L2186>>06592400
                                                               <<L2186>>06592410
<<       IF <> THEN                                            <<L2186>>06592420
<<          LCREATE'TEMP (LENGTH, TYPE, PMODE, LIBRARY, KEY);  <<L2186>>06592430
         END                                                   <<L2186>>06592440
      ELSE                                                     <<L2186>>06592450
                                                               <<L2186>>06592460
         << For LOADPROC entries in the LST, create temporary  <<L2186>>06592470
         << entries only.                                      <<L2186>>06592480
         <<----------------------------------------------------<<L2186>>06592490
                                                               <<L2186>>06592500
         LCREATE'TEMP (LENGTH, TYPE, PMODE, LIBRARY, KEY)      <<L2186>>06592510
   ELSE                                                        <<L2186>>06592520
                                                               <<L2186>>06592530
      << For all entries in the LSTX, create permanent entries <<L2186>>06592540
      << only.  (Only the LST Directory can have temp entries.)<<L2186>>06592550
      <<-------------------------------------------------------<<L2186>>06592560
                                                               <<L2186>>06592570
      LCREATE'PERM (LENGTH, TYPE, PMODE, LIBRARY, KEY);        <<L2186>>06592580
                                                               <<L2186>>06592590
   IF <> THEN                                                  <<L2186>>06592600
      CONDCODE := CCL                                          <<L2186>>06592610
   ELSE                                                        <<L2186>>06592620
      CONDCODE := CCE;                                         <<L2186>>06592630
                                                               <<L2186>>06592640
END;  << LCREATE >>                                            <<L2186>>06592650
$PAGE                                                          <<L2186>>06595000
PROCEDURE LCREATE'ENT (LENGTH, TYPE, PMODE, LIBRARY, KEY,      <<L2186>>06595010
                        LSTX'DST, LSTX'OFFSET);                <<L2186>>06595020
                                                               <<L2186>>06595030
   VALUE LENGTH, TYPE, PMODE, LIBRARY, KEY;                    <<L2186>>06595040
                                                               <<L2186>>06595050
   INTEGER LENGTH;                                             <<L2186>>06595060
   INTEGER TYPE;                                               <<L2186>>06595070
   INTEGER PMODE;                                              <<L2186>>06595080
   INTEGER LIBRARY;                                            <<L2186>>06595090
   DOUBLE  KEY;                                                <<L2186>>06595100
   INTEGER LSTX'DST;                                           <<L2186>>06595110
   INTEGER LSTX'OFFSET;                                        <<L2186>>06595120
                                                               <<L2186>>06595130
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>06595140
                                                               <<L2186>>06595150
<<-------------------------------------------------------------<<L2186>>06595160
<<                                                             <<L2186>>06595170
<<  Creates a permanent Directory entry in LST/LSTX.  For      <<L2186>>06595180
<<  LOADPROC entries, all LSTX data segments are scanned for   <<L2186>>06595190
<<  available space, and if necessary a new LSTX data segment  <<L2186>>06595200
<<  will be added to hold the new entry.                       <<L2186>>06595210
<<                                                             <<L2186>>06595220
<<  CONDITION CODE:                                            <<L2186>>06595230
<<                                                             <<L2186>>06595240
<<     CCE - No errors.                                        <<L2186>>06595250
<<     CCL - Entry couldn't be created.                        <<L2186>>06595260
<<                                                             <<L2186>>06595270
<<-------------------------------------------------------------<<L2186>>06595280
                                                               <<L2186>>06595290
BEGIN  << LCREATE'ENT >>                                       <<L2186>>06595300
                                                               <<L2186>>06595310
INTEGER SAVE'DB;                                               <<L2186>>06595320
INTEGER NEXT'DST;                                              <<L2186>>06595330
INTEGER SAVE'LSTX'DST;                                         <<L2186>>06595340
INTEGER SAVE'LSTX'OFFSET;                                      <<L2186>>06595350
                                                               <<L2186>>06595360
   SAVE'DB := THIS'LST;                                        <<L2186>>06595370
   IF TYPE < EXTENSION THEN                                    <<L2186>>06595380
      NEXT'DST := SEGTABDST                                    <<L2186>>06595390
   ELSE                                                        <<L2186>>06595400
      NEXT'DST := SEGTABDST'EX;                                <<L2186>>06595410
                                                               <<L2186>>06595420
   WHILE NEXT'DST <> 0 DO                                      <<L2186>>06595430
      BEGIN                                                    <<L2186>>06595440
      EXCHANGEDB (NEXT'DST);                                   <<L2186>>06595450
      IF THIS'LST = SEGTABDST THEN                             <<L2186>>06595460
         NEXT'DST := 0  << Don't migrate out of LST >>         <<L2186>>06595470
      ELSE                                                     <<L2186>>06595480
         NEXT'DST := NEXT'LST;                                 <<L2186>>06595490
                                                               <<L2186>>06595500
      LCREATE'PERM (LENGTH, TYPE, PMODE, LIBRARY, KEY);        <<L2186>>06595510
      IF = THEN                                                <<L2186>>06595520
         GO RETURN'OK;                                         <<L2186>>06595530
      END;  << WHILE >>                                        <<L2186>>06595540
                                                               <<L2186>>06595550
   IF TYPE < EXTENSION THEN                                    <<L2186>>06595560
      GO RETURN'FAIL;                                          <<L2186>>06595570
                                                               <<L2186>>06595580
   << All the LSTX data segments are full, so try to create    <<L2186>>06595590
   << another.                                                 <<L2186>>06595600
   <<--------------------------------------------------------- <<L2186>>06595610
                                                               <<L2186>>06595620
   CREATE'LSTX;                                                <<L2186>>06595630
   IF <> THEN                                                  <<L2186>>06595640
      GO RETURN'FAIL;                                          <<L2186>>06595650
                                                               <<L2186>>06595660
   EXCHANGEDB (NEXT'LST);                                      <<L2186>>06595670
   LCREATE'PERM (LENGTH, TYPE, PMODE, LIBRARY, KEY);           <<L2186>>06595680
   IF <> THEN                                                  <<L2186>>06595690
      GO RETURN'FAIL;                                          <<L2186>>06595700
                                                               <<L2186>>06595710
RETURN'OK:                                                     <<L2186>>06595720
                                                               <<L2186>>06595730
   SAVE'LSTX'DST := THIS'LST;                                  <<L2186>>06595740
   SAVE'LSTX'OFFSET := @ENTP;                                  <<L2186>>06595750
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>06595760
   LSTX'DST    := SAVE'LSTX'DST;                               <<L2186>>06595770
   LSTX'OFFSET := SAVE'LSTX'OFFSET;                            <<L2186>>06595780
   CONDCODE    := CCE;                                         <<L2186>>06595790
   RETURN;                                                     <<L2186>>06595800
                                                               <<L2186>>06595810
RETURN'FAIL:                                                   <<L2186>>06595820
                                                               <<L2186>>06595830
   CONDCODE := CCL;                                            <<L2186>>06595840
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>06595850
                                                               <<L2186>>06595860
END;  << LCREATE'ENT >>                                        <<L2186>>06595870
$PAGE                                                          <<L2186>>06599800
PROCEDURE LPURGE;                                              <<L2186>>06599900
  BEGIN  << LPURGE >>                                          <<L2186>>06615000
                                                               <<L2186>>06617000
    << Don't put entry back on garbage list if it's a          <<L2186>>06617100
    << reserved temporary entry.                               <<L2186>>06617200
    <<---------------------------------------------------------<<L2186>>06617300
                                                               <<L2186>>06617400
    IF IN'LST THEN                                             <<L2186>>06617500
      IF @ENTP = @TEMP'MAST'ENTP OR @ENTP = @TEMP'EXT'ENTP THEN<<L2186>>06617600
         BEGIN                                                 <<L2186>>06617700
         ENTP := 0;  << Mark reserved temp entry as available ><<L2186>>06617800
         RETURN;                                               <<L2186>>06617900
         END;                                                  <<L2186>>06618000
                                                               <<L2186>>06618100
    BUILDGARBAGE (@ENTP - HEADER'LEN, RLENGTH);                <<L2186>>06625000
<<  @ENTP := HDFWDLINK(GARBAGE);                               <<L2186>>06626000
<<  IF DIRLEN = RLENGTH THEN                                   <<L2186>>06627000
<<     DELETE'LSTX (THIS'LST);                                 <<L2186>>06628000
  END;  << LPURGE >>                                           <<L2186>>06630000
$PAGE                                                          <<L2186>>06631000
PROCEDURE LDELETE;                                             <<L2186>>06632000
                                                               <<L2186>>06632010
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>06632020
                                                               <<L2186>>06632030
<<-------------------------------------------------------------<<L2186>>06632040
<<                                                             <<L2186>>06632050
<<  Deletes the current entry in the current LST/LSTX, and     <<L2186>>06632060
<<  also deletes the home entry if the current one is tempo-   <<L2186>>06632070
<<  rary and a home entry exists.                              <<L2186>>06632080
<<                                                             <<L2186>>06632090
<<-------------------------------------------------------------<<L2186>>06632100
                                                               <<L2186>>06632110
BEGIN  << LDELETE >>                                           <<L2186>>06632120
                                                               <<L2186>>06632130
INTEGER SAVE'ENTP;                                             <<L2186>>06632140
INTEGER SAVE'HOME'OFFSET;                                      <<L2186>>06632150
                                                               <<L2186>>06632160
   << Get rid of the home entry if one exists. >>              <<L2186>>06632170
   <<------------------------------------------>>              <<L2186>>06632180
                                                               <<L2186>>06632190
   IF TEMP'ENTRY THEN                                          <<L2186>>06632200
      IF HOME'LSTX <> 0 THEN                                   <<L2186>>06632210
         BEGIN                                                 <<L2186>>06632220
         SAVE'HOME'OFFSET := HOME'OFFSET;                      <<L2186>>06632230
         EXCHANGEDB (HOME'LSTX);                               <<L2186>>06632240
         SAVE'ENTP := @ENTP;                                   <<L2186>>06632250
         @ENTP := SAVE'HOME'OFFSET;                            <<L2186>>06632260
         LPURGE;                                               <<L2186>>06632270
         @ENTP := SAVE'ENTP;                                   <<L2186>>06632280
         EXCHANGEDB (SEGTABDST);                               <<L2186>>06632290
         END;                                                  <<L2186>>06632300
                                                               <<L2186>>06632310
   << Now get rid of the current entry. >>                     <<L2186>>06632320
   <<----------------------------------->>                     <<L2186>>06632330
                                                               <<L2186>>06632340
   LPURGE;                                                     <<L2186>>06632350
                                                               <<L2186>>06632360
END;  << LDELETE >>                                            <<L2186>>06632370
$PAGE                                                          <<L2186>>06633000
PROCEDURE LRELEASE;                                            <<L2186>>06633010
                                                               <<L2186>>06633020
   OPTION PRIVILEGED, UNCALLABLE;                              <<L2186>>06633030
                                                               <<L2186>>06633040
<<-------------------------------------------------------------<<L2186>>06633050
<<                                                             <<L2186>>06633060
<<  Purges the current temporary LST Directory entry without   <<L2186>>06633070
<<  updating its home entry.  If the current entry in the LST  <<L2186>>06633080
<<  is not temporary, no action is taken.                      <<L2186>>06633090
<<                                                             <<L2186>>06633100
<<-------------------------------------------------------------<<L2186>>06633110
                                                               <<L2186>>06633120
BEGIN  << LRELEASE >>                                          <<L2186>>06633130
                                                               <<L2186>>06633140
INTEGER SAVE'DB;                                               <<L2186>>06633150
                                                               <<L2186>>06633160
   SAVE'DB := EXCHANGEDB(SEGTABDST);                           <<L2186>>06633170
   IF TEMP'ENTRY THEN                                          <<L2186>>06633180
      LPURGE;                                                  <<L2186>>06633190
   EXCHANGEDB (SAVE'DB);                                       <<L2186>>06633200
                                                               <<L2186>>06633210
END;  << LRELEASE >>                                           <<L2186>>06633220
$PAGE                                                          <<L2186>>06634000
END;                                                           <<S1744>>07456000
$PAGE                                                          <<S1744>>07456500
<<----------------------------------------------------------->><<S1744>>07456510
<< DATE: 12/23/85                                            >><<S1744>>07456520
<<                                                           >><<S1744>>07456530
<< SHOWALLOCATE'STATUS is a supportive routine for the       >><<S1744>>07456540
<< SHOWALLOCATE command.  It executes the functionallity     >><<S1744>>07456550
<< of the status option.  The configured size and utilization>><<S1744>>07456560
<< of the following tables are calculated and displayed:     >><<S1744>>07456570
<< CST, CSTX, CSTXBLOCK, AND LST.  The total number of       >><<S1744>>07456580
<< allocated and autoallocated programs are also printed.    >><<S1744>>07456590
<<                                                           >><<S1744>>07456600
<< PARAMETERS IN:                                            >><<S1744>>07456610
<<   LIST'FNUM    - file number of the list file.            >><<S1744>>07456620
<<   TEMP'LST'XDS - extra data segment number of the         >><<S1744>>07456630
<<               temporary LST.                              >><<S1744>>07456640
<<                                                           >><<S1744>>07456650
<< PARAMETERS OUT:                                           >><<S1744>>07456660
<<   SHOWALLOCATE - LOADER ERROR NUMBER                      >><<S1744>>07456670
<<                   0 -> NO ERROR                           >><<S1744>>07456680
<<----------------------------------------------------------->><<S1744>>07456690
INTEGER PROCEDURE SHOWALLOCATE'STATUS(LIST'FNUM,TEMP'LST'XDS); <<S1744>>07456700
  VALUE LIST'FNUM,TEMP'LST'XDS;                                <<S1744>>07456710
  INTEGER LIST'FNUM,TEMP'LST'XDS;                              <<S1744>>07456720
  OPTION UNCALLABLE;                                           <<S1744>>07456730
                                                               <<S1744>>07456740
BEGIN                                                          <<S1744>>07456750
  INTEGER CST'SIZE,                                            <<S1744>>07456760
          CSTX'SIZE,                                           <<S1744>>07456770
          XCSTB'SIZE,        <<SIZE OF XCST BLOCK PTR. TABLE>> <<S1744>>07456780
          LENGTH,            <<NUMBER OF CHARS IN THE STRING>> <<N2069>>07456790
          LST'XDS'SIZE,      <<SIZE OF CURRENT LST          >> <<S1744>>07456800
          XCSTB'FREE,        <<FREE SPACE IN XCST BLOCK PTR >> <<S1744>>07456810
          CST'FREE,          <<                        TABLE>> <<S1744>>07456820
          CSTX'FREE,                                           <<S1744>>07456830
          LST'FREE,                                            <<S1744>>07456840
          SAVEDB,                                              <<S1744>>07456850
$EDIT                                                          <<01958>>07456860
          NUMB'ALLOCATE,     <<COUNTERS FOR ALLOCATED AND   >> <<S1744>>07456870
          NUMB'AUTOALLOCATE, << AND AUTOALLOCATE PROGRAMS   >> <<S1744>>07456880
          LOCAL'AUTOALLOC'FLAG, <<AUTOALLOCATE ON/OFF FLAG >>  <<S1744>>07456890
          UTILIZATION;       <<USED TO CALUCLATE THE        >> <<S1744>>07456900
                             << UTILIZATION OF A TABLE      >> <<S1744>>07456910
                                                               <<N2069>>07456915
  LOGICAL  LST'CONFIG'SIZE;   << CONFIGURED SIZE OF THE LST >> <<N2069>>07456916
                                                               <<N2069>>07456918
  INTEGER ERROR:=0;          <<LOADER ERROR NUMBER IF ANY?  >> <<S1744>>07456920
                                                               <<S1744>>07456930
  REAL    NUMERATOR,         <<USED TO CALCULATE PERCENT    >> <<S1744>>07456940
          DENOMINATOR;       <<UTILIZATION OF TABLES.       >> <<S1744>>07456950
                                                               <<S1744>>07456960
  EQUATE                                                       <<N2069>>07456970
                                                               <<N2069>>07456980
         COL0       = 5,          <<EQUATES FOR FORMATING   >> <<S1744>>07456990
         COL1       = COL0 + 2,   << THE OUTPUT             >> <<S1744>>07457000
         COL'SIZE   = 54,                                      <<S1744>>07457010
         COL'UTILIZATION = 66;                                 <<S1744>>07457020
                                                               <<S1744>>07457030
                                                               <<S1744>>07457040
  EQUATE XCSTB'SIZE'OFFSET = 0;  <<OFFSET INTO XCSTB        >> <<S1744>>07457050
                                                               <<S1744>>07457060
$EDIT                                                          <<01958>>07457070
                                                               <<N2069>>07457075
  ARRAY TEMPBUF(0:5) = Q;                                      <<N2069>>07457076
  BYTE ARRAY TEMPBUF'B(*) = TEMPBUF;                           <<N2069>>07457077
                                                               <<N2069>>07457078
  INTEGER ARRAY CTAB'BUF(0:127) = Q;                           <<S1744>>07457080
  ARRAY OUTBUF(*) = CTAB'BUF;  <<CAN REUSE CTAB'BUF         >> <<S1744>>07457090
  BYTE ARRAY OUTBUF'B(*) = OUTBUF;                             <<S1744>>07457100
                                                               <<S1744>>07457110
<<---------------------------------------------------------->> <<S1744>>07457120
<<  SUBROUTINE BLANK'OUTBUF                                 >> <<S1744>>07457130
<<                                                          >> <<S1744>>07457140
<<  PURPOSE: TO FILL THE OUTPUT BUFFER WITH BLANKS          >> <<S1744>>07457150
<<---------------------------------------------------------->> <<S1744>>07457160
SUBROUTINE BLANK'OUTBUF;                                       <<S1744>>07457170
  BEGIN                                                        <<S1744>>07457180
  OUTBUF:="  ";                                                <<S1744>>07457190
  MOVE OUTBUF(1):=OUTBUF(0),(39);                              <<S1744>>07457200
  END;                                                         <<S1744>>07457210
                                                               <<S1744>>07457220
                                                               <<S1744>>07457230
                                                               <<S1744>>07457240
<<---------------------------------------------------------->> <<S1744>>07457250
<<*           START OF SOWALLOCATE'STATUS                  *>> <<S1744>>07457260
<<---------------------------------------------------------->> <<S1744>>07457270
                                                               <<S1744>>07457280
<<GET SIZE AND AMOUNT OF FREE SPACE FOR THE CST  >>            <<S1744>>07457290
CST'SIZE := CSTBP(CST'CONFIGURED);                             <<S1744>>07457300
CST'FREE:= CSTBP(CST'FREE'OFFSET);                             <<S1744>>07457310
                                                               <<S1744>>07457320
                                                               <<S1744>>07457330
<<GET SIZE AND AMOUNT OF FREE SPACE FOR THE CSTX >>            <<S1744>>07457340
                                                               <<S1744>>07457350
SAVEDB:=EXCHANGEDB(CSTX'DST);                                  <<S1744>>07457360
CSTX'SIZE := CSTX'TABLE(CST'CONFIGURED);                       <<S1744>>07457370
CSTX'FREE := CSTX'TABLE(CST'FREE'OFFSET);                      <<S1744>>07457380
EXCHANGEDB(SAVEDB);                                            <<S1744>>07457390
                                                               <<S1744>>07457400
<<----------------------------------------------->>            <<S1744>>07457410
<<CALCULATE AMOUNT OF FREE SPACE IN CSTX BLOCK   >>            <<S1744>>07457420
<< TABLE. ALSO, GET THE SIZE OF THE TABLE.       >>            <<S1744>>07457430
<<----------------------------------------------->>            <<S1744>>07457440
                                                               <<S1744>>07457450
XCSTB'SIZE:=CSTEXT(XCSTB'SIZE'OFFSET);                         <<S1744>>07457460
                                                               <<S1744>>07457470
XCSTB'FREE := 0;                                               <<S1744>>07457480
WHILE (XCSTB'SIZE > 0) DO                                      <<S1744>>07457490
  BEGIN                                                        <<S1744>>07457500
  IF (CSTEXT(XCSTB'SIZE) = -1)                                 <<S1744>>07457510
    THEN XCSTB'FREE := XCSTB'FREE + 1;                         <<S1744>>07457520
  XCSTB'SIZE := XCSTB'SIZE -1;                                 <<S1744>>07457530
  END; <<WHILE>>                                               <<S1744>>07457540
                                                               <<S1744>>07457550
XCSTB'SIZE:=CSTEXT(XCSTB'SIZE'OFFSET);                         <<S1744>>07457560
                                                               <<S1744>>07457570
<<-------------------------------------------------------->>   <<S1744>>07457580
<<GET THE CONF. SIZE OF THE LST FROM DST ENTRY %22 WORD 1 >>   <<01958>>07457590
<< ALSO, CALCULATE THE FREE SPACE IN THE LST AND COUNT THE>>   <<S1744>>07457600
<< NUMBER OF ALLOCATED AND AUTOALLOCATED PROGRAMS.        >>   <<S1744>>07457610
<<-------------------------------------------------------->>   <<S1744>>07457620
$EDIT VOID=07457830                                            <<01958>>07457630
                                                               <<S1744>>07457840
LST'CONFIG'SIZE :=                                             <<01958>>07457850
  DSTI(SEGTABDST*DST'ENTRY'SIZE + DST'FLAG'WORD).VMALLOCFIELD  <<01958>>07457855
                                                 * VMPAGESIZE; <<01958>>07457856
                                                               <<01958>>07457857
                                                               <<S1744>>07457860
<<-------------------------------------------------------->>   <<S1744>>07457870
<<COUNT THE NUMBER OF ALLOCATED AND AUTOALLOCATED PROGRAMS>>   <<S1744>>07457880
<<-------------------------------------------------------->>   <<S1744>>07457890
                                                               <<S1744>>07457900
NUMB'ALLOCATE := 0;                                            <<S1744>>07457910
NUMB'AUTOALLOCATE:=0;                                          <<S1744>>07457920
                                                               <<S1744>>07457930
SAVEDB:=EXCHANGEDB(TEMP'LST'XDS);                              <<S1744>>07457940
@ENTP:=HDFWDLINK(PROGFILE);  <<GET HEAD OF PROGRAM LIST   >>   <<S1744>>07457950
                                                               <<S1744>>07457960
WHILE (@ENTP<>0) DO                                            <<S1744>>07457970
  BEGIN                                                        <<S1744>>07457980
  IF (EPAUTOALLOC=1)                                           <<S1744>>07457990
    THEN NUMB'AUTOALLOCATE := NUMB'AUTOALLOCATE + 1            <<S1744>>07458000
  ELSE                                                         <<S1744>>07458010
    IF (EPA=1)                                                 <<S1744>>07458020
      THEN NUMB'ALLOCATE := NUMB'ALLOCATE + 1;                 <<S1744>>07458030
                                                               <<S1744>>07458040
  @ENTP := FWDLINK;                                            <<S1744>>07458050
  END; <<WHILE>>                                               <<S1744>>07458060
                                                               <<S1744>>07458070
<<CALCULATE FREE SPACE IN THE TEMPORARY LST             >>     <<S1744>>07458080
LST'FREE := 0;                                                 <<S1744>>07458090
@ENTP := HDFWDLINK(GARBAGE);  <<GET HEAD OF GARBAGE LIST>>     <<S1744>>07458100
                                                               <<S1744>>07458110
WHILE (@ENTP<>0) DO                                            <<S1744>>07458120
  BEGIN                                                        <<S1744>>07458130
  LST'FREE:=LST'FREE + RLENGTH;                                <<S1744>>07458140
  @ENTP:=FWDLINK;                                              <<S1744>>07458150
  END;                                                         <<S1744>>07458160
                                                               <<S1744>>07458170
LOCAL'AUTOALLOC'FLAG := SYS'AUTOALLOC'FLAG;                    <<S1744>>07458180
EXCHANGEDB(SAVEDB);                                            <<S1744>>07458190
                                                               <<S1744>>07458200
<<GET THE CURRENT SIZE OF THE LST EXTRA DATA SEGMENT.   >>     <<S1744>>07458210
<< (IT COULD BE DIFFERENT FROM THE CONFIGURED SIZE.)    >>     <<S1744>>07458220
                                                               <<S1744>>07458230
LST'XDS'SIZE := DSTI(SEGTABDST*DST'ENTRY'SIZE).DST'SEGSIZE * 4;<<01958>>07458240
                                                               <<S1744>>07458250
IF REQUESTSERVICE THEN GO GETOUT;   <<IF BREAK KEY WAS HIT>>   <<S1744>>07458260
                                                               <<S1744>>07458270
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>>     <<S1744>>07458280
<<  START OUTPUTTING ALL INFORMATION GATHERED           >>     <<S1744>>07458290
<<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>>     <<S1744>>07458300
                                                               <<S1744>>07458310
BLANK'OUTBUF;                                                  <<S1744>>07458320
MOVE OUTBUF'B(COL0):="ALLOCATION STATUS:";                     <<S1744>>07458330
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458340
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458350
                                                               <<S1744>>07458360
                                                               <<S1744>>07458370
BLANK'OUTBUF;                                                  <<S1744>>07458380
FWRITE(LIST'FNUM,OUTBUF,1,0);   <<OUTPUT A BLANK LINE>>        <<S1744>>07458390
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458400
                                                               <<S1744>>07458410
MOVE OUTBUF'B(COL1):="AUTOALLOCATE IS ";                       <<S1744>>07458420
IF (LOCAL'AUTOALLOC'FLAG = 0)                                  <<S1744>>07458430
  THEN MOVE OUTBUF'B(COL1+16):="OFF"                           <<S1744>>07458440
  ELSE MOVE OUTBUF'B(COL1+16):="ON";                           <<S1744>>07458450
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458460
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458470
                                                               <<S1744>>07458480
BLANK'OUTBUF;                                                  <<S1744>>07458490
MOVE OUTBUF'B(COL1):="NUMBER OF PROGRAMS ALLOCATED     =";     <<S1744>>07458500
ASCII(NUMB'ALLOCATE,-10,OUTBUF'B(COL1+37));                    <<S1744>>07458510
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458520
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458530
                                                               <<S1744>>07458540
BLANK'OUTBUF;                                                  <<S1744>>07458550
MOVE OUTBUF'B(COL1):="NUMBER OF PROGRAMS AUTOALLOCATED =";     <<S1744>>07458560
ASCII(NUMB'AUTOALLOCATE,-10,OUTBUF'B(COL1+37));                <<S1744>>07458570
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458580
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458590
                                                               <<S1744>>07458600
BLANK'OUTBUF;                                                  <<S1744>>07458610
FWRITE(LIST'FNUM,OUTBUF,1,0);       <<OUTPUT A BLANK LINE>>    <<S1744>>07458620
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458630
                                                               <<S1744>>07458640
FWRITE(LIST'FNUM,OUTBUF,1,0);       <<OUTPUT A BLANK LINE>>    <<S1744>>07458650
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458660
                                                               <<S1744>>07458670
MOVE OUTBUF'B(COL1):="ALLOCATION RELATED TABLES";              <<S1744>>07458680
MOVE OUTBUF'B(COL'SIZE):="SIZE     % USED";                    <<S1744>>07458690
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458700
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458710
OUTBUF'B(COL1):="-";                                           <<S1744>>07458720
MOVE OUTBUF'B(COL1+1):=OUTBUF'B(COL1),(39);                    <<S1744>>07458730
MOVE OUTBUF'B(COL'SIZE):="----     ------";                    <<S1744>>07458740
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458750
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458760
                                                               <<S1744>>07458770
BLANK'OUTBUF;                                                  <<S1744>>07458780
FWRITE(LIST'FNUM,OUTBUF,1,0);       <<OUTPUT A BLANK LINE>>    <<S1744>>07458790
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458800
                                                               <<S1744>>07458810
MOVE OUTBUF'B(COL1):="CODE SEGMENT TABLE";                     <<S1744>>07458820
ASCII(CST'SIZE,-10,OUTBUF'B(COL'SIZE+3));                      <<S1744>>07458830
NUMERATOR := REAL(CST'SIZE-CST'FREE);                          <<S1744>>07458840
DENOMINATOR:=REAL(CST'SIZE);                                   <<S1744>>07458850
UTILIZATION:=INTEGER(FIXR(NUMERATOR/DENOMINATOR*100.0));       <<S1744>>07458860
ASCII(UTILIZATION,-10,OUTBUF'B(COL'UTILIZATION));              <<S1744>>07458870
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458880
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458890
                                                               <<S1744>>07458900
BLANK'OUTBUF;                                                  <<S1744>>07458910
MOVE OUTBUF'B(COL1):="CODE SEGMENT TABLE EXTENSION";           <<S1744>>07458920
ASCII(CSTX'SIZE,-10,OUTBUF'B(COL'SIZE+3));                     <<S1744>>07458930
NUMERATOR:=REAL(CSTX'SIZE-CSTX'FREE);                          <<S1744>>07458940
DENOMINATOR:=REAL(CSTX'SIZE);                                  <<S1744>>07458950
UTILIZATION:=INTEGER(FIXR(NUMERATOR/DENOMINATOR*100.0));       <<S1744>>07458960
ASCII(UTILIZATION,-10,OUTBUF'B(COL'UTILIZATION));              <<S1744>>07458970
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07458980
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07458990
                                                               <<S1744>>07459000
BLANK'OUTBUF;                                                  <<S1744>>07459010
MOVE OUTBUF'B(COL1):="CSTX BLOCK TABLE";                       <<S1744>>07459020
ASCII(XCSTB'SIZE,-10,OUTBUF'B(COL'SIZE+3));                    <<S1744>>07459030
NUMERATOR:=REAL(XCSTB'SIZE-XCSTB'FREE);                        <<S1744>>07459040
DENOMINATOR:=REAL(XCSTB'SIZE);                                 <<S1744>>07459050
UTILIZATION:=INTEGER(FIXR(NUMERATOR/DENOMINATOR*100.0));       <<S1744>>07459060
ASCII(UTILIZATION,-10,OUTBUF'B(COL'UTILIZATION));              <<S1744>>07459070
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07459080
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07459090
                                                               <<S1744>>07459100
BLANK'OUTBUF;                                                  <<S1744>>07459110
MOVE OUTBUF'B(COL1):="LOADER SEGMENT TABLE";                   <<S1744>>07459120
                                                               <<N2069>>07459125
TEMPBUF:="  ";                                                 <<N2069>>07459126
MOVE TEMPBUF(1):=TEMPBUF(0),(5);                               <<N2069>>07459127
LENGTH:=DASCII(double(LST'CONFIG'SIZE),10,TEMPBUF'B(0));       <<N2069>>07459128
MOVE OUTBUF'B(COL'SIZE+3):=TEMPBUF'B(LENGTH-1),(-LENGTH);      <<N2069>>07459129
                                                               <<N2069>>07459130
NUMERATOR:=REAL(LST'XDS'SIZE-LST'FREE);  <<AMOUNT USED>>       <<S1744>>07459140
DENOMINATOR:=REAL(LST'CONFIG'SIZE);                            <<S1744>>07459150
UTILIZATION:=INTEGER(FIXR(NUMERATOR/DENOMINATOR*100.0));       <<S1744>>07459160
ASCII(UTILIZATION,-10,OUTBUF'B(COL'UTILIZATION));              <<S1744>>07459170
FWRITE(LIST'FNUM,OUTBUF,36,0);                                 <<S1744>>07459180
IF <> THEN GO LIST'FILE'ERROR;                                 <<S1744>>07459190
                                                               <<S1744>>07459200
GO GETOUT;                                                     <<S1744>>07459210
                                                               <<S1744>>07459220
LIST'FILE'ERROR:                                               <<S1744>>07459230
  ERROR := ERR108;  <<I/O ERROR ON SHOWALLOCATE LIST FILE >>   <<S1744>>07459240
                                                               <<S1744>>07459250
GETOUT:                                                        <<S1744>>07459260
  SHOWALLOCATE'STATUS:=ERROR;                                  <<S1744>>07459270
                                                               <<S1744>>07459280
END; <<SHOWALLOCATE'STATUS>>                                   <<S1744>>07459290
$PAGE                                                          <<S1744>>07459300
<<----------------------------------------------------------->><<S1744>>07459310
<<                                                           >><<S1744>>07459320
<<PRINT'PROG'NAMES                                           >><<S1744>>07459330
<<  OBJECTIVE                                                >><<S1744>>07459340
<<    -- supportive routine for SHOWALLOCATE                 >><<S1744>>07459350
<<    -- displays all program file names which match the file>><<S1744>>07459360
<<       set specified by the user.                          >><<S1744>>07459370
<<                                                           >><<S1744>>07459380
<<  ALGORITHM USED                                           >><<S1744>>07459390
<<                                                           >><<S1744>>07459400
<<    -- scan the program entries in the temporary LST.  If  >><<S1744>>07459410
<<       the entry matches the print option (allocated or    >><<S1744>>07459420
<<       autoallocated) then use the program file address    >><<S1744>>07459430
<<       to get the file label.                              >><<S1744>>07459440
<<                                                           >><<S1744>>07459450
<<    -- checks the file name in the file label against the  >><<S1744>>07459460
<<       file set specified using the routine "DIRMATCH"     >><<S1744>>07459470
<<                                                           >><<S1744>>07459480
<<                                                           >><<S1744>>07459490
<<  PARAMETERS IN:                                           >><<S1744>>07459500
<<       LIST'FNUM       -- file number of the list file     >><<S1744>>07459510
<<                                                           >><<S1744>>07459520
<<       FILESET         -- byte array with the file set     >><<S1744>>07459530
<<                          specified by the user.  The      >><<S1744>>07459540
<<                          file set should be 24 chars      >><<S1744>>07459550
<<                          long 8 bytes for the file name,  >><<S1744>>07459560
<<                          8 for the group and 8 for the    >><<S1744>>07459570
<<                          account.  Each name should be    >><<S1744>>07459580
<<                          buffered by blanks and be        >><<S1744>>07459590
<<                          ready to use by the procedure    >><<S1744>>07459600
<<                          DIRMATCH.                        >><<S1744>>07459610
<<                          i.e.  all @..@ should be @       >><<S1744>>07459620
<<                                all @? should be ?@        >><<S1744>>07459630
<<                                                           >><<S1744>>07459640
<<       PRINT'OPTION    -- 1 = print all allocated programs >><<S1744>>07459650
<<                          2 = print all autoallocated      >><<S1744>>07459660
<<                              programs.                    >><<S1744>>07459670
<<                                                           >><<S1744>>07459680
<<       TEMP'LST'XDS    -- the extra data segment number for>><<S1744>>07459690
<<                           the temporary LST.              >><<S1744>>07459700
<<                                                           >><<S1744>>07459710
<<                                                           >><<S1744>>07459720
<<  PARAMETERS OUT:                                          >><<S1744>>07459730
<<       PRINT'PROG'NAMES - loader error number              >><<S1744>>07459740
<<                          0 -> no error                    >><<S1744>>07459750
<<                                                           >><<S1744>>07459760
<<----------------------------------------------------------->><<E2169>>07459765
<<                                                           >><<E2169>>07459766
<<  LOADER PERFORMANCE ENHANCEMENTS:     4/23/86             >><<E2169>>07459767
<<  ===============================                          >><<E2169>>07459768
<<                                                           >><<E2169>>07459769
<<  The loader will NO longer need to get to the file label  >><<E2169>>07459770
<<  to obtain the file name.  Instead, it now accesses the   >><<E2169>>07459771
<<  PROGRAM NAME table in the LOADER AUXILIARY XDS to obtain >><<E2169>>07459772
<<  the file name.  As a result, many physical I/O's will be >><<E2169>>07459773
<<  saved with this new access implementation.               >><<E2169>>07459774
<<                                                           >><<E2169>>07459776
<<----------------------------------------------------------->><<E2169>>07459777
                                                               <<E2169>>07459778
INTEGER PROCEDURE PRINT'PROG'NAMES(LIST'FNUM,FILESET,          <<S1744>>07459780
                                    PRINT'OPTION,TEMP'LST'XDS);<<S1744>>07459790
  VALUE      LIST'FNUM,PRINT'OPTION,TEMP'LST'XDS;              <<S1744>>07459800
  INTEGER    LIST'FNUM,PRINT'OPTION,TEMP'LST'XDS;              <<S1744>>07459810
  BYTE ARRAY FILESET;                                          <<S1744>>07459820
  OPTION     UNCALLABLE;                                       <<S1744>>07459830
                                                               <<S1744>>07459840
BEGIN                                                          <<S1744>>07459850
  INTEGER        SAVE'ECSTBLK,                                 <<E2169>>07459860
                 SAVEDB,                                       <<S1744>>07459870
$EDIT                                                          <<E2169>>07459880
                 SHARECOUNT,       <<SHARE COUNT OF PROGRAM  >><<S1744>>07459890
                 MATCH'COUNT,      <<NUMBER OF PROGRAMS      >><<S1744>>07459900
                                   <<FOUND MATCHING FILESET  >><<S1744>>07459910
$EDIT                                                          <<E2169>>07459920
                 FROM'INDEX,       <<USED TO FORMAT THE FILE >><<S1744>>07459930
                 TO'INDEX;         <<  NAME TO FN.GRP.ACT    >><<S1744>>07459940
  INTEGER        ERROR:=0;         <<LOAD ERROR NUMBER IF ANY>><<S1744>>07459950
                                                               <<S1744>>07459960
$EDIT VOID=07460070                                            <<E2169>>07459970
  EQUATE         FNAME=0,  << INDEX INTO THE PROGRAM NAME   >> <<E2169>>07460060
                 GROUP=8,  << ARRAY FOR THE PROGRAM NAME,   >> <<E2169>>07460070
                 ACCT =16; << GROUP, AND ACCOUNT.           >> <<E2169>>07460080
                                                               <<S1744>>07460090
  EQUATE         PRINT'ALLOCATE = 1, <<EQUATES FOR THE PRINT>> <<S1744>>07460100
                 PRINT'AUTOALLOC= 2, << OPTION.             >> <<S1744>>07460110
                 COL0           = 5,      <<EQUATES FOR     >> <<S1744>>07460120
                 COL1           =COL0+2,  <<FORMATING OUTPUT>> <<S1744>>07460130
                 COL'SHARECNT   =COL0+34;                      <<S1744>>07460140
                                                               <<S1744>>07460150
  LOGICAL ARRAY  OUTBUF(0:39) = Q;                             <<S1744>>07460160
  BYTE ARRAY OUTBUF'B (*) = OUTBUF;                            <<S1744>>07460170
                                                               <<E2169>>07460180
  BYTE ARRAY  PROGNAME(0:23) = Q;                              <<E2169>>07460190
                                                               <<S1744>>07460200
                                                               <<S1744>>07460210
<<---------------------------------------------------------->> <<S1744>>07460220
<<*              START OF PRINT'PROG'NAMES                 *>> <<S1744>>07460230
<<---------------------------------------------------------->> <<S1744>>07460240
MATCH'COUNT:=0;                                                <<S1744>>07460250
                                                               <<S1744>>07460260
SAVEDB:=EXCHANGEDB(TEMP'LST'XDS);                              <<S1744>>07460270
@ENTP:=HDFWDLINK(PROGFILE);  <<GET HEAD OF PROGRAM LINK LIST>> <<S1744>>07460280
                                                               <<S1744>>07460290
WHILE (@ENTP<>0)  DO                                           <<S1744>>07460300
  BEGIN                                                        <<S1744>>07460310
                                                               <<S1744>>07460320
 <<-------------------------------------------------------->>  <<S1744>>07460330
 << IF:   THE FILE IS ALLOCATED AND                        >>  <<S1744>>07460340
 <<           THE PRINT OPTION = PRINT ALLOCATED FILES     >>  <<S1744>>07460350
 <<       OR                                               >>  <<S1744>>07460360
 <<       THE FILE IS AUTOALLOCATED AND                    >>  <<S1744>>07460370
 <<           THE PRINT OPTION = PRINT AUTOALLOCATED FILES >>  <<S1744>>07460380
 <<-------------------------------------------------------->>  <<S1744>>07460390
  IF ((EPA=1) LAND (EPAUTOALLOC<>1) LAND                       <<S1744>>07460400
      (PRINT'OPTION=PRINT'ALLOCATE)) OR                        <<S1744>>07460410
     ((EPAUTOALLOC=1) LAND (PRINT'OPTION=PRINT'AUTOALLOC))     <<S1744>>07460420
    THEN BEGIN                                                 <<S1744>>07460430
                                                               <<S1744>>07460440
    IF REQUESTSERVICE THEN GO GETOUT; <<WAS BREAK KEY HIT? >>  <<S1744>>07460450
$EDIT VOID=07460510                                            <<E2169>>07460460
                                                               <<E2169>>07460470
    SETSECPTRS;  << SET THE SECONDARY POINTERS FOR THE >>      <<E2169>>07460480
                 << CURRENT PROGRAM ENTRY IN THE LST   >>      <<E2169>>07460490
                                                               <<S1744>>07460520
    <<KEEP A LOCAL COPY OF SHARECOUNT FROM THE PROGRAM     >>  <<S1744>>07460530
    << ENTRY OF THE LST.  IF THE PROGRAM IS ALLOCATED ONE  >>  <<S1744>>07460540
    << MUST BE SUBTRACTED FROM THE SHARECOUNT TO GET THE   >>  <<S1744>>07460550
    << TRUE SHARE COUNT.                                   >>  <<S1744>>07460560
                                                               <<S1744>>07460570
    IF (EPAUTOALLOC<>1)                                        <<S1744>>07460580
      THEN SHARECOUNT:=ESHR  - 1                               <<S1744>>07460590
      ELSE SHARECOUNT:=ESHR;                                   <<S1744>>07460600
                                                               <<S1744>>07460610
    SAVE'ECSTBLK := ECSTBLK;<< SAVE CSTX BLOCK INDEX OF PROG >><<E2169>>07460620
    EXCHANGEDB(0);                                             <<E2169>>07460630
                                                               <<E2169>>07460640
    GET'PROGNAME (SAVE'ECSTBLK, PROGNAME);                     <<E2169>>07460650
                                                               <<E2169>>07460660
$EDIT VOID=07460910                                            <<E2169>>07460670
                                                               <<E2169>>07460770
    << CHECK THE FILE NAME (IN THE PROGNAME ARRAY) WITH  >>    <<E2169>>07460780
    << THE FILE SET SPECIFIED BY THE USER TO SEE IF IT   >>    <<E2169>>07460790
    << SHOULD BE OUTPUTTED.                              >>    <<E2169>>07460800
                                                               <<E2169>>07460810
    IF (DIRMATCH (FILESET(FNAME),PROGNAME(FNAME)) = 0)  AND    <<E2169>>07460820
       (DIRMATCH (FILESET(GROUP),PROGNAME(GROUP)) = 0)  AND    <<E2169>>07460830
       (DIRMATCH (FILESET(ACCT), PROGNAME(ACCT) ) = 0)  THEN   <<E2169>>07460840
      BEGIN                                                    <<E2169>>07460850
                                                               <<E2169>>07460860
      MATCH'COUNT := MATCH'COUNT + 1;                          <<S1744>>07460920
                                                               <<S1744>>07460930
      <<FORMAT THE NAME FOR OUTPUT                           >><<S1744>>07460940
      <<REMOVE BLANKS, PUT PERIODS IN.  FNAME.GROUP.ACCT     >><<S1744>>07460950
                                                               <<S1744>>07460960
      OUTBUF:="  ";                                            <<S1744>>07460970
      MOVE OUTBUF(1):=OUTBUF(0),(39);                          <<S1744>>07460980
                                                               <<S1744>>07460990
    <<FILL OUTBUF WITH ' .' TO AID IN ROW ALLIGNMENT>>         <<S1744>>07461000
                                                               <<S1744>>07461010
      OUTBUF(COL1/2) := " .";                                  <<S1744>>07461020
      MOVE OUTBUF(COL1/2 +1):=                                 <<S1744>>07461030
                    OUTBUF(COL1/2),((COL'SHARECNT-COL1)/2-1);  <<S1744>>07461040
                                                               <<S1744>>07461050
      FROM'INDEX := 0;                                         <<S1744>>07461060
      TO'INDEX:=COL1;                                          <<S1744>>07461070
      WHILE (FROM'INDEX<24) DO                                 <<S1744>>07461080
                                                               <<S1744>>07461090
        BEGIN                                                  <<S1744>>07461100
        IF PROGNAME(FROM'INDEX)<>" " THEN                      <<E2169>>07461110
          BEGIN                                                <<S1744>>07461120
          OUTBUF'B(TO'INDEX):=PROGNAME(FROM'INDEX);            <<E2169>>07461130
          TO'INDEX:=TO'INDEX+1;                                <<S1744>>07461140
          END;                                                 <<S1744>>07461150
                                                               <<S1744>>07461160
        FROM'INDEX:=FROM'INDEX+1;                              <<S1744>>07461170
        IF (FROM'INDEX=GROUP) OR (FROM'INDEX=ACCT) THEN        <<S1744>>07461180
          BEGIN                                                <<S1744>>07461190
          OUTBUF'B(TO'INDEX):=".";                             <<S1744>>07461200
          TO'INDEX:=TO'INDEX+1;                                <<S1744>>07461210
          END;                                                 <<S1744>>07461220
        END; <<WHILE FROM'INDEX<24>>                           <<S1744>>07461230
                                                               <<S1744>>07461240
      OUTBUF'B(TO'INDEX):=" "; <<MAKE SURE A BLANK FOLLOWS   >><<S1744>>07461250
                               << THEN FILE NAME.            >><<S1744>>07461260
                                                               <<S1744>>07461270
      <<PUT THE SHARE COUNT INTO THE OUTPUT BUFFER>>           <<S1744>>07461280
      ASCII(SHARECOUNT,-10,OUTBUF'B(COL'SHARECNT+5));          <<S1744>>07461290
                                                               <<S1744>>07461300
      FWRITE(LIST'FNUM,OUTBUF,36,0);                           <<S1744>>07461310
      IF <> THEN                                               <<S1744>>07461320
        BEGIN                                                  <<S1744>>07461330
        ERROR:=ERR108; <<I/O ERROR ON SHOWALLOCATE LIST FILE>> <<S1744>>07461340
        GO GETOUT;                                             <<S1744>>07461350
        END;                                                   <<S1744>>07461360
                                                               <<E2169>>07461365
      END   << END OF IF DIRMATCH >>                           <<E2169>>07461370
$edit                                                          <<E2169>>07461371
                                                               <<S1744>>07461380
    END; <<THEN>>                                              <<S1744>>07461390
  EXCHANGEDB(TEMP'LST'XDS);                                    <<S1744>>07461400
                                                               <<S1744>>07461410
  @ENTP:=FWDLINK;                                              <<S1744>>07461420
  END;<<WHILE @ENTP<>0>>                                       <<S1744>>07461430
                                                               <<S1744>>07461440
  EXCHANGEDB(SAVEDB);                                          <<S1744>>07461450
                                                               <<S1744>>07461460
<<OUTPUT THE MATCH'COUNT>>                                     <<S1744>>07461470
  OUTBUF:="  ";                                                <<S1744>>07461480
  MOVE OUTBUF(1):=OUTBUF,(39);                                 <<S1744>>07461490
  FWRITE(LIST'FNUM,OUTBUF,1,0);  <<OUTPUT A BLANK LINE>>       <<S1744>>07461500
  IF <> THEN                                                   <<S1744>>07461510
    BEGIN                                                      <<S1744>>07461520
    ERROR := ERR108;  <<I/O ERROR ON SHOWALLOCATE LIST FILE>>  <<S1744>>07461530
    GO GETOUT;                                                 <<S1744>>07461540
    END;                                                       <<S1744>>07461550
  MOVE OUTBUF'B(COL1):="NUMBER OF PROGRAMS FOUND = ";          <<S1744>>07461560
  ASCII(MATCH'COUNT,10,OUTBUF'B(COL1+27));                     <<S1744>>07461570
  FWRITE(LIST'FNUM,OUTBUF,36,0);                               <<S1744>>07461580
  IF <> THEN                                                   <<S1744>>07461590
    BEGIN                                                      <<S1744>>07461600
    ERROR:=ERR108;  <<I/O ERROR ON SHOWALLOCATE LIST FILE>>    <<S1744>>07461610
    GO GETOUT;                                                 <<S1744>>07461620
    END;                                                       <<S1744>>07461630
                                                               <<S1744>>07461640
GETOUT:                                                        <<S1744>>07461650
  PRINT'PROG'NAMES:=ERROR;                                     <<S1744>>07461660
  EXCHANGEDB(SAVEDB);                                          <<S1744>>07461670
END;  <<PRINT'PROG'NAMES>>                                     <<S1744>>07461680
                                                               <<S1744>>07461690
$PAGE                                                          <<S1744>>07461700
<<----------------------------------------------------------->><<S1744>>07461710
<< DATE: 12/23/85                                            >><<S1744>>07461720
<<                                                           >><<S1744>>07461730
<< SHOWALLOCATE executes the MPE command "SHOWALLOCATE".  A  >><<S1744>>07461740
<< copy of the LST is made in a temporary extra data segment >><<S1744>>07461750
<< (so not to hold up the loader) and control is passed      >><<S1744>>07461760
<< to supportive procedures to execute the command.          >><<S1744>>07461770
<<                                                           >><<S1744>>07461780
<<                                                           >><<S1744>>07461790
<< PARAMETERS IN:                                            >><<S1744>>07461800
<<   FILESET - 24 char byte array specifying the fully       >><<S1744>>07461810
<<             qualified file name to list. 8 characters     >><<S1744>>07461820
<<             for each the filename, group and account.     >><<S1744>>07461830
<<             Each name must be padded with blanks. No      >><<S1744>>07461840
<<             periods.                                      >><<S1744>>07461850
<<                                                           >><<S1744>>07461860
<<             (It must be in the format for the "DIRMATCH") >><<S1744>>07461870
<<             (routine.                                   ) >><<S1744>>07461880
<<             (  ie.  all @@@@....@@@@ converted to @     ) >><<S1744>>07461890
<<             (       all @?           converted to ?@    ) >><<S1744>>07461900
<<                                                           >><<S1744>>07461910
<<   OPTIONS   - Specifies which option of the SHOWALLOCATE  >><<S1744>>07461920
<<              command the user chose.                      >><<S1744>>07461930
<<                  0 - STATUS                               >><<S1744>>07461940
<<                  1 - ALLOCATE                             >><<S1744>>07461950
<<                  2 - AUTOALLOCATE                         >><<S1744>>07461960
<<                  3 - ALL                                  >><<S1744>>07461970
<<                                                           >><<S1744>>07461980
<<   LIST'FNUM - file number of the list file.               >><<S1744>>07461990
<<                                                           >><<S1744>>07462000
<< PARAMETERS OUT:                                           >><<S1744>>07462010
<<   SHOWALLOCATE - LOADER ERROR NUMBER                      >><<S1744>>07462020
<<                     0 - NO ERROR                          >><<S1744>>07462030
<<----------------------------------------------------------->><<S1744>>07462040
INTEGER PROCEDURE SHOWALLOCATE(LIST'FNUM,FILESET,OPTIONS);     <<S1744>>07462050
  VALUE LIST'FNUM,OPTIONS;                                     <<S1744>>07462060
  INTEGER LIST'FNUM,OPTIONS;                                   <<S1744>>07462070
  BYTE ARRAY FILESET;                                          <<S1744>>07462080
  OPTION UNCALLABLE;                                           <<S1744>>07462090
                                                               <<S1744>>07462100
BEGIN                                                          <<S1744>>07462110
  INTEGER TEMP'LST'SIZE;   <<SIZE TO MAKE THE TEMPORARY LST >> <<S1839>>07462120
  INTEGER TEMP'LST'XDS:=0;                                     <<S1839>>07462130
  INTEGER SAVE'LSTSIR;                                         <<S1839>>07462140
  INTEGER SAVEDB:=-1;                                          <<S1839>>07462150
                                                               <<S1839>>07462160
  LOGICAL LOCAL'AUTOALLOC'FLAG;  <<AUTOALLOCATE ON OR OFF?  >> <<S1744>>07462170
                                                               <<S1744>>07462180
  EQUATE PRINT'ALLOCATE = 1,<<EQUATES FOR PRINT'PROG'NAMES  >> <<S1744>>07462190
         PRINT'AUTOALLOC= 2,                                   <<S1744>>07462200
                                                               <<S1744>>07462210
         COL0           = 5,<<EQUATE FOR FORMATTING OUTPUT  >> <<S1744>>07462220
         COL'SHARECNT   = COL0+34;                             <<S1744>>07462230
                                                               <<S1744>>07462240
  INTEGER ERROR :=0;        <<ERROR MESSAGE NUMBER IF ANY?  >> <<S1744>>07462250
  BYTE ARRAY OUTBUF(0:72) = Q;                                 <<S1744>>07462260
                                                               <<S1744>>07462270
  LABEL GETOUT,LIST'FILE'ERROR;                                <<S1744>>07462280
                                                               <<S1744>>07462290
                                                               <<S1744>>07462300
<<-------------------------------------------------------->>   <<S1744>>07462310
<<**                 START OF SHOWALLOCATE              **>>   <<S1744>>07462320
<<-------------------------------------------------------->>   <<S1744>>07462330
                                                               <<S1744>>07462340
IF REQUESTSERVICE THEN GO GETOUT;  <<IF BREAK KEY WAS SET>>    <<S1744>>07462350
                                                               <<S1744>>07462360
                                                               <<S1744>>07462370
<<MAKE COPY OF LST IN TEMPORARY LST>>                          <<S1744>>07462380
TEMP'LST'SIZE:= DSTI(SEGTABDST*DST'ENTRY'SIZE).DST'SEGSIZE * 4;<<01958>>07462390
TEMP'LST'XDS  := GETDATASEG(TEMP'LST'SIZE,TEMP'LST'SIZE);      <<S1744>>07462400
IF <> THEN                                                     <<S1744>>07462410
  BEGIN                                                        <<S1744>>07462420
  ERROR:=ERR104;  <<UNABLE TO OBTAIN AN EXTRA DATA SEGMENT>>   <<S1744>>07462430
  GO GETOUT;                                                   <<S1744>>07462440
  END;                                                         <<S1744>>07462450
                                                               <<S1744>>07462460
SAVEDB := EXCHANGEDB(TEMP'LST'XDS);                            <<S1744>>07462470
SAVE'LSTSIR := GETSIR(SEGTABSIR);                              <<S1744>>07462480
TOS:= 0;            <<TARGET ADDRESS>>                         <<S1744>>07462490
TOS:=SEGTABDST;     <<SOURCE XDS>>                             <<S1744>>07462500
TOS:=0;             <<SOURCE ADDRESS>>                         <<S1744>>07462510
TOS:=TEMP'LST'SIZE; <<COUNT TO MOVE >>                         <<S1744>>07462520
ASSEMBLE (MFDS 4);                                             <<S1744>>07462530
                                                               <<S1744>>07462540
RELSIR(SEGTABSIR,SAVE'LSTSIR);                                 <<S1744>>07462550
                                                               <<S1744>>07462560
LOCAL'AUTOALLOC'FLAG := SYS'AUTOALLOC'FLAG; <<GET LOCAL COPY>> <<S1744>>07462570
                                                               <<S1744>>07462580
EXCHANGEDB(SAVEDB);                                            <<S1744>>07462590
                                                               <<S1744>>07462600
CASE OPTIONS OF                                                <<S1744>>07462610
  BEGIN                                                        <<S1744>>07462620
  << 0 - STATUS >>                                             <<S1744>>07462630
  ERROR:=SHOWALLOCATE'STATUS(LIST'FNUM,TEMP'LST'XDS);          <<S1744>>07462640
                                                               <<S1744>>07462650
  << 1 - ALLOCATE>>                                            <<S1744>>07462660
  BEGIN                                                        <<S1744>>07462670
  OUTBUF := " ";                                               <<S1744>>07462680
  MOVE OUTBUF(1):=OUTBUF(0),(71);                              <<S1744>>07462690
  MOVE OUTBUF(COL0):="ALLOCATED PROGRAMS";                     <<S1744>>07462700
  MOVE OUTBUF(COL'SHARECNT):="SHARE COUNT";                    <<S1744>>07462710
  FWRITE(LIST'FNUM,OUTBUF,36,0);                               <<S1744>>07462720
  IF <> THEN GO LIST'FILE'ERROR;                               <<S1744>>07462730
  OUTBUF(COL0):="-";                                           <<S1744>>07462740
  MOVE OUTBUF(COL0+1):=OUTBUF(COL0),(17);                      <<S1744>>07462750
  MOVE OUTBUF(COL'SHARECNT):="-----------";                    <<S1744>>07462760
  FWRITE(LIST'FNUM,OUTBUF,36,0);                               <<S1744>>07462770
  IF <> THEN GO LIST'FILE'ERROR;                               <<S1744>>07462780
                                                               <<S1744>>07462790
  ERROR:=PRINT'PROG'NAMES(LIST'FNUM,FILESET,                   <<S1744>>07462800
                   PRINT'ALLOCATE,TEMP'LST'XDS);               <<S1744>>07462810
  END;                                                         <<S1744>>07462820
                                                               <<S1744>>07462830
  << 2 - AUTOALLOCATE>>                                        <<S1744>>07462840
  BEGIN                                                        <<S1744>>07462850
  OUTBUF:=" ";                                                 <<S1744>>07462860
  MOVE OUTBUF(1):=OUTBUF,(71);                                 <<S1744>>07462870
  IF (LOCAL'AUTOALLOC'FLAG = 1) THEN     <<AUTOALLOCATE IS ON>><<S1744>>07462880
    BEGIN                                                      <<S1744>>07462890
    MOVE OUTBUF(COL0):="AUTOALLOCATED PROGRAMS";               <<S1744>>07462900
    MOVE OUTBUF(COL'SHARECNT):="SHARE COUNT";                  <<S1744>>07462910
    FWRITE(LIST'FNUM,OUTBUF,36,0);                             <<S1744>>07462920
    IF <> THEN  GO LIST'FILE'ERROR;                            <<S1744>>07462930
    MOVE OUTBUF(COL0):="-";                                    <<S1744>>07462940
    MOVE OUTBUF(COL0+1):=OUTBUF(COL0),(21);                    <<S1744>>07462950
    MOVE OUTBUF(COL'SHARECNT):="-----------";                  <<S1744>>07462960
    FWRITE(LIST'FNUM,OUTBUF,36,0);                             <<S1744>>07462970
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07462980
                                                               <<S1744>>07462990
    ERROR:=PRINT'PROG'NAMES(LIST'FNUM,FILESET,                 <<S1744>>07463000
                     PRINT'AUTOALLOC,TEMP'LST'XDS);            <<S1744>>07463010
    END                                                        <<S1744>>07463020
  ELSE                                                         <<S1744>>07463030
    BEGIN                                                      <<S1744>>07463040
    MOVE OUTBUF(COL0):="AUTOALLOCATE IS OFF";                  <<S1744>>07463050
    FWRITE(LIST'FNUM,OUTBUF,36,0);                             <<S1744>>07463060
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463070
                                                               <<S1744>>07463080
    END; <<ELSE>>                                              <<S1744>>07463090
  END; <<2 - AUTOALLOCATE>>                                    <<S1744>>07463100
                                                               <<S1744>>07463110
  << 3 - ALL >>                                                <<S1744>>07463120
  BEGIN                                                        <<S1744>>07463130
  OUTBUF(0) := " ";                                            <<S1744>>07463140
  MOVE OUTBUF(1):=OUTBUF(0),(71);                              <<S1744>>07463150
  MOVE OUTBUF(COL0):="ALLOCATED PROGRAMS";                     <<S1744>>07463160
  MOVE OUTBUF(COL'SHARECNT):="SHARE COUNT";                    <<S1744>>07463170
  FWRITE(LIST'FNUM,OUTBUF,36,0);                               <<S1744>>07463180
  IF <> THEN GO LIST'FILE'ERROR;                               <<S1744>>07463190
  OUTBUF(COL0):="-";                                           <<S1744>>07463200
  MOVE OUTBUF(COL0+1):=OUTBUF(COL0),(17);                      <<S1744>>07463210
  MOVE OUTBUF(COL'SHARECNT):="-----------";                    <<S1744>>07463220
  FWRITE(LIST'FNUM,OUTBUF,36,0);                               <<S1744>>07463230
  IF <> THEN GO LIST'FILE'ERROR;                               <<S1744>>07463240
                                                               <<S1744>>07463250
  ERROR:=PRINT'PROG'NAMES(LIST'FNUM,FILESET,                   <<S1744>>07463260
                   PRINT'ALLOCATE,TEMP'LST'XDS);               <<S1744>>07463270
  IF (ERROR <> 0) THEN GO GETOUT;                              <<S1744>>07463280
                                                               <<S1744>>07463290
  IF (LOCAL'AUTOALLOC'FLAG = 1) THEN    <<AUTOALLOCATE IS ON>> <<S1744>>07463300
    BEGIN                                                      <<S1744>>07463310
    MOVE OUTBUF:="  ";                                         <<S1744>>07463320
    FWRITE(LIST'FNUM,OUTBUF,1,0);  <<OUTPUT A BLANK LINE>>     <<S1744>>07463330
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463340
    FWRITE(LIST'FNUM,OUTBUF,1,0);  <<OUTPUT A BLANK LINE>>     <<S1744>>07463350
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463360
                                                               <<S1744>>07463370
    MOVE OUTBUF(COL0):="AUTOALLOCATED PROGRAMS";               <<S1744>>07463380
    MOVE OUTBUF(COL'SHARECNT) := "SHARE COUNT";                <<S1744>>07463390
    FWRITE(LIST'FNUM,OUTBUF,36,0);                             <<S1744>>07463400
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463410
    MOVE OUTBUF(COL0):="-";                                    <<S1744>>07463420
    MOVE OUTBUF(COL0+1):=OUTBUF(COL0),(21);                    <<S1744>>07463430
    MOVE OUTBUF(COL'SHARECNT):="-----------";                  <<S1744>>07463440
    FWRITE(LIST'FNUM,OUTBUF,36,0);                             <<S1744>>07463450
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463460
                                                               <<S1744>>07463470
    ERROR:=PRINT'PROG'NAMES(LIST'FNUM,FILESET,                 <<S1744>>07463480
                     PRINT'AUTOALLOC,TEMP'LST'XDS);            <<S1744>>07463490
    IF (ERROR <> 0) THEN GO GETOUT;                            <<S1744>>07463500
    END;<<THEN>>                                               <<S1744>>07463510
                                                               <<S1744>>07463520
    MOVE OUTBUF:="  ";                                         <<S1744>>07463530
    FWRITE(LIST'FNUM,OUTBUF,1,0);  <<OUTPUT A BLANK LINE>>     <<S1744>>07463540
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463550
    FWRITE(LIST'FNUM,OUTBUF,1,0);  <<OUTPUT A BLANK LINE>>     <<S1744>>07463560
    IF <> THEN GO LIST'FILE'ERROR;                             <<S1744>>07463570
                                                               <<S1744>>07463580
  ERROR:=SHOWALLOCATE'STATUS(LIST'FNUM,TEMP'LST'XDS);          <<S1744>>07463590
  END; <<3 - ALL>>                                             <<S1744>>07463600
                                                               <<S1744>>07463610
END; <<CASE>>                                                  <<S1744>>07463620
                                                               <<S1744>>07463630
GO GETOUT;                                                     <<S1744>>07463640
LIST'FILE'ERROR:                                               <<S1744>>07463650
  ERROR:=ERR108;  <<I/O ERROR ON SHOWALLOCATE LIST FILE>>      <<S1744>>07463660
                                                               <<S1744>>07463670
GETOUT:                                                        <<S1744>>07463680
  SHOWALLOCATE := ERROR;                                       <<S1744>>07463690
                                                               <<S1744>>07463700
IF (ERROR<>0)                                                  <<S1839>>07463701
  THEN GENMSG(9,ERROR);                                        <<S1839>>07463702
                                                               <<S1839>>07463703
IF (SAVEDB <> -1) THEN EXCHANGEDB(SAVEDB);                     <<S1839>>07463710
IF (TEMP'LST'XDS <> 0)                                         <<S1839>>07463720
  THEN RELDATASEG(TEMP'LST'XDS);                               <<S1839>>07463721
END; <<SHOWALLOCATE>>                                          <<S1744>>07463730
$PAGE                                                          <<S1744>>07463740
  INTEGER COMMAND := 0;     <<BUFFER FOR WORD 0 OF LCT>>       <<L1608>>07536000
$EDIT VOID=07560000                                            <<.2086>>07550000
                                                               <<.2086>>07551000
EQUATE                                                         <<.2086>>07552000
  SYSTEMDL=10,        !SUBSYSTEM DL AREA SIZE                  <<.2086>>07553000
  XTRAMAXDATA=%2000,  !STACK SPACE FOR SYSTEM USAGE            <<.2086>>07554000
  STACKOVERFLOW=128;  !STACKOVERFLOW BACKUP ALLOCATION AREA    <<.2086>>07555000
                                                               <<.2086>>07556000
                                                               <<.2086>>07961000
                                                               <<.2086>>07986000
  COMMAND.(2:5) := FLAGS.(10:5);  <<FLAGS FOR LCT>>            <<L1608>>08901000
                     COMMAND,JSMP,SAVESIR,PVINFO);             <<L1608>>08925000
                                                               <<S1744>>08985100
                                                               <<S1744>>08985200
  <<-------------------------------------------->>             <<S1744>>08985300
  <<AUTOALLOCATE THIS FILE IF:                  >>             <<S1744>>08985400
  <<  1)  It's currently not allocated.         >>             <<S1744>>08985500
  <<  2)  Auto-allocate is enabled.             >>             <<S1744>>08985600
  <<  3)  The program is not on a private vol.  >>             <<S1744>>08985700
  <<  4)  It is not a temporary program.        >>             <<S1744>>08985800
  <<-------------------------------------------->>             <<S1744>>08985900
  IF (EPA<>1) AND (SYS'AUTOALLOC'FLAG = 1) AND                 <<S1744>>08986000
     (EPVINFO'PROG=0) AND (NOT TEMP'FILE(PROGKEY))             <<S1744>>08986100
    THEN BEGIN                                                 <<S1744>>08986200
    EPA := 1;           <<SET ALLOCATE BIT    >>               <<S1744>>08986300
    EPAUTOALLOC := 1;   <<SET AUTOALLOCATE BIT>>               <<S1744>>08986400
    END; <<THEN>>                                              <<S1744>>08986500
                                                               <<S1744>>08986600
                                                               <<.2086>>09196000
                                                               <<.2086>>09226000
                                                               <<.2086>>09236000
                                                               <<.2086>>09266000
                                                               <<.2086>>09276000
                                                               <<.2086>>09321000
       S1:=S1+XTRAMAXDATA;  !ADD SYSTEM STACK USAGE AREA       <<.2086>>09346000
                                                               <<.2086>>09361000
  TOS := [10/0,6/16];  ASSEMBLE(XCH,ZERO);                     <<R1624>>09800000
   INTEGER SEG'DESCRIPTOR'IDX,  <<STARTING SEGMENT DESCRIPTOR>><<11662>>09896100
           START'CST'IDX,    <<RECORD OFFSET FOR STARTING CST>><<11662>>09896200
           STARTINGSEG;      <<STARTING SEGMENT NUMBER       >><<11662>>09896300
   DOUBLE  SEG'DESC'RECNO,   <<SEGMENT DESCRIPTOR RECORD NO. >><<11662>>09896400
           START'CST'RECNO;  <<CST REMAPPING ARRAY RECORD NO.>><<11662>>09896500
      IF (EPAUTOALLOC=1) AND (ESHR=0) AND                      <<02202>>10131000
         ( (LIBRARY<>ELIB) OR (LMAP) )  THEN                   <<02202>>10131100
        BEGIN                    <<UNLOAD BECAUSE ITS AUTO- >> <<R1624>>10132000
        EPA:=0;              <<RESET ALLOCATE BIT>>            <<S1744>>10132100
        EPAUTOALLOC:=0;      <<RESET AUTOALLOCATE BIT>>        <<S1744>>10132200
        DELETE'AUTOALLOC'TABLE;  <<ALLOCATED, SHARECOUNT = 0>> <<R1624>>10132300
        SETSECPTRS;                                            <<R1624>>10132310
        ADJREFCOUNTS(-1);        <<AND TRYING TO BE LOADED  >> <<R1624>>10132400
        END  <<THEN>>            <<WITH DIFFERENT LIB SEARCH>> <<R1624>>10132500
      ELSE                                                     <<R1624>>10133000
        BEGIN                                                  <<R1624>>10134000
        << ------------------------------------------------- >><<11662>>10140000
        << NEED TO BUILD RETURN VALUE ON TOS AS FOLLOWS:     >><<11662>>10140100
        <<         |------------------------|                >><<11662>>10140200
        <<         | M | P | STARTING CST #  |               >><<11727>>10140300
        <<         |------------------------|                >><<11662>>10140400
        << WHERE M (BIT 0:1) IS 1 IF LOADED IN PM ELSE 0,    >><<11727>>10140500
        <<       P (BIT 1:1) IS 1 IF PHYSICALLY MAPPED       >><<11727>>10140510
        <<                   ELSE IT IS 0.                   >><<11727>>10140520
        <<                                                   >><<11662>>10140600
        << WE WILL GET STARTING CST # FROM CST RE-MAPPING    >><<11662>>10140700
        << ARRAY AND M-BIT FROM SEG. DESCRIPTOR ARRAY AT     >><<11662>>10140800
        << THE BEGINNING OF THE PROGRAM FILE.                >><<11662>>10140900
        <<                                                   >><<11662>>10141000
        << THE LOCAL ARRAY PROGREC0 (SBUF IN THE LST) HAS    >><<11662>>10141100
        << THE FIRST 128 WORDS OF THE PROGRAM FILE IN IT.    >><<11662>>10141200
        << DEPENDING ON THE NUMBER OF SEGMENTS IN THE PROGRAM>><<11662>>10141300
        << IT MAY BE NECESSARY TO READ IN MORE RECORDS WHICH >><<11662>>10141400
        << WOULD DESTROY THE DATA IN SBUF.  IF THIS DATA IS  >><<11662>>10141500
        << NEEDED LATER IN THE LOAD PROCESS IT WILL HAVE TO  >><<11662>>10141600
        << BE REMEMBERED AND RESTORED.                       >><<11662>>10141700
        <<                                                   >><<11662>>10141800
        << ------------------------------------------------- >><<11662>>10141900
                                                               <<11662>>10142000
        STARTINGSEG := PSTARTINGSEG; << GET LOCAL COPY >>      <<11662>>10142010
                                                               <<11662>>10142020
        <<CALCULATE RECORD NUMBER AND OFFSET FOR STARTING   >> <<11662>>10144100
        <<CST IN THE CST REMAPPING ARRAY.                   >> <<11662>>10144200
        TOS := (PCST'REMAP+((STARTINGSEG)&LSR(1)));            <<11662>>10145000
        START'CST'IDX:=S0.(9:7);                 << MOD 128 >> <<S1946>>10150000
        START'CST'RECNO:= DOUBLE(TOS.(0:9));     << DIV 128 >> <<S1946>>10155000
                                                               <<11662>>10160000
        <<CALCULATE RECORD NUMBER AND OFFSET FOR STARTING   >> <<11662>>10160100
        <<SEGMENTS SEGMENT DESCRIPTOR ARRAY ENTRY.          >> <<11662>>10160200
        TOS := (PCST'REMAP+((PNRSEGS+1)&LSR(1))+STARTINGSEG);  <<11662>>10160300
        SEG'DESCRIPTOR'IDX := S0.(9:7);          << MOD 128 >> <<S1946>>10160400
        SEG'DESC'RECNO := DOUBLE(TOS.(0:9));     << DIV 128 >> <<S1946>>10160500
                                                               <<11662>>10160600
                                                               <<11662>>10160700
        << IS RE-MAPPING ARRAY ENTRY IN FIRST RECORD? >>       <<11662>>10160710
        IF (START'CST'RECNO <> 0D)                             <<11662>>10160800
          THEN FREADDIR(PROGFNUM,PROGREC0,128,START'CST'RECNO);<<11662>>10160900
                                                               <<11662>>10161000
        IF (STARTINGSEG.(15:1) = 1)    << ODD ? >>             <<11662>>10161100
           THEN TOS := PROGREC0(START'CST'IDX).(8:8)           <<11662>>10161200
           ELSE TOS := PROGREC0(START'CST'IDX).(0:8);          <<11662>>10161300
                                                               <<11662>>10161400
        << IS SEG DESC. ARRAY ENTRY IN SAME RECORD ? >>        <<11662>>10161410
        IF (SEG'DESC'RECNO<>START'CST'RECNO)                   <<11662>>10161500
           THEN FREADDIR(PROGFNUM,PROGREC0,128,SEG'DESC'RECNO);<<11662>>10161600
                                                               <<11662>>10161700
        TOS.(0:1) := PROGREC0(SEG'DESCRIPTOR'IDX).(0:1);       <<11662>>10161800
                                                               <<11662>>10161900
      << WE ARE ASSUMING HERE THAT THE FIRST SEGMENT >>        <<11662>>10161910
      << OF A PROGRAM WILL ALWAYS BE LOGICALLY MAPPED. >>      <<11662>>10161920
      << TOS.(1:1):=0; >>  <<SET MAPPING FLAG TO LOGICAL>>     <<11662>>10162000
        END;  <<ELSE>>                                         <<R1624>>10166000
      END; <<THEN LSEARCH>>                                    <<R1624>>10170000
        IF (EPAUTOALLOC=1) AND (ESHR=0) AND (AMOUNT=1)         <<R1624>>11546100
          THEN DELETE'AUTOALLOC'TABLE;                         <<R1624>>11546200
               <<LOADING AUTOALLOCATED PROG. AND SHARE COUNT >><<R1624>>11546210
               << IS INCREMENTED TO ONE. REMOVE ENTRY FROM   >><<S1946>>11546220
               << LRU LIST OF AUTOALLOCATED UNREFERENCED PROG>><<R1624>>11546230
                                                               <<R1624>>11546240
        IF (EPAUTOALLOC=1) AND (ESHR=1) AND (AMOUNT=-1)        <<R1624>>11546300
          THEN ADD'AUTOALLOC'TABLE; <<UNLOADING SHARE COUNT>>  <<R1624>>11546400
                                    <<FALLS TO ZERO.       >>  <<R1624>>11546500
      <<IF PROGFILE ALLOCATED OR        >>                     <<R1624>>11590000
      <<OLD COUNT*NEW COUNT  > 0        >>                     <<R1624>>11595000
      IF EPA=1 OR TOS<> 0 AND ESHR<>0 THEN                     <<02203>>11600000
      IF ESHR <= 0 THEN DELETEFLAG := TRUE;                    <<R1624>>11630000
   TOS:=@PSS;                                                  <<S1946>>11666000
   TOS:=@PST;                                                  <<S1946>>11667000
   @SL'INFO'AREA:=@ENTP2;                                      <<S1946>>11670000
       @PST:=@SL'INFO'AREA + EOFFSET'OF'FADDR; <<PTR TO SLID>> <<S1946>>11715000
       @SL'INFO'AREA:=@SL'INFO'AREA +                          <<S1946>>11716000
           (IF EXSYS'BITMAP THEN EXSLINFO'AREA'SIZE            <<S1946>>11717000
                  ELSE ESLINFO'AREA'SIZE);                     <<S1946>>11718000
           IF EXSYS'SL THEN                                    <<S1946>>11731000
              LSTEP(ADJSEG,EXSLBITMAP'SIZE)                    <<S1946>>11732000
           ELSE                                                <<S1946>>11733000
                LSTEP(ADJSEG,ESLBITMAP'SIZE);                  <<S1946>>11735000
                        <<ADJUST REFCOUNT OF>>                 <<S1946>>11736000
   @PST:=TOS;                                                  <<S1946>>11791000
   @PSS:=TOS;                                                  <<S1946>>11793000
  OPTION UNCALLABLE;                                           <<01957>>11930000
    @PTEMP3:=@ENTP+ESLFIXED'SIZE;  <<PTR TO LOG SEG ARRAY>>    <<S1946>>11955000
    IF EXSYS'SL THEN                                           <<S1946>>11965000
           @PTEMP2:=@ENTP+EXSLSEGLIST'INDEX+                   <<S1946>>11966000
               TEMP1* ESLSEGLIST'ENTRY'SIZE                    <<S1946>>11966500
     ELSE                                                      <<S1946>>11967000
           @PTEMP2:=@ENTP+ESLSEGLIST'INDEX+                    <<S1946>>11968000
               TEMP1*ESLSEGLIST'ENTRY'SIZE;                    <<S1946>>11968100
                              <<PTR TO SEG LIST ENTRY>>        <<S1946>>11968200
            IF REFCOUNT <= 0 THEN                              <<D1853>>12010000
                SLLOGSEGNR:=%777;   <<MARK IT FREE    >>       <<S1946>>12055000
   INTEGER AUX'XDS;  <<LOCAL VARIABLE FOR AUX. XDS NUMBER>>    <<01959>>12151000
                                                               <<01959>>12152000
                                                               <<01959>>12286100
   <<--------------------------------------------------->>     <<01959>>12286200
   <<  SAVE PROGRAM NAME INTO ENTRY 0 OF PROGRAM NAME   >>     <<01959>>12286300
   <<  TABLE.                                           >>     <<01959>>12286400
   <<--------------------------------------------------->>     <<01959>>12286500
   IF (BIT = 1) THEN                                           <<01959>>12286600
     BEGIN                                                     <<01959>>12286700
     EXCHANGEDB(SEGTABDST);                                    <<01959>>12286800
     AUX'XDS := LOADER'AUX'XDS;                                <<01959>>12286900
                                                               <<01959>>12287000
     IF (AUX'XDS <> 0) THEN                                    <<01959>>12287100
       BEGIN                                                   <<01959>>12287200
       EXCHANGEDB(AUX'XDS);   <<GO TO AUX'XDS TO GET POINTER>> <<01959>>12287300
                              << TO PROGRAM NAME TABLE.     >> <<01959>>12287400
       TOS := AUX'XDS;                                         <<01959>>12287500
       TOS := @PROGNAME'TABLE;                                 <<01959>>12287600
       TOS := @FLABEL;                                         <<01959>>12287700
       TOS := 12;         <<24 CHAR. OF FILE NAME = 12 WORDS>> <<01959>>12287800
                                                               <<01959>>12287900
       EXCHANGEDB(0);   <<BACK TO STACK>>                      <<01959>>12288000
                                                               <<01959>>12288100
       ASSEMBLE (MTDS 4);                                      <<R2169>>12288200
       END  <<THEN AUX'XDS = 0>>                               <<01959>>12288300
     ELSE                                                      <<01959>>12288400
       EXCHANGEDB(0);  <<BACK TO STACK>>                       <<01959>>12288500
     END; <<THEN>>                                             <<01959>>12288600
                                                               <<01959>>12288700
$PAGE                                                          <<R1624>>12340500
<<-------------------------------------------------------->>   <<R1624>>12341000
<< GETS THE FILE LABEL OF THE SPECIFIED FILE.  CHECKS THE >>   <<R1624>>12341010
<<  FOPTIONS DOMAIN FIELD TO SEE IF THE FILE IN QUESTION  >>   <<R1624>>12341020
<<  IS TEMPORARY OR NOT.                                  >>   <<R1624>>12341030
<<-------------------------------------------------------->>   <<R1624>>12341040
LOGICAL PROCEDURE TEMP'FILE(FADDR);                            <<R1624>>12341050
  VALUE FADDR;                                                 <<R1624>>12341060
  DOUBLE FADDR;                                                <<R1624>>12341070
  OPTION UNCALLABLE;                                           <<R1624>>12341071
                                                               <<R1624>>12341072
BEGIN                                                          <<R1624>>12341080
  INTEGER SAVEFILESIR,SAVEDB;                                  <<R1624>>12341090
  INTEGER POINTER FLABEL;                                      <<R1624>>12341100
  INTEGER ARRAY FLABEL'BUF(0:127) = Q;                         <<R1624>>12341110
                                                               <<R1624>>12341120
  SAVEDB := EXCHANGEDB(0);                                     <<R1624>>12341130
  SAVEFILESIR := GETSIR(FILESYSSIR);                           <<R1624>>12341140
  @FLABEL := @FLABEL'BUF;                                      <<R1624>>12341150
  TEMP'FILE := FALSE;                                          <<R1624>>12341160
                                                               <<R1624>>12341170
  TOS := 0D;                    <<SPACE ON STACK FOR LDEV>>    <<R1624>>12341180
  TOS := FADDR&TASL(8) & DLSR(8); <<SEPERATE LDEV FROM REST>>  <<R1624>>12341190
                                <<OF DISC ADDRESS.       >>    <<R1624>>12341200
  TOS := ATTIOREAD;                                            <<R1624>>12341210
  TOS := @FLABEL;                                              <<R1624>>12341220
  TOS := FLABIO(*,*,*,*);                                      <<R1624>>12341230
                                                               <<R1624>>12341240
  IF (TOS = 0) THEN    <<SUCCESSFUL FILE LABEL I/O>>           <<R1624>>12341250
    BEGIN                                                      <<R1624>>12341260
    IF (FLABEL'FOPTIONS.(14:2) = FOPTIONS'TMPFILE'CODE) OR     <<R1624>>12341270
       (FLABEL'FOPTIONS.(10:3) = 3)      <<FILE IS $OLDPASS>>  <<R1624>>12341280
     THEN TEMP'FILE := TRUE;                                   <<R1624>>12341290
    END  <<THEN TOS=0>>                                        <<R1624>>12341300
    ELSE TEMP'FILE := TRUE;  <<IF ERROR WITH FILE LABEL I/O>>  <<R1624>>12341301
                             <<ASSUME TEMP. FILE SO IT WON'T >><<R1624>>12341302
                             <<BE ALLOCATED.                 >><<R1624>>12341303
                                                               <<R1624>>12341310
  RELSIR(FILESYSSIR,SAVEFILESIR);                              <<R1624>>12341320
  EXCHANGEDB(SAVEDB);                                          <<R1624>>12341330
END; <<TEMP'FILE>>                                             <<R1624>>12341340
    @SL'INFO'AREA:=@ENTP2;                                     <<S1946>>12605000
        @PST:=@SL'INFO'AREA+EOFFSET'OF'FADDR; <<PTR TO SLID>>  <<S1946>>12650000
        @SL'INFO'AREA:=@SL'INFO'AREA +                         <<S1946>>12651000
             (IF EXSYS'BITMAP THEN EXSLINFO'AREA'SIZE          <<S1946>>12652000
                       ELSE ESLINFO'AREA'SIZE);                <<S1946>>12653000
            IF EXSYS'SL THEN                                   <<S1946>>12666000
               LSTEP(SUMSEGS,EXSLBITMAP'SIZE)                  <<S1946>>12667000
            ELSE                                               <<S1946>>12668000
               LSTEP(SUMSEGS,ESLBITMAP'SIZE);                  <<S1946>>12670000
                         <<COUNT NON-MPE SEG>>                 <<S1946>>12671000
$EDIT VOID=12896600                                            <<S1744>>12895100
$EDIT VOID=13115000                                            <<L2186>>13105000
              LSTORE;  << LOADPROCMASTER >>                    <<L2186>>14297000
$EDIT VOID=14365000                                            <<L2186>>14355000
          LSTORE;  << EXTENSION >>                             <<L2186>>14380000
INTEGER PROCEDURE ALLOCATEPROG (PROGFNAME,HAS'OP'CAP);         <<D1938>>14705000
   VALUE      HAS'OP'CAP;  << TRUE IF USER HAS OP CAPABILITY >><<D1938>>14787000
   LOGICAL    HAS'OP'CAP;                                      <<D1938>>14792000
   LOGICAL AOP'PARM;       << AOPTIONS OF THE PROGRAM FILE   >><<D1938>>14807000
   LOGICAL ALLOW'EXEC'ACC := FALSE; << EXECUTE ACCESS IN AOP >><<D1938>>14808000
   INTEGER SAVESIR:=-1;                                        <<R1897>>14825000
   DEFINE  ACCESS'TYPE = (12:4)#;  << TYPE OF ACCESS ALLOWED >><<D1938>>14836000
   EQUATE  EXEC'ACCESS'TYPE = 6;                               <<D1938>>14837000
                                                               <<D1938>>14926000
   << INSERT ADDITIONAL PARAMETER (AOPTION) IN FGETINFO TO   >><<D1938>>14927000
   << GET THE ACCESS TYPE TO SEE IF THE FILE HAS EXEC ACCESS.>><<D1938>>14928000
                                                               <<D1938>>14929000
   FGETINFO(PROGFNUM,,S0,AOP'PARM,,,S1,,S4,,,,,,,S5,,S6,,DS3); <<D1938>>14930000
                                                               <<D1938>>14931000
   IF  AOP'PARM.ACCESS'TYPE >= EXEC'ACCESS'TYPE  THEN          <<D1938>>14932000
       ALLOW'EXEC'ACC := TRUE;                                 <<D1938>>14933000
                                                               <<D1938>>14934000
   IF TOS.(14:2) = FOPTIONS'TMPFILE'CODE THEN    <<TEMP. FILE>><<R1624>>14935000
      IF (EPAUTOALLOC = 1) THEN       <<REMOVE ENTRY FROM THE>><<S1744>>15091000
        BEGIN                            <<AUTOALLOCATE TABLE>><<S1744>>15092000
        EPA:=0;              <<RESET ALLOCATE BIT>>            <<S1744>>15092100
        EPAUTOALLOC:=0;      <<RESET AUTOALLOCATE BIT>>        <<S1744>>15092200
        DELETE'AUTOALLOC'TABLE;                                <<S1744>>15092300
        END;                                                   <<S1744>>15092400
         BEGIN   <<FILE IS ALREADY ALLOCATED>>                 <<R1624>>15100000
      IF  HAS'OP'CAP  THEN  << EXECUTE LIKE IT DID BEFORE >>   <<D1938>>15162000
        BEGIN                                                  <<D1938>>15162010
          EPA := 0;   << RESET THE ALLOCATE BIT >>             <<D1938>>15162020
          IF (EPAUTOALLOC=1) THEN   << IS IT AUTOALLOCATED? >> <<D1938>>15162030
                            << IF FALSE THEN IT'S ALLOCATED >> <<D1938>>15162040
            BEGIN                                              <<D1938>>15162050
         << @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >><<D1938>>15162060
         << @ NOTES:  The ESHR count needs to increment by @ >><<D1938>>15162070
         << @ =====   1 because AUTOALLOCATE keeps the ref.@ >><<D1938>>15162080
         << @ count of the program entry to be the true    @ >><<D1938>>15162090
         << @ reference count and keeps the ref. counts of @ >><<D1938>>15162100
         << @ all segments related as "true ref.count+1"   @ >><<D1938>>15162110
         << @ just like the MPE ALLOCATE has always kept.  @ >><<D1938>>15162120
         << @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >><<D1938> 15162130
                                                               <<D1938>>15162140
              ESHR := ESHR + 1;                                <<D1938>>15162150
              DELETE'AUTOALLOC'TABLE;                          <<D1938>>15162160
              EPAUTOALLOC := 0;                                <<D1938>>15162170
            END;                                               <<D1938>>15162180
        END                                                    <<D1938>>15162190
       ELSE   << THE USER DOESN'T HAVE THE OP CAPABILITY. >>   <<D1938>>15162200
        BEGIN                                                  <<D1938>>15162210
          IF  ALLOW'EXEC'ACC  THEN << THE PROGRAM FILE ALLOWS>><<D1938>>15162220
                               << PRIV MODE USER TO EXECUTE. >><<D1938>>15162230
            BEGIN                                              <<D1938>>15162240
              IF (EPAUTOALLOC=1) THEN                          <<D1938>>15162250
                BEGIN                                          <<D1938>>15162260
             << @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >><<D1938>>15162270
             << @ Please read the above comments for the   @ >><<D1938>>15162280
             << @ explanation of the (true) reference count@ >><<D1938>>15162290
             << @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >><<D1938>>15162300
                                                               <<D1938>>15162310
                  ESHR := ESHR + 1;                            <<D1938> 15162320
                  DELETE'AUTOALLOC'TABLE;                      <<D1938>>15162330
                  EPA := 0;   << RESET THE ALLOCATE BIT >>     <<D1938>>15162340
                  EPAUTOALLOC := 0;<< RESET THE AUTOALLOC BIT>><<D1938>>15162350
                END                                            <<D1938>>15162360
               ELSE << THE USER WITHOUT THE OP CAPABILITY IS >><<D1938>>15162370
                    << NOT SUPPOSED TO DEALLOCATE A          >><<D1938>>15162380
                    << NON-AUTOALLOCATED PROGRAM.            >><<D1938>>15162390
                BEGIN                                          <<D1938>>15162400
                  TOS := ERR1659;                              <<D1938>>15162410
                  GO  ABORT;                                   <<D1938>>15162420
                END; << ELSE OF EPAUTOALLOC >>                 <<D1938>>15162430
            END                                                <<D1938>>15162440
           ELSE  << PROG FILE DOESN'T ALLOW EXECUTE ACCESS   >><<D1938>>15162450
            BEGIN                                              <<D1938>>15162460
              TOS := ERR53;                                    <<D1938>>15162470
              GO  ABORT;                                       <<D1938>>15162480
            END;  << ELSE OF ALLOW'EXEC'ACC >>                 <<D1938>>15162490
        END;  << ELSE OF HAS'OP'CAP >>                         <<D1938>>15162500
                                                               <<D1938>>15165000
$EDIT VOID=15166500                                            <<D1938>>15166000
   ABORT:                                                      <<R1897>>15200000
   ALLOCATEPROG := TOS;  <<ERROR NR.>>                         <<R1897>>15205000
   IF SAVESIR <> -1 THEN RELSIR(SEGTABSIR,SAVESIR);            <<R1897>>15206000
   SAVESIR:=-1;                                                <<R1897>>15207000
   IF PROGFNUM <> 0 THEN FCLOSE(PROGFNUM,0,0);                 <<R1897>>15210000
   TOS := CCL;  <<ERROR CONDITION CODE>>                       <<R1897>>15215000
                                                               <<R1897>>15220000
SCAN'LSTX:                                                     <<L2186>>15417000
             TRANS'LSTX'TO'LST;                                <<L2186>>15495000
             LOGSEG:=ALLOC'PROC'LOG'SEG; <<GET LOG SEG #>>     <<S1946>>15520000
$EDIT VOID=15605000                                            <<L2186>>15600000
                                                               <<L2186>>15667000
     IF NEXT'LST <> 0 THEN                                     <<L2186>>15667100
       BEGIN                                                   <<L2186>>15667200
       EXCHANGEDB (NEXT'LST);                                  <<L2186>>15667300
       GO SCAN'LSTX;                                           <<L2186>>15667400
       END;                                                    <<L2186>>15667500
                                                               <<L2186>>15667600
    DEFINE NUMB'SEGLIST'ENTRIES = PSI(5)#,                     <<S1946>>15821000
       EXPANDED'SL = LOGICAL(PSI.(2:1))#,                      <<S1946>>15822000
       LIB'LOG'SEG = PSEGLIST.(0:9)#;                          <<S1946>>15823000
                                                               <<S1946>>15824000
     IF EXPANDED'SL THEN    <<PTR TO FIRST SEGLIST>>           <<S1946>>15849000
        @PSEGLIST:=SI+EXSLSEGLIST'INDEX          <<SSLEX>>     <<S1946>>15850000
     ELSE                                                      <<S1946>>15851000
        @PSEGLIST:=SI+ESLSEGLIST'INDEX;                        <<S1946>>15852000
    @PEND:=@PSEGLIST+                           <<END SEGLIST>><<S1946>>15855000
         +NUMB'SEGLIST'ENTRIES*ESLSEGLIST'ENTRY'SIZE;          <<S1946>>15856000
                SK:=LIB'LOG'SEG; <<LOG SEG NR>>                <<S1946>>15895000
            IF SJ = LIB'LOG'SEG THEN                           <<S1946>>15930000
    DEFINE EX'PSLINFO = LOGICAL(PSLINFO.(0:1))#;               <<S1946>>16136000
    DEFINE PSLINFO'LIB = PSLINFO.(1:15)#;                      <<S2020>>16137000
                                                               <<S2020>>16138000
       << Run Time Event Logging (RTEL) uses an SL which   >>  << 2115>>16225000
       <<     is loaded before SL.PUB.SYS but after any    >>  << 2115>>16225010
       <<     group or account SL.  Therefore, PSLINFO'LIB >>  << 2115>>16225020
       <<     can now have values of 0,1,2 or 3.  The DB   >>  << 2115>>16225030
       <<     relative variable SL is set below with the   >>  << 2115>>16225040
       <<     value of PSLINFO'LIB.  So, to minimize code  >>  << 2115>>16225050
       <<     changes to MPE, this procedure will auto-    >>  << 2115>>16225060
       <<     matically set SL to known, expected values   >>  << 2115>>16225070
       <<     of 0,1 or 2 as follows:                      >>  << 2115>>16225080
       <<                                                  >>  << 2115>>16225090
       <<  Current PSLINFO'LIB,    OLD SL return values    >>  << 2115>>16225100
       <<    (before RTEL fixes)     (expected returns)    >>  << 2115>>16225110
       <<  ---------------------   ---------------------   >>  << 2115>>16225120
       <<  0 = SL.PUB.SYS          0 = SL.PUB.SYS          >>  << 2115>>16225130
       <<  1 = RTELSL.PUB.SYS      1 = SL.PUB.ACCT         >>  << 2115>>16225140
       <<  2 = SL.PUB.ACCT         2 = SL.GRP.ACCT         >>  << 2115>>16225150
       <<  3 = SL.GRP.ACCT         3 = unused              >>  << 2115>>16225160
                    if pslinfo'lib = 0 then sl := pslinfo'lib  << 2115>>16225170
                    else sl := pslinfo'lib - 1;                << 2115>>16225180
                <<NEXT SL INFO AREA>>                          <<S1946>>16313000
        IF EX'PSLINFO THEN                                     <<S1946>>16314000
          @PSLINFO:=@PSLINFO+EXSLINFO'AREA'SIZE                <<S1946>>16315000
        ELSE                                                   <<S1946>>16316000
          @PSLINFO:=@PSLINFO+ESLINFO'AREA'SIZE;                <<S1946>>16317000
    INTEGER SAVEENTP;                                          <<L9944>>16511000
                  END                                          <<L9944>>16820000
                ELSE   <<NO MATCH>>                            <<L9944>>16820100
                  BEGIN      <<TRY TO FIND MATCH USING>>       <<L9944>>16820200
                              <<EXTENSION ENTRY>>              <<L9944>>16820300
                    EXCHANGEDB(SEGTABDST'EX);                  <<L9944>>16820400
SCAN'LSTX:                                                     <<L2186>>16820450
                    @ENTP:=HDFWDLINK(EXTENSION);               <<L9944>>16820500
                    WHILE @ENTP <> 0 DO                        <<L9944>>16820600
                      BEGIN                                    <<L9944>>16820700
                        IF EPIN = PINX/PCBSIZE THEN            <<L9944>>16820800
                         BEGIN <<FOUND EXTENSION FOR PIN>>     <<L9944>>16820900
                           TRANS'LSTX'TO'LST;                  <<L2186>>16821000
                           IF <> THEN                          <<L9944>>16821100
                             BEGIN                             <<L9944>>16821110
                               EXCHANGEDB(SEGTABDST);          <<L9944>>16821120
                               RETURN;                         <<L9944>>16821130
                             END; <<END OF IF <> >>            <<L9944>>16821140
                           EXCHANGEDB(SEGTABDST);              <<L9944>>16821200
                           SAVEENTP:=@ENTP;                    <<L9944>>16821300
                           SETSECPTRS;                         <<L9944>>16821400
                           @PSLINFO:=@ENTP2; <<PTR TO SLINFO>> <<L9944>>16821500
                           NSLINFO:=ESLINFO'EXT; <<# SLINFO>>  <<L9944>>16821600
                           TOS:=0;  << SCANSLINFOAREAS RESULT>><<L9944>>16821700
                           TOS:=@PSLINFO;                      <<L9944>>16821800
                           IF SCANSLINFOAREAS(*,NSLINFO,CSTNR, <<L9944>>16821900
                                               TRUE) THEN      <<L9944>>16822000
                             BEGIN    <<FOUND MATCH>>          <<L9944>>16822100
                               SLTYPE:=SL;                     <<L9944>>16822200
                               LOGSEG:=SK;                     <<L9944>>16822300
                               CONDCODE:=CCE;                  <<L9944>>16822400
                               @ENTP:=SAVEENTP;                <<L9944>>16822500
                               LRELEASE;  << EXTENSION >>      <<L2186>>16822600
                               RETURN;                         <<L9944>>16822700
                             END; <<IF SCANSLINFOAREAS>>       <<L9944>>16822800
                           @ENTP:=SAVEENTP;                    <<L9944>>16822900
                           LRELEASE;  << EXTENSION >>          <<L2186>>16823000
                           EXCHANGEDB(SEGTABDST'EX);           <<L9944>>16823100
                         END; <<IF EPIN=PINX/PCBSIZE>>         <<L9944>>16823200
                        @ENTP:=FWDLINK;       <<NEXT EXT>>     <<L1359>>16823300
                      END; <<WHILE>>                           <<L9944>>16823400
                    IF NEXT'LST <> 0 THEN                      <<L2186>>16823430
                      BEGIN                                    <<L2186>>16823440
                      EXCHANGEDB (NEXT'LST);                   <<L2186>>16823450
                      GO SCAN'LSTX;                            <<L2186>>16823460
                      END;                                     <<L2186>>16823470
                                                               <<L2186>>16823480
                    EXCHANGEDB(SEGTABDST);                     <<L9944>>16823500
                  END; <<IF SCANSLINFOAREAS ELSE >>            <<L9944>>16823600
  <<        SEGMENTNR.(7:9) = LOGICAL SEG #        >>          <<S1946>>17615000
    DEFINE LOGSEG = SEGMENTNR.(7:9)#, <<LOG SEG #>>            <<S1946>>17670000
           PROG'LIB = ENTP2.(12:4)#,                           <<S1946>>17671000
           EX'PSLINFO   = LOGICAL(ENTP2.(0:1))#,               <<S1946>>17672000
                                                               <<S1946>>17790000
              PROG'LIB <> SLTYPE DO                            <<S1946>>17800000
            IF EX'PSLINFO THEN                                 <<S1946>>17809000
              @ENTP2:=@ENTP2+EXSLINFO'AREA'SIZE                <<S1946>>17810000
            ELSE                                               <<S1946>>17811000
              @ENTP2:=@ENTP2+ESLINFO'AREA'SIZE;                <<S1946>>17812000
       <<                                                  >>  << 2115>>17870010
       << Run Time Event Logging (RTEL) uses an SL which   >>  << 2115>>17870020
       <<     is loaded before SL.PUB.SYS but after any    >>  << 2115>>17870030
       <<     group or account SL.  So, to minimize code   >>  << 2115>>17870040
       <<     changes to MPE, this procedure will auto-    >>  << 2115>>17870050
       <<     matically change SEGMENTNR.(0:4) as follows: >>  << 2115>>17870060
       <<                                                  >>  << 2115>>17870070
       <<  OLD SEGMENTNR.(0:4),    NEW SEGMENTNR.(0:4)     >>  << 2115>>17870080
       <<    (before RTEL fixes)     (after RTEL fixes)    >>  << 2115>>17870090
       <<  ---------------------   ---------------------   >>  << 2115>>17870100
       <<  0 = SL.PUB.SYS          0 = SL.PUB.SYS          >>  << 2115>>17870110
       <<  1 = SL.PUB.ACCT         1 = RTELSL.PUB.SYS      >>  << 2115>>17870120
       <<  2 = SL.GRP.ACCT         2 = SL.PUB.ACCT         >>  << 2115>>17870130
       <<  3 =  NOT USED           3 = SL.GRP.ACCT         >>  << 2115>>17870140
       << 14 = PROGRAM            14 = PROGRAM             >>  << 2115>>17870150
       <<                                                  >>  << 2115>>17870160
    IF SLTYPE=1 OR SLTYPE=2 THEN SLTYPE := SLTYPE + 1;         << 2115>>17870170
SCAN'LSTX:                                                     <<L2186>>18112000
                            TRANS'LSTX'TO'LST;                 <<L2186>>18145000
                                LRELEASE;  << EXTENSION >>     <<L2186>>18215000
                            LRELEASE;  << EXTENSION >>         <<L2186>>18235000
                        @ENTP:=FWDLINK;       <<NEXT EXT>>     <<L1359>>18250000
                                                               <<L2186>>18257000
                    IF NEXT'LST <> 0 THEN                      <<L2186>>18257100
                      BEGIN                                    <<L2186>>18257200
                      EXCHANGEDB (NEXT'LST);                   <<L2186>>18257300
                      GO SCAN'LSTX;                            <<L2186>>18257400
                      END;                                     <<L2186>>18257500
                                                               <<L2186>>18257600
                                                               <<O2499>>18451000
   <<@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@>>         <<O2499>>18451100
   <<@  The caller should NOT call this procedure  @>>         <<O2499>>18451200
   <<@  in SPLIT STACK mode.                       @>>         <<O2499>>18451300
   <<@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@>>         <<O2499>>18451400
                                                               <<O2499>>18451500
<<*****************************************************>>      <<E2169>>18453000
<<                                                     >>      <<E2169>>18453010
<< LOADER PERFORMANCE ENHANCEMENTS:     4/23/86        >>      <<E2169>>18453020
<< ===============================                     >>      <<E2169>>18453030
<<                                                     >>      <<E2169>>18453040
<< The loader will NO longer need to get to the file   >>      <<E2169>>18453050
<< label to obtain the file name.  Instead, it now     >>      <<E2169>>18453060
<< accesses the PROGRAM NAME table in the LOADER AUX   >>      <<E2169>>18453070
<< XDS to obtain the file name.  As a result, many     >>      <<E2169>>18453080
<< physical I/O's will be saved with this new access   >>      <<E2169>>18453090
<< implementation.                                     >>      <<E2169>>18453100
<<                                                     >>      <<E2169>>18453110
<<*****************************************************>>      <<E2169>>18453120
                                                               <<E2169>>18453130
   integer  SAVE'ECSTBLK;                                      <<E2169>>18477000
   equate   NAME    = 0,                                       <<E2169>>18505000
            GROUP   = 8,                                       <<E2169>>18510000
            ACCOUNT = 16;                                      <<E2169>>18511000
                                                               <<E2169>>18512000
   byte array  PROGNAME(0:23) = Q;                             <<E2169>>18515000
                                                               <<O2499>>18516000
   << Change the declaration method to eliminate the  >>       <<O2499>>18517000
   << INTEGER OVERFLOW occurred in the MOVE operation >>       <<O2499>>18518000
                                                               <<O2499>>18519000
   byte array   LOCPNAME(*)    = PROGNAME (NAME);              <<O2499>>18520000
   byte array   LOCPGROUP(*)   = PROGNAME (GROUP);             <<O2499>>18525000
   byte array   LOCPACCOUNT(*) = PROGNAME (ACCOUNT);           <<O2499>>18530000
                                                               <<E2169>>18531000
$edit void=18550000                                            <<E2169>>18540000
   if LSEARCH(double(logical(PIN)), ANYMODE, SHARER) and       <<E2169>>18615000
         << SHARER entry found >>                              <<E2169>>18616000
      LSEARCH(E6'PROGKEY, ANYMODE, PROGFILE) then              <<E2169>>18617000
         << PROGRAM FILE entry found >>                        <<E2169>>18618000
                                                               <<E2169>>18619000
      SAVE'ECSTBLK := ECSTBLK;    << SAVE CSTX BLOCK INDEX >>  <<E2169>>18625000
                                  << OF PROGRAM >>             <<E2169>>18626000
                                                               <<E2169>>18656000
      GET'PROGNAME(SAVE'ECSTBLK, PROGNAME);                    <<E2169>>18660000
                                                               <<E2169>>18661000
$edit void=18735000                                            <<E2169>>18665000
                                                               <<E2169>>18666000
      move  FNAME := LOCPNAME, (8);                            <<E2169>>18675000
      scan  FNAME until " ",1;                                 <<E2169>>18676000
      move  * := ".",2;                                        <<E2169>>18677000
      move  BPS0 := LOCPGROUP, (8);                            <<E2169>>18678000
      scan  * until " ",1;                                     <<E2169>>18679000
      move  * := ".",2;                                        <<E2169>>18680000
      move  * := LOCPACCOUNT, (8);                             <<E2169>>18681000
      TOS := CCE;                                              <<E2169>>18682000
$page                                                          <<E2169>>18856000
procedure GET'PROGNAME (CSTX'BLK'INX,PNAME);                   <<E2169>>18856010
  value      CSTX'BLK'INX;  << CSTX BLOCK INDEX >>             <<E2169>>18856020
  integer    CSTX'BLK'INX;                                     <<E2169>>18856030
  byte array PNAME; << requested fully qualified program name>><<E2169>>18856040
  option     privileged, uncallable;                           <<E2169>>18856050
COMMENT                                                        <<E2169>>18856060
***************************************************************<<E2169>>18856070
*                                                             *<<E2169>>18856080
*                  PROCEDURE  GET'PROGNAME                    *<<E2169>>18856090
*                                                             *<<E2169>>18856100
***************************************************************<<E2169>>18856110
*                                                             *<<E2169>>18856120
*                   FUNCTION OF PROCEDURE                     *<<E2169>>18856130
*                                                             *<<E2169>>18856140
*  GET'PROGNAME obtains the LOADER AUXILIARY XDS from the LST *<<E2169>>18856160
*  table, indexes the PROGRAM NAME table in LOADER AUXILIARY  *<<E2169>>18856170
*  XDS via the CST BLOCK TABLE index, gets the requested      *<<E2169>>18856180
*  program name, and moves it to the PROGNAME byte array.     *<<E2169>>18856190
*                                                             *<<E2169>>18856200
*  PARAMETER:       CSTX'BLK'INX  (index used to access the   *<<E2169>>18856210
*  ---------                       PROGRAM NAME table)        *<<E2169>>18856220
*                   PNAME         (byte array used to hold    *<<E2169>>18856230
*                                  the 24 chars program name) *<<E2169>>18856240
*                                                             *<<E2169>>18856250
*  RETURN:          PNAME                                     *<<E2169>>18856260
*  ------                                                     *<<E2169>>18856270
*                                                             *<<E2169>>18856280
*  ERROR HANDLING:  none                                      *<<E2169>>18856290
*  --------------                                             *<<E2169>>18856300
*                                                             *<<E2169>>18856310
***************************************************************<<E2169>>18856320
*                                                             *<<E2169>>18856330
*                     NOTES AND CAUTIONS                      *<<E2169>>18856340
*                     @@@@@@@@@@@@@@@@@@                      *<<E2169>>18856350
*                                                             *<<E2169>>18856360
*  DB register must be at the user STACK before calling this  *<<E2169>>18856370
*  procedure.                                                 *<<E2169>>18856380
*                                                             *<<E2169>>18856390
***************************************************************<<E2169>>18856400
;                                                              <<E2169>>18856410
  begin                                                        <<E2169>>18856420
                                                               <<E2169>>18856430
  <<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>18856440
  <<             LOCAL PROCEDURE DECLARATION                 >><<E2169>>18856450
  <<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>18856460
                                                               <<E2169>>18856470
    equate   WORDCOUNT = 12;                                   <<E2169>>18856480
                                                               <<E2169>>18856490
    integer  SAVEDB,                                           <<E2169>>18856500
             SAVELSTSIR,                                       <<E2169>>18856510
             LOCAL'AUX'XDS,                                    <<E2169>>18856520
             LOCAL'PNAME'OFFSET;                               <<E2169>>18856530
                                                               <<E2169>>18856540
    integer subroutine WORDADDRESS (BYTEADDRESS);              <<B2280>>18856550
      byte array  BYTEADDRESS;                                 <<B2280>>18856551
    <<=======================================================>><<B2280>>18856552
    <<               SUBROUTINE  WORDADDRESS                 >><<B2280>>18856553
    <<                                                       >><<B2280>>18856554
    <<  PARAMETER:    BYTEADDRESS                            >><<B2280>>18856555
    <<  ---------                                            >><<B2280>>18856556
    <<                                                       >><<B2280>>18856557
    <<  PURPOSE:      To convert byte addresses to word      >><<B2280>>18856558
    <<  -------       addresses.                             >><<B2280>>18856559
    <<                                                       >><<B2280>>18856560
    <<=======================================================>><<B2280>>18856561
      begin                                                    <<B2280>>18856562
        WORDADDRESS := @BYTEADDRESS & lsr(1);                  <<B2280>>18856563
        tos := @BYTEADDRESS & lsr(1);                          <<B2280>>18856564
        push(z);                                               <<B2280>>18856565
        if  tos <<WORDADDRESS>>  >  tos <<z>>   then           <<B2280>>18856566
         << if the WORDADDRESS is greater than z then the    >><<B2280>>18856567
         << WORDADDRESS is really in the DB negative area.   >><<B2280>>18856568
            WORDADDRESS.(0:1) := 1;                            <<B2280>>18856569
      end;                                                     <<B2280>>18856570
                                                               <<E2169>>18856580
  <<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>18856590
  <<               START OF PROCEDURE BODY                   >><<E2169>>18856600
  <<!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!>><<E2169>>18856610
                                                               <<E2169>>18856620
                                                               <<E2169>>18856650
    SAVELSTSIR := GETSIR(SEGTABSIR);                           <<E2169>>18856660
    SAVEDB := EXCHANGEDB(SEGTABDST);                           <<E2169>>18856670
                                                               <<E2169>>18856680
    if (LOADER'AUX'XDS <> 0) then                              <<E2169>>18856690
      begin                                                    <<E2169>>18856700
        LOCAL'AUX'XDS := LOADER'AUX'XDS;                       <<E2169>>18856710
        EXCHANGEDB(LOCAL'AUX'XDS);                             <<E2169>>18856720
        LOCAL'PNAME'OFFSET :=                                  <<E2169>>18856730
       @PROGNAME'TABLE(CSTX'BLK'INX*PROGNAME'TABLE(ENTRY'LEN));<<E2169>>18856740
      end;   << if LOADER'AUX'XDS >>                           <<E2169>>18856750
                                                               <<E2169>>18856760
    EXCHANGEDB(SAVEDB);  << BACK TO ORIGINAL DB UPON ENTRY >>  <<B2280>>18856770
$edit                                                          <<B2280>>18856780
                                                               <<E2169>>18856790
    TOS := WORDADDRESS (PNAME);                                <<B2280>>18856800
    TOS := LOCAL'AUX'XDS; << PROGRAM NAME table in this dseg >><<B2280>>18856810
    TOS := LOCAL'PNAME'OFFSET;                                 <<E2169>>18856820
    TOS := WORDCOUNT;                                          <<E2169>>18856830
    ASSEMBLE (MFDS 4);                                         <<E2169>>18856840
                                                               <<E2169>>18856850
    RELSIR(SEGTABSIR,SAVELSTSIR);                              <<B2280>>18856855
                                                               <<B2280>>18856856
  end;   << procedure GET'PROGNAME >>                          <<E2169>>18856860
    INTEGER SEARCHDOMAIN := 0;  <<LOADPROC TO SEARCH LOGON >>  <<L1608>>19131000
                                <<GROUP/ACCT. OR PROGRAMS  >>  <<L1608>>19132000
    DEFINE CALLED'NONPM = STATUS.(0:1)=0#;<<MODE BIT>>         <<S1946>>19225000
    DEFINE EX'PSLINFO=LOGICAL(AUXENTP2.(0:1))#; <<EXPANDED SL>><<S1946>>19226000
    DEFINE CCOMMAND     = COMMAND.(0:2)#, <<LOADER COMMAND  >> <<L1608>>19227000
           CLIBSEARCH   = COMMAND.(2:2)#, <<LIBRARY SEARCH  >> <<L1608>>19228000
           CLOADDOMAIN  = COMMAND.(5:1)#, <<LOAD DOMAIN     >> <<L1608>>19229000
           CSEARCHDOMAIN= COMMAND.(7:1)#; <<FOR LOADPROCS   >> <<L1608>>19229100
    EQUATE MAXLIBSEARCH = 4;                                   <<L1608>>19235000
                        <<CHECK VALIDITY OF LIBSEARCH>>        <<01769>>19905500
                        IF NOT (0<=(INTEGER(OPTIONS(TEMP)))    <<01769>>19905600
                                 <=MAXLIBSEARCH) THEN          <<01769>>19905700
                          BEGIN   <<ILLEGAL LIBSEARCH>>        <<01769>>19905800
                            ERROR:=ERR20;                      <<01769>>19905900
                            GO RETURNERROR2;                   <<01769>>19906000
                          END;                                 <<01769>>19906100
                                                               <<01769>>19906200
                                                               <<01769>>19906300
                        IF OPTIONS(TEMP) > 2 THEN              <<01769>>19906400
                        BEGIN                                  <<01769>>19906500
                      <<------------------------------------->><<01769>>19906600
                      <<LOADPROC FROM THE PROGRAM GROUP AND  >><<01769>>19906700
                      << ACCOUNT INSTEAD OF LOGON GROUP AND  >><<01769>>19906800
                      << ACCOUNT.                            >><<01769>>19906900
                      <<                                     >><<01769>>19907000
                      <<LIBSEARCH FUDGE:                     >><<01769>>19907100
                      <<                                     >><<01769>>19907200
                      << USER POINT OF VIEW:                 >><<01769>>19907300
                      << LIB = 3  -> SAME AS LIB = 1 EXCEPT  >><<01769>>19907400
                      <<             USE THE PROGRAM GRP/ACT >><<01769>>19907500
                      << LIB = 4  -> SAME AS LIB = 2 EXCEPT  >><<01769>>19907600
                      <<             USE THE PROGRAM GRP/ACT >><<01769>>19907700
                      <<                                     >><<01769>>19907800
                      <<INTERNAL TO LOADER:                  >><<01769>>19907900
                      << LIB = 3 IS CONVERTED TO LIB = 1 AND >><<01769>>19910000
                      <<  THE SEARCHDOMAIN FLAG IS SET.      >><<01769>>19911000
                      << LIB = 4 IS CONVERTED TO LIB = 2 AND >><<01769>>19912000
                      <<  THE SEARCHDOMAIN FLAG IS SET.      >><<01769>>19913000
                      <<                                     >><<01769>>19914000
                      << THE SEARCHDOMAIN FLAG IS USED BY THE>><<01769>>19914100
                      <<  LOAD PROCESS.                      >><<01769>>19914200
                      <<------------------------------------->><<01769>>19915000
                                                               <<01769>>19920000
                                                               <<01769>>19925000
                          LIBSEARCH:=OPTIONS(TEMP) - 2;        <<01769>>19930000
                          SEARCHDOMAIN:=1;                     <<01769>>19935000
                        END                                    <<01769>>19940000
                        ELSE LIBSEARCH := OPTIONS(TEMP);       <<01769>>19945000
                                                               <<01769>>19946000
                IF EX'PSLINFO THEN                             <<S1946>>20529000
                  @AUXENTP2:=@AUXENTP2+EXSLINFO'AREA'SIZE      <<S1946>>20530000
                ELSE                                           <<S1946>>20531000
                  @AUXENTP2:=@AUXENTP2+ESLINFO'AREA'SIZE;      <<S1946>>20532000
                TOS.(0:9):=SL-1; <<LOGSEG>>                    <<S1946>>20725000
SCAN'LSTX:                                                     <<L2186>>20827000
                       AUXENTP.(3:1) = SEARCHDOMAIN AND        <<L1608>>20901000
                            EXCHANGEDB (SEGTABDST);            <<L2186>>20927000
                            LRELEASE; << LOADPROCMASTER >>     <<L2186>>20928000
                        EXCHANGEDB (SEGTABDST);                <<L2186>>20966000
                        LRELEASE;  << LOADPROCMASTER >>        <<L2186>>20967000
                IF NEXT'LST <> 0 THEN                          <<L2186>>20997000
                  BEGIN                                        <<L2186>>20997100
                  EXCHANGEDB (NEXT'LST);                       <<L2186>>20997200
                  GO SCAN'LSTX;                                <<L2186>>20997300
                  END;                                         <<L2186>>20997400
        LRELEASE;  << LOADPROCMASTER >>                        <<L2186>>21077000
    LSTORE;  << Possibly new LOADPROCMASTER >>                 <<L2186>>21097000
    CCOMMAND:=1;    <<LOADPROC REQUEST>>                       <<L1608>>21185000
    CLIBSEARCH:=LIBSEARCH;    <<LIB SEARCH ORDER    >>         <<L1608>>21190000
    CSEARCHDOMAIN:=SEARCHDOMAIN; <<LOADPROC USE LOGON GROUP  >><<L1608>>21191000
                                 <<ACCT. OR PROGRAMS.        >><<L1608>>21192000
    CLOADDOMAIN:=LOADDOMAIN;  <<MAPPED OR NON-MAPPED>>         <<L1608>>21195000
    ERROREXIT([10/80,6/7],0,0);                                <<F1440>>21245000
    ERROREXIT([10/80,6/7],0,0);                                <<F1440>>21285000
