*        704724   SIGMA 5/7         BPM M:ROOT
***********************************************************************
*M*      LDR      LOADER'S DRIVER,DATA AND PATCH AREAS
***********************************************************************
*P*      NAME:    LDR
*P*      PURPOSE: THIS IS THE DRIVER FOR THE FIRST AND SECOND PASS.
*P*               IT ALSO CONTAINS A COLLECTION OF FREQUENTLY USED
*P*               SUBROUTINES,AND THE LOADER'S ONLY DATA AREA(COMPOSED
*P*               OF A TEMP STACK,A COLLECTION OF VARIABLE DATA AND
*P*               PATCH SPACE.
*P*      DESCRIPTION: OVERALL EXECUTION OF THE LOADER IS CONTROLLED BY
*P*               THE DRIVER WITHIN THE LDR SEGMENT BEGINNING AT
*P*               LOCATION LOADER. EXIT FROM THE LOADER BACK TO CCI OR
*P*               PASS3 ALWAYS OCCURS AT LOCATION LEAVE WITHIN THE
*P*               DRIVER. IF AN ERROR OCCURS DURING PROCESSING,CONTROL
*P*               IS TRANSFERRED TO MESSAGE WITH THE ERROR NUMBER.
*P*               MESSAGE BUILDS THE KEY,READS THE ERRMSG FILE,PRINTS
*P*               THE OFFENDING ERROR(AND THE KEY) AND TRANSFERS TO
*P*               LEAVE.
*P*      REFERENCE: OVERLAY LOADER TECHNICAL MANUAL.
***********************************************************************
         SYSTEM   SIG7FDP
         PCC      0
MODE     EQU      1
DEBUG    EQU      0
CFU      EQU      1
PATCHER  EQU      1
         DO       MODE=2
         DEF      J:JIT
J:JIT    EQU      X'8000'
         FIN
         REF      M:DO
         DO       PATCHER~=0
         CSECT    1
         DEF      PATCH
         DO       MODE=0
PATCH    RES      50
         ELSE
PATCH    RES      X'100'
         ORG      PATCH
         CAL1,8   RSTBRK            RESET BREAK COUNT
         LI,R5    NOBM              LATER
         INT,2    TSTACK+1          IS THERE ROOM FOR THE MESSAGE
         CI,R2    9
         BL       BRKXIT            NO..
         LW,R5    TXBLNK
         STW,R5   *TSTACK,R2
         BDR,R2   %-1
         LW,R5    TSTACK
         AI,R5    1
         SLS,R5   2
         LW,R3    R5
         AI,R3    1
         LI,R2    CPUMSG
         BAL,SR3  MOVMSG
         CAL1,8   TTIMER
         LCW,SR1  SR1
         AW,SR1   Y1
         SLD,SR1  -32
         DW,SR1   D30               THOU MINS
         LI,R4    '='
         LI,R6    5
         LI,SR1   0
         DW,SR1   D10
         STB,SR1  R7
         SLS,R7   -4
         CI,R6    3
         BNE      %+2
         SLS,R7   -4
         BDR,R6   %-7
         AI,R7    X'1000'           MAKE DECIMAL NONZERO..KILL BLANKER
         BAL,SR4  BINTHEXT
         LI,SR1   '.'
         LW,R6    D2
         STB,SR1  D2,R6
         STB,R4   0,R3
         BAL,SR3  MOVMSG+1
         LI,R2    SEQMSG
         BAL,SR3  MOVMSG
         STB,R4   0,R3
         LW,R7    SEQNUM
         BAL,SR4  BINTHEXT
         BAL,SR3  MOVMSG+1
         LI,R2    EFMSG
         BAL,SR3  MOVMSG
         STB,R4   0,R3
         LI,R2    OPENEF+8
         BAL,SR3  MOVFIL
         LI,R4    X'15'             PUT CR TOO
         STB,R4   0,R3
         SW,R3    R5
         STB,R3   0,R5
         SLS,R5   -2
BRKXIT   CAL1,2   TYPE
         B        STMPSM1
D10      DATA     10
D30      DATA     30
CPUMSG   TEXTC    'CPU'
RSTBRK   DATA     X'6100000'
TTIMER   DATA     X'12000002'
NOBM     TEXTC    ' ??'
TYPE     DATA     X'2000000',X'80000000',X'80000005'
         FIN
         FIN
         CSECT    1
         DEF      MCRT
MCRT     EQU      %
*K* MXX DEFINES A RIGHT-JUSTIFIED MASK OF 'XX' BITS
*K* MNXX DEFINES A LEFT-JUSTIFIED MASK OF 'XX' BITS
*K* XNNNN DEFINES A RIGHT-JUSTIFIED MASK OF VALUE X'NNNN'
*K* YNNNN DEFINES A LEFT-JUSTIFIED MASK OF X'NNNN'
         DEF      M1
         DEF      M2
         DEF      M3
         DEF      M4
         DEF      M5
         DEF      M6
         DEF      M7
         DEF      M8
         DEF      M9
         DEF      M10
         DEF      M11
         DEF      M15
         DEF      M16
         DEF      M17
         DEF      M20
         DEF      M24
         DEF      M30
         DEF      M32
         DEF      MN1
         DEF      MN2
         DEF      MN3
         DEF      MN4
         DEF      MN8
         DEF      MN9
         DEF      MN16
         DEF      X8
         DEF      Y1
         DEF      Y2
         DEF      Y4
         DEF      Y8
         DEF      Y01
         DEF      Y02
         DEF      Y03
         DEF      Y05
         DEF      Y08
         DEF      Y68
         DEF      YFF
         DEF      Y001
         DEF      Y002
         DEF      Y003
         DEF      Y004
         DEF      Y006
         DEF      Y008
         DEF      Y00C
         DEF      Y018
         DEF      Y048
         DEF      Y0001
         DEF      Y0002
         DEF      Y0003
         DEF      Y0004
         DEF      Y0005
         DEF      Y0006
         DEF      Y0007
         DEF      Y0008
         DEF      Y000B
         DEF      Y000C
         DEF      Y000F
         DEF      Y00FF
         DEF      Y0303
         DEF      Y0304
         DEF      Y0343
         DEF      Y0405
         DEF      Y00FFFF
         DEF      Y00008
         DEF      YFF00FFFF
         DEF      YFFF0FFFF
         DEF      YF0FFFFFF         HEAD RECORD WORD 0 MASK.
         DEF      Y8000FF30         HEAD RECORD WORD 0 AFTER MASK.
         DEF      MRFXPSD           XPSD INSTRUCTION FOR MREF TO USE
         DEF      MSKFTYPE          EQUAL TO ABSOLUTE X'F0000'
         DEF      TXF:              HAS 'F:' IN BYTES 1,2
         DEF      TXM:              HAS 'M:' IN BYTES 1,2
         DEF      TXLIB             TEXTC ':LIB'
         DEF      TX6F4:            TEXTC 'F4:' WITH BYTE COUNT=6
         DEF      TXHEAD            TEXTC 'HEAD' WITH TRAILING ZEROES
         DEF      TXTREE            TEXTC 'TREE' WITH TRAILING ZEROES
         DEF      HEADWD            WORD 0 OF HEAD, TYPE =80
         DEF      VAL%SW            PREVERVES LOCWD BETWEEN NAME & VAL SORT
         DEF      LIBFLG            SET NONZERO BY FIN FOR LIB LMN
         DEF      HEADADR           BUFFER ADDRESS FOR HEAD RECORD
         DEF      LMNSW             SET TO 1 IF L.M. EXISTS, ELSE 0
         DEF      SYMBOLTB          SET ZERO IF NO INTERNAL SYMBOL TBL
         DEF      SYMTOP            TOP LOCATION OF INTERNAL SYMBOL TBL
         DEF      LHEADWD           HEAD WORD OF TYPE 81 LMN
         DEF      TXBLNK            A WORD OF BLANKS
         DEF      ER1X              UNEXPECTED EOF ERROR ROUTINE
         DEF      ER8               STACK OVERFLOW-ERR CODE
         DEF      ER6X              CANNOT OPEN E.F.
         DEF      ER7X              UNABLE TO OPEN E.F. ERROR ROUTINE
         DEF      ER9               BIAS TOO LARGE-ERR CODE
         DEF      ERAX              ILLEGAL ROM LANGUAGE ERR ROUTINE
         DEF      ERB               BAD START ADDRESS-ERR CODE
         DEF      ERC               UNEXPECTED ROM END-ERR CODE
         DEF      ERD               ZERO REPEAT LOAD COUNT-ERR CODE
         DEF      ERE               IMPROPER BOUND-ERR CODE
         DEF      ERF               ILLEGAL ORG-ERR CODE
         DEF      ER10X             I/O ERROR ON M:LM ROUTINE
         DEF      ER11              SEV. LEVEL EXCEEDED-ERR CODE
         DEF      ER12              ILL. LIB. LOAD MODULE ERR CODE
         DEF      ER14              ILLEGAL DSECT - ERR CODE
         DEF      ER15              ROOT SEGMENT TOO LARGE-ERR CODE
         DEF      ER16              CANT ENTER EXTENDED MEMORY MODE-
*,*                                 NO ROOM FOR CORE IMAGE BUFFER
         DEF      ER17              CANT ENTER EXTENDED MEMORY MODE -
*,*                                 STACKS TOO LARGE. (ERR CODE)
         DEF      ER18              NO ROOM TO CONCATENATE XMEM
*,*                                 PAGES (ERROR CODE)
         DEF      ER19              NO ROOM FOR LIB CORE IMAGE
         DEF      ER1A              NO ROOM FOR LIB RELOCATION DICT.
         DEF      ER1B              NO ROOM FOR NEW EXPRESSION
         DEF      ER1F              INSUFFICIENT PHYSICAL MEMORY-ERR CODE
         DEF      ER20              BAD A/M RECORD-ERR CODE
         DEF      ER21              NO ROOM TO ADD LIBRARY LOAD MODULE
*,*                                 TO ROM TABLE (ERR CODE)
         DEF      ER22              NO ROOM TO READ LIBRARY
*,*                                 REF/DEF STACK (ERR CODE)
         DEF      ER23              NO ROOM TO UPDATE LIB-ERR CODE
         DEF      ER32              CANT MAP EXISTING LMN-ERR CODE
         DEF      BLANKER           ROUTINE TO FILL PBUF WITH BLANKS
         DEF      BINTOHEX          CONVERTS BINARY TO EBCDIC HEX
         DEF      READBILI          READS A RECORD FROM M:EF
         DEF      MESSAGE           PRINTS AN ERROR MESSAGE & ERROR CODE
         DEF      IOMSG             PRINTS IO MESSAGES
         DEF      GBYTE0            CHECK FIRST  RECORD OF  ELEMENT FILE
         DEF      READBIL0          READ 1ST EF RECORD..SET TYPE FOR REST
         DEF      GBYTE             RETURN NEXT BYTE OF ELEMENT FILE
         DEF      2BNUM             RETURN NEXT 2 BYTES OF ELEMENT FILE
         DEF      3BNUM             RETURN NEXT 3 BYTES OF ELEMENT FILE
         DEF      4BNUM             RETURN NEXT 4 BYTES OF ELEMENT FILE
         DEF      12BNUM            RETURN NEXT 1 OR 2 BYTE DECLARATION
*,*                                 NUMBER FROM ELEMENT FILE
         DEF      GETSEG            ROUTINE TO FOLLOW A TREE STRUCTURE
         DEF      DECLSTK           DECLARATION STACK SPD
         DEF      DECLSTK1          2ND WORD OF DECLSTK SPD
         DEF      DECLBAS           BASE OF DECLARATION STACK
         DEF      RFDFBAS           BASE OF REF/DEF STACK
         DEF      RFDFSTK           SPD FOR REF/DEF STACK
         DEF      RFDFSTK1          2ND WORD OF RFDFSTK SPD
         DEF      EXPRSTK           SPD FOR EXPRESSION STACK
         DEF      EXPRSTK1          2ND WORD OF EXPRSTK SPD
         DEF      EXPRBAS           BASE OF EXPRESSION STACK
         DEF      BSEG1             TEMPORARY SEGMENT NUMBER
         DEF      BSEG2             BASE OF LARGEST INTERNAL SYMB TBL
         DEF      CSEG1             DISPLACEMENT FROM BEGINNING OF TREE
*,*                 TABLES TO BEGINNING OF TREE FOR CURRENT SEGMENT.
         DEF      CSEG2             TEMP. STORAGE FOR SEGMENT NUMBER
         DEF      CROM1             CURRENT ROM POINTER-DISPLACEMENT
*,*                 FROM START OF ROM TABLE TO CURRENT ROM
         DEF      CRFDF1            POINTER TO CURRENT REF/DEF ENTRY
         DEF      CRFDF2            TOP OF CURRENT REF/DEF STACK
         DEF      EXPRES            TEMP SAVE FOR EXPRESSIONS
         DEF      CURBYTE           DISPLACEMENT INTO CARD IMAGE
*,*                                 BEING READ BY GBYTE.
         DEF      RCDSIZE           SIZE OF ROM RECORD READ BY GBYTE
         DEF      SEQNUM            ACTUAL SEQUENCE NUMBER OF RECORD
*,*                                 JUST READ BY GBYTE.
         DEF      SEVLEV            SEVERITY LEVEL OF LOAD MODULE
         DEF      LASTCARD          FLAG SET FOR LAST CARD OF ROM
         DEF      BUF               USED AS ROM INPUT BUFFER BY
*,*                 BY PS1 & EVL. USED AS OUTPUT BUFFER BY FIN,WRT.
         DEF      BUF2              USED TO BUILD AN EXPRESSION
*,*                 FROM LOAD RELOCATABLE LOAD ITEM. USED IN WRT.
         DEF      TEMPPTR           USED TO KEEP TRACK OF TEMP
*,*                                 STACK IN USER'S TCB.
         DEF      TREEPTR           POINTER TO LOADER-BUILT TREE TBL
         DEF      FCOUNT            SIZE OF DCB NAME TABLE; USED
*,*                                 IN PASS1
         DEF      FTABLE            START ADDRESS OF DCB NAME TABLE
         DEF      ERRTAB            ERTABLE SIZE FROM LOCCT
         DEF      ERRSTK            ERSTACK SIZE FROM LOCCT
         DEF      TCBSIZE           TOTAL SIZE OF TARGET TCB
         DEF      TCBPTR            START ADDRESS OF TARGET TCB
         DEF      FTAB              START ADDRESS OF DCB NAME
*,*                 TABLE AT EXECUTION TIME. SET IN ALLL, USED IN WRT.
         DEF      RSEG00            POINTER TO ROOT SEGMENT TYPE 00
         DEF      RSEG01            POINTER TO ROOT SEGMENT TYPE 01
         DEF      RSEG10            POINTER TO ROOT SEGMENT TYPE 10
         DEF      RREL00            POINTER TO ROOT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 00
         DEF      RREL01            POINTER TO ROOT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 01
         DEF      RREL10            POINTER TO ROOT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 10
         DEF      CSEG00            POINTER TO CURRENT SEGMENT
*,*                                 FOR PROTECTION TYPE 00
         DEF      CREL00            POINTER TO CURRENT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 01
         DEF      CREL01            POINTER TO CURRENT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 01
         DEF      CREL10            POINTER TO CURRENT SEGMENT'S
*,*                 RELOCATION DICTIONARY FOR PROTECTION TYPE 10
         DEF      MAX00             LARGEST PROTECTION TYPE AREAS
*,*                 WHICH HAVE TO BE ALLOCATED FOR EACH SEGMENT
         DEF      MAX01             LARGEST PROTECTION TYPE AREAS
*,*                 WHICH HAVE TO BE ALLOCATED FOR EACH SEGMENT
         DEF      MAX10             LARGEST PROTECTION TYPE AREAS
*,*                 WHICH HAVE TO BE ALLOCATED FOR EACH SEGMENT
         DEF      DLOC              EXECUTION LOCATION COUNTER FOR 00
         DEF      PLOC              EXECUTION LOCATION COUNTER FOR 01
         DEF      SLOC              EXECUTION LOCATION COUNTER FOR 10
         DEF      LOC               LOAD LOCATION COUNTER
         DEF      START             LOAD MODULE START ADDRESS
         DEF      LOCCT             ADDRESS OF LOCCT
         DEF      LOADBAS           ACTUAL LOAD BIAS USED
         DEF      MODBAS            USED FOR MERGING CORE IMAGE
*,*                                 RECORD INTO XMEM BUFFERS. SEE EVL.
         DEF      RELDBAS           BASE OF RELOCATION DICTIONARY
*,*                                 FOR CORE IMAGE LIBRARY.
         DEF      MBIAS             START OF ORIGINAL REF/DEF STACK
         DEF      FBIAS             USED FOR PAGED LOAD MODULES,
*,*                 ADDRESS POINTING INTO CORE IMAGE BUFFERS.
         DEF      BIAS              EQUIVALENT OF ORG TO EXECUTION
*,*                                 ADDRESS OF START OF ROM.
         DEF      RDIG              RELOCATION DIGIT
         DEF      MODSIZ            ARS FROM M:EF AFTER READING
*,*                                 RELOCATION DICTIONARY.
         DEF      NOTLLM            FLAG IN WRT FOR NOT A LIB. LMN
         DEF      MAXRFDF           LONGEST REF/DEF PATH FROM PASS1
         DEF      MAXEXPR           LONGEST EXPRESSION PATH FROM PASS1
         DEF      TOPOMEM           LAST AVAILABLE ADDRESS
         DEF      OPENEF            OPEN PLIST FOR M:EF
         DEF      USID              USER SYSID
         DEF      CSECFLG           FLAG FOR SPECIAL CSECT USED
*,*                                 IN MERGING LIBRARY LMNS.
         DEF      LOCWD             FIRST WORD OF THE LOCCT,
*,*                                 CONTAINING PARAMETER BITS.
         DEF      LIB               1 IF A LIBRARY LMN IS BEING LOADED
         DEF      XMKEY             1 IF LIB. LMN IS BEING LOADED
         DEF      PBUF              EXTENDED MEMORY MODE KEY USED
*,*                                 WRITE CORE IMAGE RECORDS.
         DEF      PLIB              FLAG WHICH GETS SET IF THE
*,*                 ADDITION OF A CORE EXPRESSION WOULD CAUSE THE
*,*                 EXPRESSION STACK TO OVERWRITE A CORE IMAGE
*,*                 BUFFER ABOVE IT.
         DEF      RFLDSG            SEGMENT NUMBER WHERE DEF IS
*,*                                 DEFINED IN BREF MODE.
         DEF      TEMPSIZE          SIZE OF LOADER DATA + TSTACK
         DEF      DECLSIZE          INITIAL SIZE OF DECLSTK
         DEF      EXPRDIS           DISPLACEMENT FROM START OF TREE
*,*                                 TO EXPRESSION STACK DESCRIPTOR
         DEF      RFLOADIS          DISPLACEMENT FROM START OF TREE
*,*                                 TO SIZE OF REF/BREF TABLES
         DEF      RFDFDIS           DISPLACEMENT FROM START OF TREE
*,*                                 TO REF/DEF STACK DESCRIPTOR.
         DEF      NXROMDIS          DISPLACEMENT FROM START OF ROMT
*,*                                 TO FLAG WORD FOR LAST ROM.
         DEF      SBLNKDIS          DISPLACEMENT FROM START OF TREE
*,*                                 TO SUBLINK FIELD.
         DEF      ROM1DIS           DISPLACEMENT FROM START OF TREE
*,*                                 TO ROM POINTER FIELD.
         DEF      TMPSZDIS          DISPLACEMENT FROM START OF LOCCT
*,*                                 TO TEMP STACK SIZE FIELD.
         DEF      NUNSTDIS          DISPLACEMENT FROM START OF LOCCT
*,*                                 TO NUMBER OF UNSATS.
         DEF      00DIS             DISPLACEMENT FROM START OF TREE
*,*                                 TO 00 TYPE DESCRIPTOR WORD.
         DEF      01DIS             DISPLACEMENT FROM START OF TREE
*,*                                 TO 01 TYPE DESCRIPTOR WORD.
         DEF      10DIS             DISPLACEMENT FROM START OF TREE
*,*                                 TO 10 TYPE DESCRIPTOR WORD.
         DEF      01SIZ             FOR SPECIAL CSECT IN MERGING
*,*                                 LIBRARY LMNS. SEE ALLL.
         DEF      NRWACCT           DISPLACEMENT FROM START OF LOCCT
*,*                                 TO NUMBER OF READ & WRITE ACCOUNTS.
         DEF      TREESIZE          SIZE OF A TREE TABLE ENTRY
         DEF      TREEDIS           DISPLACEMENT FROM START OF LOCCT
*,*                                 TO TREE TABLE DISPLACEMENT.
         DEF      TREELOC           ADDRESS OF TREE TABLES - USED BY EVL.
         DEF      BIASDIS           DISPLACEMENT FROM START OF LOCCT
*,*                                 TO BIAS.
         DEF      LOWLIMDS          DISPLACEMENT FROM START OF LOCCT
*,*                                 TO BACKGROUND LOWER LIMIT (BPM).
         DEF      FCOMDIS           DISPLACEMENT FROM START OF LOCCT
*,*                                 TO FCOM ENTRY (BPM).
         DEF      ERRDIS            DISPLACEMENT FROM START OF LOCCT
*,*                                 TO ERSTACK, ERTABLE INFORMATION.
         DEF      LMNDIS            DISPLACEMENT FROM START OF LOCCT
*,*                                 TO LOAD MODULE NAME.
         DEF      USACTDIS          DISPLACEMENT FROM START OF LOCCT
*,*                                 TO USER ACCOUNT NUMBER.
         DEF      LMPASS            DISPLACEMENT FROM START OF LOCCT
*,*                                 TO LOAD MODULE PASSWORD.
         DEF      LMEXPDIS          DISPLACEMENT FROM START OF LOCCT
*,*                                 TO LOAD MODULE EXPIRATION DATE.
         DEF      ROMSIZE           SIZE OF ROM TABLE ENTRY
         DEF      TCBBLNK           NUMBER OF BLANK WORDS IN TCB
         DEF      LIBER             I/O ERROR HANDLER FOR M:EF
         DEF      MXRFDFSG          CONTAINS SEGMENT NUMBER, AID
*,*                 IN DETERMINING PATH HAVING LARGEST REF/DEF STACK..
         DEF      FCOMSIZ           SIZE OF BLANK COMMON
         DEF      NXTAVPG           EXECUTION ADDRESS OF PAGE JUST
*,*                                 JUST ABOVE THE LOAD MODULE.
         DEF      XMEM3X            ROUTINE TO HANDLE READ ERRORS
*,*                                 OF XMEM CORE IMAGE FILE.
         DEF      RLOC              LOAD LOCATION COUNTER FOR
*,*                                 RELOCATION DICTIONARIES.
         DEF      TRESIZ            SIZE OF THE LOADER TO SEE IF
*,*                 IF IT MUST DO SEGLOADS OR CAN JUST BRANCH.
         DEF      XMRKEY            EXTENDED MEMORY MODE KEY FOR
*,*                                 READING THE RELOCATION DICTIONARY.
         DEF      04LOC             IN ALLL, POINTER TO LAST CSECT
*,*                 WHEN SEARCHING FOR SPECIAL LIBRARY CONTROL SECTIONS.
*,*                 IN SPECDSEC, THE LOCATION OF AN 04 TYPE ENTRY.
         DEF      TSTACK            SPD FOR LOADER'S TEMP STACK
         DEF      BREFBIT           BREF FLAG IN LOCWD
         DEF      TXS:OVRL          TEXTC 'S:OVRLY'
         DEF      DOREFPTR          IN BREF MODE, POINTER TO
*,*                                 S:OVRLY IN REF/DEF STACK.
         DEF      RFLDMODS          REF AND BREF FLAGS IN LOCWD
         DEF      RFLDTBSZ          REF COUNT FROM LOCCT
         DEF      BREFERR           COUNT OF REFS OVERFLOWING BREF TABLE
         DEF      PASS3RET          INFORMATION SAVED FOR RETURN
*,*                                 TO PASS3 OR CCI.
         DEF      RELPAGE           BEGINNING PAGE ADDRESS OF
*,*                 LIBRARY REF/DEF STACK. USED IN PS1 TO FREE
*,*                 LIBRARY REF/DEF STACK PAGES AFTER USE.
         DEF      HEADSIZE          SIZE OF HEAD RECORD
         DEF      HEADRFDF          DISPLACEMENT INTO HEAD OF
*,*                                 REF/DEF DESCRIPTOR WORD.
         DEF      FIRSTF            POINTER INTO REF/DEF STACK
*,*                                 FOR 1ST FORWARD REFERENCE.
         DEF      LASTF             POINTER INTO REF/DEF STACK
*,*                                 FOR LAST FORWARD REFERENCE.
         DEF      XCSEG1            RETAINS CURRENT SEGMENT TO
*,*                 PERMIT ALTERNATE USE OF CSEG1 FOR XMEM.
         DEF      DECLCHK           ROUTINE TO TEST VALIDITY OF
*,*                                 A DECLARATION NUMBER.
         DEF      CODE              LOADER ERROR CODE AFTER AN ERROR.
         DEF      KICKOUT           USED IN EXPRESSION STACK SQUEEZE,
*,*                 IN PS1, USED TO SAVE POINTER TO LIB. LMN'S
*,*                 SPECIAL REF/DEF ENTRY. IN SQUEEZ, CONTAINS COUNT
*,*                 OF ENTRIES DELETED FROM ROOT'S EXPRESSION STACK.
         DEF      CFUPTR            POINTER TO VALUE WORD OF
*,*                                 REF/DEF ENTRY FOR M:*
         DO       MODE=1
         DEF      CORELIB           USED IN PS1 TO SHOW IF REF
*,*                                 TO 9INITIAL OR 9DBINIT WAS HIT.
         DEF      M:FVP             M:FVP FPT
         DEF      LIBEXPR           USED TO SAVE POINTER TO 2ND WORD
*,*                 OF LIBRARY LMN'S SPECIAL 3-WORD EXPRESSION
*,*                 STACK ENTRY DURING PASS1.
         DEF      MREFLAG           SET NON-ZERO IN IN1 IF
*,*                                 LOADING IN MREF MODE.
         DEF      MREFTAB           POINTS TO VALUE WORD OF DEF
*,*                 ENTRY IN REF/DEF STACK DEFINING MREF TABLE.
         DEF      TOVBALPSD         POINTS TO VALUE WORD OF DEF
*,*                 ENTRY IN REF/DEF STACK DEFINING T:OVBALPSD
         DEF      TOVBPSD           POINTS TO VALUE WORD OF DEF
*,*                 ENTRY IN REF/DEF STACK DEFINING T:OVBPSD
         DO       CFU=1
         DEF      TXM:STAR          TEXTC FOR 'M:*'
         FIN
         FIN
         DO       MODE=0
         DEF      SNM:LM            INSN FIELD OF M:LM (BPM ONLY)
         FIN
         DEF      BITMASKS          ORDERED TABLE OF MASKS
         DEF      TEMPR1            SCRATCH STORAGE USED IN CRITICAL CODE
         DEF      FASTSRCH          FLAG = 0 IF USING BINARY SORT
         DEF      RDPTRS            BINARY SORT TABLE OF REF/DEF PTRS
         DEF      RDSYMS            NO. OF ENTRIES IN RDPTRS
         DEF      GSYMSIZ           SIZE OF GLOBAL SYMBOLS
         DEF      PATCHD            PATCH AREA IN DATA PAGE
         DEF      UNSATFLG          N.A.P FLAGS FOR UNSAT TBL
         DEF      UNSATTBL          ADDR OF UNSAT IN LOCCT
         DEF      SATREF            SATISFYY PREFS FROM LIBS...ENTRY
         DEF      ADLEF             ADD EF FROM LIBRARY
         DEF      SETEF             SET ERR,ABN IN M:EF TO *SR1
         DEF      SEGBSR4           SEGLOAD AND B *SR4
         REF      CALLP1            ENTRY TO PASS1 FOR LIBRARIES
*
*        REFS
*
         REF      INIT1             ENTRY POINT TO IN1
         REF      INIT2             ENTRY POINT TO IN2
         REF      PASS1             ENTRY POINT TO PS1
         REF      PASS2             ENTRY POINT TO PS2
         REF      FINISH            ENTRY POINT TO FIN
         REF      SAT               ENTRY POINT TO SAT
         REF      EFNAME            GET NAME IN OPENEF IN ROOT RFDFSTK
         REF      EFACCNT           ACCOUNT IN OPENEF IN ROOT STACK
         REF      EFPASS            PASSWORD IN OPENEF
         REF      J:LMN             FOR SETTING LAST LOADED LMN
         REF      XMRDERR           READ ERROR ROUTINE FOR XMEM
*,*                                 CORE IMAGE FILE.
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         DO       MODE=0
         DEF      CJOB
CJOB     EQU      X'4F'
         FIN
         PAGE
*                 IMMEDIATE CONSTANTS FOR LOADER.
K0       EQU      0
K1       EQU      1
K2       EQU      2
K3       EQU      3
K4       EQU      4
K5       EQU      5
K6       EQU      6
K7       EQU      7
K8       EQU      8
K9       EQU      9
KA       EQU      X'A'
KB       EQU      X'B'
KC       EQU      X'C'
KD       EQU      X'D'
KE       EQU      X'E'
KF       EQU      X'F'
K10      EQU      X'10'
K11      EQU      X'11'
K12      EQU      X'12'
K16      EQU      X'16'
K17      EQU      X'17'
K19      EQU      X'19'
K1C      EQU      X'1C'
K1E      EQU      X'1E'
K1F      EQU      X'1F'
K20      EQU      X'20'
K24      EQU      X'24'
K39      EQU      X'39'
K3C      EQU      X'3C'
K3F      EQU      X'3F'
K40      EQU      X'40'
K43      EQU      X'43'
K6C      EQU      X'6C'
K78      EQU      X'78'
K80      EQU      X'80'
K81      EQU      X'81'
KF0      EQU      X'F0'
KFF      EQU      X'FF'
K100     EQU      X'100'
K120     EQU      X'120'
K1FF     EQU      X'1FF'
K200     EQU      X'200'
K202     EQU      X'202'
K256     EQU      X'256'
K800     EQU      X'800'
KC00     EQU      X'C00'
K3FFF    EQU      X'3FFF'
K7FFF    EQU      X'7FFF'
K8000    EQU      X'8000'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -1
KN2      EQU      -2
KN3      EQU      -3
KN4      EQU      -4
KN8      EQU      -8
KN16     EQU      -16
KN100    EQU      -100
KTE      EQU      'E'
KTR      EQU      'R'
         PAGE
BE       EQU      X'683'
BNEZ     EQU      X'693'
BGE      EQU      X'681'
BGEZ     EQU      X'681'
BL       EQU      X'691'
BAZ      EQU      X'684'
BCR8     EQU      X'688'
BLE      EQU      X'682'
BEZ      EQU      X'683'
BCR10    EQU      X'68A'
*        QUIT     ERROR,CONDITION,OUTPUT
QUIT     CNAME
         PROC
LF       EQU      %
         DO       NUM(AF)=3
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+4
         FIN
         STW,AF(3) CODE
         ELSE
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+3
         FIN
         FIN
         LI,R3    AF(1)
         DO       MODE=1&AF(3)=SR3
         B        IOMSG
         ELSE
         B        MESSAGE
         FIN
         PEND
SNAPIT   CNAME
         PROC
LF       CAL1,3   %+1
         DATA     0
         GEN,1,31 AFA(1),AF(1)
         GEN,1,31 AFA(2),AF(2)
         DATA     AF(3),AF(4),X'02000000'
         PEND
         PAGE
BINSRTL  DATA     BINSRT,BINX       DOUBLE WORD LIMITS
BITMASKS RES
I        DO       33
         DATA     X'FFFFFFFF'**(I-33)
         FIN
*                 STATIC DATA FOR LOADER.
M1       EQU      BITMASKS+1
M2       EQU      BITMASKS+2
M3       EQU      BITMASKS+3
M4       EQU      BITMASKS+4
M5       EQU      BITMASKS+5
M6       EQU      BITMASKS+6
M7       EQU      BITMASKS+7
M8       EQU      BITMASKS+8
M9       EQU      BITMASKS+9
M10      EQU      BITMASKS+10
M11      EQU      BITMASKS+11
M15      EQU      BITMASKS+15
M16      EQU      BITMASKS+16
M17      EQU      BITMASKS+17
M20      EQU      BITMASKS+20
M24      EQU      BITMASKS+24
M30      EQU      BITMASKS+30
M32      EQU      BITMASKS+32
*
MN1      DATA,4   X'FFFFFFFE'
MN2      DATA,4   X'FFFFFFFC'
MN3      DATA,4   X'FFFFFFF8'
MN4      DATA,4   X'FFFFFFF0'
MN8      DATA,4   X'FFFFFF00'
MN9      DATA,4   X'FFFFFE00'
MN16     DATA,4   X'FFFF0000'
Y1       DATA,4   X'10000000'
Y2       DATA,4   X'20000000'
Y4       DATA,4   X'40000000'
Y68      DATA,4   X'68000000'
Y8       DATA,4   X'80000000'
Y01      DATA,4   X'1000000'
Y018     DATA     X'01800000'
Y02      DATA,4   X'2000000'
Y03      DATA,4   X'3000000'
Y05      DATA     X'05000000'
Y048     DATA     X'04800000'
Y08      DATA,4   X'8000000'
Y006     DATA,4   X'00600000'
Y001     DATA,4   X'100000'
Y002     DATA,4   X'200000'
Y003     DATA,4   X'300000'
Y004     DATA,4   X'400000'
Y008     DATA,4   X'800000'
Y00C     DATA,4   X'C00000'
Y00FFFF  DATA,4   X'FFFF00'
Y0001    DATA,4   X'10000'
Y0002    DATA,4   X'20000'
Y0003    DATA,4   X'30000'
Y0004    DATA,4   X'40000'
Y0005    DATA,4   X'50000'
Y0006    DATA,4   X'60000'
Y0007    DATA,4   X'70000'
Y0008    DATA,4   X'80000'
Y00008   DATA,4   X'8000'
Y000B    DATA,4   X'B0000'
Y000C    DATA,4   X'C0000'
Y0302    DATA,4   X'3020000'
Y0303    DATA,4   X'3030000'
Y0343    DATA,4   X'3430000'
Y0304    DATA,4   X'3040000'
Y0405    DATA,4   X'4050000'
Y00FF    DATA,4   X'FF0000'
YFF      DATA,4   X'FF000000'
YFF00FFFF    DATA,4  X'FF00FFFF'
Y000F    DATA,4   X'F0000'
YFFF0FFFF    DATA,4  X'FFF0FFFF'
YF0FFFFFF DATA    X'F0FFFFFF'       HEAD RECORD WORD 0 MASK.
Y8000FF30 DATA    X'8000FF30'       HEAD RECORD WORD 0 AFTER MASK.
MRFXPSD  XPSD,2   0
         PAGE
MSKFTYPE EQU      Y000F
TXBLNK   DATA    X'40404040'
TXF:     DATA,4   X'C67A00'
TXM:     DATA,4   X'D47A00'
TXLIB    TEXTC    ':LIB'
TX6F4:   DATA,4   X'06C6F47A'
TXS:OVRL TEXTC    'S:OVRLY'
         DO       MODE=1
         DO       CFU=1
TXM:STAR TEXTC    'M:*'
         FIN
         FIN
TXHEAD   GEN,8,24 4,'HEA'
         GEN,8,24 'D',0
HEADWD   DATA     X'8000FF18'
LHEADWD  DATA     X'8100FF18'
TXTREE   GEN,8,24 4,'TRE'
         GEN,8,24 'E',0
IN2      RES
SATT     RES
IN1      TEXTC    'IN1'
PS1      TEXTC    'PS1'
FIN      TEXTC    'FIN'
X8       DATA     8
         DO       MODE~=0
M:FVP    GEN,8,24 5,0
GVP      GEN,8,24 4,0
FCP      DATA     X'0D0000FF'
         FIN
BREFBIT  EQU      Y4                BREF FLAG IN LOCWD
RFLDMODS DATA     X'40000004'       REF AND BREF FLAGS
         PAGE
         DEF      READLM            FPT USED TO READ LOAD MODULE
         DEF      WRITELM           FPT USED TO WRITE LOAD MODULE
         DEF      CLOSE             GENERAL M:CLOSE *R5 FPT
         DEF      READEF            FPT USED TO READ ELEMENT FILE
         DEF      PRINT             M:PRINT *R5 FPT.
         DEF      SEGLOAD           M:SEGLD *R5 FPT.
M:LL     DSECT    1
         DATA     X'103'
         GEN,15,17 2,4
         DATA     0,0,0
         GEN,2,30 2,0               SPECIFY SAVE ON AN OUTPUT DCB
         DATA     FPLLL
         DATA     0,0,0
         DATA     KBLL
         DO       11
         DATA     0
         FIN
FPLLL    DATA     X'01000003'
         DATA     0,0,0
         DATA     X'02000002',0,0,X'03000002',0,0
         DATA     X'7010003'
         DATA     0,0,0
KBLL     RES      8
M:EF     DSECT    1
         DATA     0,0,0,0,0,0,FPLEF,0,0,0,KBEF
         DO       11
         DATA     0
         FIN
FPLEF    DATA     X'1000003'
         RES      3
         DATA     X'2000002',0,0,X'3000002',0,0,X'7010002',0,0
KBEF     RES      8
M:LM     DSECT    1
         DATA     0,0,0
         DATA     ER10X
         DATA     0,X'80000000'
         DATA     FPLLM,0,0,0,KBLM
         DATA     0,X'0F000000'
         DO       9
         DATA     0
         FIN
FPLLM    DATA     X'1000003'
         RES      3
         DATA     X'2000002',0,0,X'3000002',0,0,X'4000002',0,0
         DATA     X'5000010'
         DO       16
         DATA     0
         FIN
         DATA     X'06000010'
         DO       16
         DATA     0
         FIN
SNM:LM   DATA     X'07000002'
         DO       2
         DATA     0
         FIN
         DO       MODE=0
         DATA     X'0B010202',0,0
         ELSE
         DATA     X'B000003',0,0,0
         DATA     X'14000010'
         DO       16
         DATA     0
         FIN
         DATA     X'15010003',0,0,0
         FIN
KBLM     RES      8
M:MSG    DSECT    1
         DATA     1,X'20000',PBUF+4
         DATA     BADERMSG,BADERMSG
         DATA     X'80000022',FPLMSG,0,0,0,KBMSG,0
         DATA     X'04000000'
         DO       9
         DATA     0
         FIN
FPLMSG   DATA     X'01000202'
         TEXTC    'ERRMSG'
         DATA     X'02010202'
         TEXT     ':SYS    '
KBMSG    RES      8
         USECT    MCRT
READLM   GEN,8,24 X'10',M:LM
         DATA     X'38000010'
         DATA     X'80000005',X'80000006',X'80000007'
WRITELM  GEN,8,24 X'11',M:LM
         DATA     X'38000070'
         DATA     X'80000005',X'80000006',X'80000007'
CLOSE    DATA     X'95000005',X'80000010',2
PRINT    GEN,8,24 1,M:LL
         GEN,1,31 1,0
         DATA     X'80000005'
READEF  GEN,8,24 X'10',M:EF
         DATA     X'7C000010'
         DATA     EOF,X'80000004',X'80000006',X'80000005',0
SETEF    GEN,8,24 6,M:EF
         DATA     X'C0000000'
         PZE      *SR1
         PZE      *SR1
PFIL0    GEN,8,24 X'1C',M:EF
         DATA     X'10'             BOF
SEGLOAD  GEN,8,24 1,0
         DATA     X'80000005'
RDMSG    GEN,8,24 X'10',M:MSG
         DATA     X'D8000000'
         DATA     BADERMSG
         DATA     BADERMSG
         DATA     X'80'
         DATA     ERFLAG
         PAGE
         CSECT
STUFF    RES      0
DECLSTK  RES      2
DECLSTK1 EQU      DECLSTK+1
RFDFSTK  RES      2
RFDFSTK1 EQU      RFDFSTK+1
EXPRSTK  RES      2
EXPRSTK1 EQU      EXPRSTK+1
DECLBAS  RES      1
RFDFBAS  RES      1
EXPRBAS  RES      1
BSEG1    RES      1
BSEG2    RES      1
CSEG1    RES      1
CSEG2    RES      1
CROM1    RES      1
CRFDF1   RES      1
CRFDF2   RES      1
CURBYTE  RES      1
RCDSIZE  RES      1
SEQNUM   RES      1
SEVLEV   RES      1
LASTCARD RES      1
BUF      RES      30
BUF2     RES      4
TEMPPTR  RES      1
TREEPTR  RES      1
RELPAGE  RES      1
FCOUNT   RES      1
FTABLE   RES      1
ERRTAB   RES      1
ERRSTK   RES      1
TCBSIZE  RES      1
TCBPTR   RES      1
FTAB     RES      1
RSEG00   RES      6
RSEG01   EQU      RSEG00+1
RSEG10   EQU      RSEG00+2
RREL00   EQU      RSEG00+3
RREL01   EQU      RSEG00+4
RREL10   EQU      RSEG00+5
CSEG00   RES      6
CSEG01   EQU      CSEG00+1
CSEG10   EQU      CSEG00+2
CREL00   EQU      CSEG00+3
CREL01   EQU      CSEG00+4
CREL10   EQU      CSEG00+5
MAX00    RES      3
MAX01    EQU      MAX00+1
MAX10    EQU      MAX00+2
DLOC     RES      3
PLOC     EQU      DLOC+1
SLOC     EQU      DLOC+2
LOC      RES      1
START    RES      1
LOCCT    RES      1
LOADBAS  RES      1
MODBAS   RES      1
RELDBAS  RES      1
MBIAS    RES      1
FBIAS    RES      1
BIAS     RES      1
RDIG     RES      1
MODSIZ   RES      1
NOTLLM   RES      1
MAXRFDF  RES      1
MAXEXPR  RES      1
TOPOMEM  RES      1
OPENEF   RES      17
PLIB     RES      1
CSECFLG  RES      1
LIB      RES      1
XMKEY    RES      1
LOCWD    RES      1
USID     RES      1
RFLDSG   RES      1
ERFLAG   RES      1
MXRFDFSG RES      1
NXTAVPG  RES      1
RLOC     RES      1
01SIZ    RES      1
TRESIZ   RES      1
FCOMSIZ  RES      1
XMRKEY   RES      1
04LOC    RES      1
DOREFPTR RES      1
RFLDTBSZ RES      1
BREFERR  RES      1
PASS3RET RES      1
CORELIB  RES      1
FIRSTF   RES      1
LASTF    RES      1
XCSEG1   RES      1
SYMBOLTB RES      1
SYMTOP   RES      1
TRAPCC   RES      1
CODE     RES      1
KICKOUT  RES      1
LIBFLG   RES      1
VAL%SW   RES      1
HEADADR  RES      1
LMNSW    RES      1
MREFLAG  RES      1
MREFTAB  RES      1
TOVBALPSD RES     1
TOVBPSD  RES      1
TEMPR1   RES      1
FASTSRCH RES      1
RDSYMS   RES      1
RDPTRS   RES      1
BINRET   RES      1
GSYMSIZ  RES      1
CFUPTR   RES      1
TREELOC  RES      1
LIBEXPR  RES      1
ROMKEY   RES      1
UNSATTBL RES      1
EXPRES   RES      1
         BOUND    8
PBUF     RES      22
UNSATFLG RES      2
TSTACK   RES      256-(%-STUFF)
         RES      30                ALLOW EXTRA SPACE FOR
*                                    M:LM OPEN PLIST
SAVELOC  EQU      %
DDSIZE   EQU      LIBEXPR-DECLSTK+1
STKSIZE  EQU      256-DDSIZE-2
TEMPSIZE EQU      DDSIZE+STKSIZE+2
        PAGE
DECLSIZE EQU      X'40'
EXPRDIS  EQU      8
RFLOADIS EQU      10
RFDFDIS  EQU      6
NXROMDIS EQU      2
SBLNKDIS EQU      4
ROM1DIS  EQU      3
TMPSZDIS EQU      8
NUNSTDIS EQU      8
00DIS    EQU      5
01DIS    EQU      7
10DIS    EQU      9
NRWACCT  EQU      9
TREESIZE EQU      11
TREEDIS  EQU      2
BIASDIS  EQU      4
LOWLIMDS EQU      5
FCOMDIS  EQU      6
ERRDIS   EQU      7
LMNDIS   EQU      10
USACTDIS EQU      13
LMPASS   EQU      15
LMEXPDIS EQU      17
ROMSIZE  EQU      7
ROMSIZEL EQU      X'70000'
TCBBLNK  EQU      2
HEADRFDF EQU      5
         DO       MODE=0
HEADSIZE  EQU     6
         ELSE
HEADSIZE EQU      12
         FIN
         PAGE
*                 FILL UP REMAINDER OF LOADER'S 00 ROOT AREA WITH CODE
         ORG      SAVELOC
         DEF      LOADER            START LOCATION FOR THE LOADER
LOADER   EQU      %
         DO       DEBUG=1
         LI,R7    0
         FIN
*                                   IF TREE SIZE IS X'C',DONT DO
*                                   SEGLOADS-THERE WAS NO TREE CARD
*  (R7) = 0       IF ENTRY FROM CCI
*  (R7) = X'00FF0000' IF ENTRY FROM SYSGEN 'PASS3'
*                 THEREFORE, RETURN VIA M:LDTRC TO ID IN SR1
         DO       MODE~=0
         DO       DEBUG=0
         LI,R5    IN1
         CAL1,8   SEGLOAD
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD1
         LI,R5    PS1
         CAL1,8   SEGLOAD
         BAL,SR4  PASS1
         LI,R5    IN2
         CAL1,8   SEGLOAD
         BAL,SR4  INIT2
         BAL,SR4  PASS2
FIN%LD1  EQU      %
         LI,R5    FIN
         CAL1,8   SEGLOAD
         BAL,SR4  FINISH            DO MODIFYS AND MAP
         ELSE
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD2
         BAL,SR4  PASS1
         BAL,SR4  INIT2
         BAL,SR4  PASS2
FIN%LD2  EQU      %
         BAL,SR4  FINISH            DO MODIFYS AND MAP
         FIN
         ELSE
         LI,R5    M:LL
         AND,R5   MN9
         AI,R5    2
         LW,R5    *R5
         CI,R5    KC
         BLE      %+3
         LI,R5    IN1
         CAL1,8   SEGLOAD
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD3
         LW,R5    TRESIZ
         BEZ      NOLDPS1
         LI,R5    PS1
         CAL1,8   SEGLOAD
NOLDPS1  EQU      %
         BAL,SR4  PASS1
         LW,R5    TRESIZ
         BEZ      %+3
         LI,R5    IN2
         CAL1,8   SEGLOAD
         BAL,SR4  INIT2
         LW,R5    TRESIZ
         BEZ      %+3
         LI,R5    PS2
         CAL1,8   SEGLOAD
         BAL,SR4  PASS2
         LW,R5    TRESIZ
         BEZ      %+3
FIN%LD3  EQU      %
         LI,R5    FIN
         CAL1,8   SEGLOAD
         BAL,SR4  FINISH            DO MODIFYS AND MAP
*                                   NORMAL EXIT FROM LOADER
         FIN
         LI,D4    0                 SET OK FLAG FOR PASS3.
LEAVE    EQU      %
         LI,R5    M:LL              CLOSE M:LL WITH SAVE IN CASE
         CAL1,1   CLOSE             ... ITS ASSIGNED TO A FILE.
         CAL1,8   FCP               FREE COMMON MEMORY
         LW,SR1   PASS3RET
         BEZ      CCIEXIT           RETURN TO CALLER
         LW,R7    Y03               M:LDTRC FPT
         CAL1,8   R7                   M:LDTRC BACK TO SYSGEN PASS3
CCIEXIT  EQU      %
         LC       *79
         BCS,12   %+3               JUST EXIT IF NOT BATCH
         MTB,0    D4
         BNEZ     EXITE
         CAL1,9   1
         DO       MODE=0
EXITE    CAL1,9   3
         ELSE
EXITE    CAL1,9   X'10401'
         FIN
         PAGE
*                 GET BYTE IN R5.  READ A CARD IF NECESSARY. IF EOF
*                 OCCURS, DATA ERROR. IF LAST CARD OF BINARY DECK,
*                 SET LASTCARD. IF LASTCARD SET AND BYTES READ PAST
*                 END, DATA ERROR. CHECK SEQUENCE AND CHECKSUM. RECORD
*                 SIZE MUST BE LESS THAN OR EQUAL TO 108.
*
*                                   CURRENT BYTE NEGATIVE IS A SPECIAL
*                                   CASE TO JUST RUN CHECKS IN THE
*                                   FIRST WORD.
GBYTE    EQU      %
         MTW,1    CURBYTE
         LW,R1    CURBYTE
         LB,R5    0,R1
         SW,R1    RCDSIZE
         BLE      *SR4
         PSW,SR4  *R0
         BAL,SR4  READBILI
         B        ER1X
         PLW,SR4  *R0
GBYTE3   LB,R1    BUF
         AI,R1    -K3C
         STW,R1   LASTCARD
         BEZ      GBYTE1
         AI,R1    K3C-K1C
         BEZ      GBYTE1
         AI,R1    K1C-K81
         BL       ER2X
         AI,R1    K81-X'83'
         BG       ER2X
GBYTE1   LI,R1    K1
         MTW,1    SEQNUM
         LW,R5    SEQNUM
         CB,R5    BUF,R1
         QUIT     ER3,BE
*E*      ERROR:   0200-03
*E*      MESSAGE: SEQUENCE ERROR
*E*      DESCRIPTION: THE RECORDS OF A ROM WERE OUT OF SEQUENCE.
         LI,R1    K3
         LB,R1    BUF,R1
         CI,R1    K5
         BL       ER4X
         CI,R1    K6C
         BG       ER4X
         AI,R1    BA(BUF)-1
         STW,R1   RCDSIZE
         LI,R1    BA(BUF)+3         STARTING BYTE
         XW,R1    CURBYTE
         BGEZ     GBYTE
         PLW,R1   *R0               SPECIAL CALL
         LC       BUF               SET CC1 IF LOAD MODULE
         B        *SR4
*
GBYTE0   PSW,R1   *R0               SAVE REG
         LI,R1    -1
         STW,R1   CURBYTE           SET FLAG
         STW,R1   SEQNUM            AND INITIALIZE SEQ
         B        GBYTE3
         PAGE
         DO       MODE=1
         DEF      TRAP              MEMORY PROTECTION TRAP HANDLER AND
*,*                                 DYNAMIC STORAGE ALLOCATOR.
TRAP     EQU      %
         STCF     TRAPCC
         LI,R0    X'1FFFF'
         AND,R0   0,R1
         CI,R0    GETMEM
         BL       LDRTRAP
         LI,SR4   BUMPRET           SET RETURN FROM KILL SRCH
         LW,R2    *R0
         CI,R2    FASTSRCH          IS IT A SPECIAL CALL
         BE       KILLSRCH          YUP
         CLM,0    BINSRTL           IF WERE IN BINSRT
         BOL      %+3               AND THERE ISNT ONE
         MTW,0    FASTSRCH          BUMPEXIT
         BNEZ     BUMPRET
         PSW,R1   TSTACK            SAVE PTR FOR BUMPEXIT
         LCI      15
         LM,1     3,1
         ANLZ,R0  *R0
         STCF     2
         SLS,2    -30
         SLS,0    -2,2
         PLW,R1   TSTACK
         CI,R0    J:LMN             IF NOT SJAC, IGNORE ATTEMPT TO
         BE       BUMPRET           SET J:LMN
GETMEM   EQU      %
         AW,R0    GVP
         CAL1,8   0
         BCR,8    STMPSM1           WORKED, GO RETRY INSTRUCTION
         AI,0     X'200'
         CAL1,8   0
         BCR,8    STMPSM1
         LC       TRAPCC
         BCR,14   MEMTRAP           NO MEMORY TRAP PROLLY
LDRTRAP  EQU      %
*E*      ERROR:   0200-2A
*E*      MESSAGE: ILLEGAL LOADER TRAP
*E*      DESCRIPTION: A LOADER ERROR HAS OCCURRED.
*E*      REGISTERS: R0 HAS TRAPPED ADDRESS.
         QUIT     X'2A',,R0
MEMTRAP  SW,R0    GVP
         AI,R0    -X'200'
         CW,R0    LOCCT
         BL       LDRTRAP
         CW,R0    TOPOMEM
         BG       LDRTRAP
         MTW,0    FASTSRCH
         BNEZ     INSUFF            NOTHING TO RELEASE
         LI,SR4   TRAP+1            NORMAL RETURN
KILLSRCH RES
         MTW,1    FASTSRCH          IF WE HAD A SORT TABLE, WE DONT NOW
         LI,R2    X'1FF'            CALCULATE # PAGES TO GIVE UP
         AND,R2   RDPTRS
         AW,R2    RDSYMS
         AI,R2    X'1FF'
         SLS,R2   -9
         LI,R5    NOBINM            LET 'EM KNOW
         CAL1,2   PRINT
         LW,R3    RDPTRS            STARTING ADDR
         OR,R3    Y05               MAKE IT AN M:FVP FPT
         CAL1,8   R3                AND FREE UP THE PAGES IT USED
         AI,R3    X'200'
         BDR,R2   %-2
         MTB,1    RDPTRS            MAKE LARGE FOR RFDF STK
         MTB,-2   RDSYMS            MAKE SUM SMALL FOR EXPR STK
         B        *SR4
NOBINM   TEXTC    ' SLOW SEARCH MODE.'
INSUFF   EQU      %
*E*      ERROR:   0200-1F
*E*      MESSAGE: INSUFFICIENT PHYSICAL MEMORY
*E*      DESCRIPTION: INSUFFICIENT MEMORY TO FORM LOAD MODULE.
*E*      REGISTERS: R0 HAS ADDRESS OF LAST ATTEMPTED MEMORY ACCESS.
         QUIT     ER1F,,R0
BUMPRET  MTW,1    0,R1
STMPSM1  CAL1,9   5
         PAGE
         DEF      CHKLM             ROUTINE TO ACQUIRE BUFFER PAGES
*,*                                 TO BE USED FOR I/O.
CHKLM    PSW,R6   TSTACK            SAVE SIZE
         MTB,0    *R5,R6            ACCESS ONE BYTE FROM EACH PAGE
         AI,R6    -X'800'
         BGZ      %-2
         MTB,0    *R5               AND FIRST ONE
         PLW,R6   TSTACK
         B        *SR4
         FIN
         PAGE
*                                   ROUTINES TO READ 1,2,3 OR 4 BYTE
*                                   NUMBERS.
*                                   RESULTS IN R7.
         DO       MODE=0
2BNUM    PSW,SR4  *R0
2BNUM2   BAL,SR4  GBYTE
         LW,R7    R5
2BNUM1   BAL,SR4  GBYTE
         STB,R5   R7
         SCS,R7   8
         PLW,SR4  *R0
         B        *SR4
*                 READ A THREE BYTE NUMBER. RESULTS IN R7.
3BNUM    PSW,SR4  *R0
         BAL,SR4  2BNUM
         B        2BNUM1
*                 READ ONE OR TWO BYTES DEPENDING ON NUMBER OF DECL'S.
12BNUM   PSW,SR4  *R0
         LI,SR4   K7FFF
         AND,SR4  DECLSTK1
         CI,SR4   K100
         BG       2BNUM2
         LI,R7    K0
         B        2BNUM1
*
4BNUM    PSW,SR4  *R0
         BAL,SR4  3BNUM
         BAL,SR4  2BNUM1
         ELSE
4BNUM    STW,R3   BINRET            SAVE 3
         LW,R3    Y0400001C
NBNUM1   LW,R2    CURBYTE
         MBS,R2   1
*
*                                   BE CAREFUL, AS A SIGMA 5 USER MAY
*                                   GENMD OUT THE PREVIOUS INSTRUCTION
*                                   & CHANGE IT TO
*                                   B S5MBS21
*
S5MBSPOST EQU     %
         STW,R2   CURBYTE
         LW,R3    BINRET
         SW,R2    RCDSIZE
         BLEZ     *SR4
         STW,SR4  BINRET
         BAL,SR4  GBYTE             JUMP TO NEXT RECORD
         MTW,-1   CURBYTE
         LW,SR4   BINRET
NBNUM    STW,R3   BINRET
         LI,R3    8**2
         SW,R3    R2
         STB,R2   R3
         B        NBNUM1
Y0400001C DATA    X'400001C'
*
3BNUM    LI,R2    3
         B        %+2
2BNUM    LI,R2    2
         LI,R7    0
         B        NBNUM
*
12BNUM   STW,SR4  BINRET
         BAL,SR4  GBYTE
         LW,R7    R5
         LI,R5    K7FFF
         AND,R5   DECLSTK1
         AI,R5    -K100
         BLEZ     *BINRET
         BAL,SR4  GBYTE
         SLS,R7   8
         OR,R7    R5
         B        *BINRET
         FIN
*
*        SPECIAL ROUTINE TO HANDLE MBS,2 1 IN ABOVE ROUTINE
*        ( IT WAS ON TOP 10 OF MOST TIME-CONSUMING BS INSTR FOR
*                 SIGMA 5'S)
*        USERS MAY GENMD LDR TO POINT TO HERE INSTEAD OF
*        EXECUTING MBS,2 1
*
S5MBS21  EQU      %
         AI,R2    1                 * MBS SUBSTITUTE LOOP
         LB,R1    0,R2              *
         STB,R1   0,R3              *
         AI,R3    1                 *
         MTB,-1   R3                *
         BNEZ     S5MBS21           *
         B        S5MBSPOST         *
         PAGE
*                                   READBILI READS A RECORD FROM M:EF.
*                                   IF THE RECORD IS KEYED "HEAD" IS
*                                   USED AND THE HEADER IS RETURNED.
*                                   NORMAL RETURN IS +2, END OF FILE
*                                   IS +1. IF "NO-SUCH-KEY" IS
*                                   RETURNED AN ATTEMPT IS MADE TO
*                                   READ WITH THE LIBRARY LOAD MODULE
*                                   NAME IN FRONT OF HEAD.IF THIS
*                                   FAILS THE ROUTINE ABORTS.
READBILI EQU      %
         PSW,R6   *R0
         LW,R5    ROMKEY            GET KEY ADDRESS
         BEZ      CALEF             NONE
         LB,R6    *R5               KEYED ROM FROM LIBRARY
         MTB,1    *R5,R6            INCREMENT FOR READ
         BNC      CALEF
         AI,R6    -1
         MTB,1    *R5,R6
CALEF    LI,R4    BUF
         LI,R6    K78
         CAL1,1   READEF
READXIT  EQU      %
         AI,SR4   K1
EOF      PLW,R6   *R0
         B        *SR4
*
READBIL0 LI,R5    TXHEAD            FIRST TIME, TRY HEAD RECORD
         PSW,R6   *R0
         LI,SR1   LIBER
         CAL1,1   SETEF             SET ERR,ABN ADDRS
READBIL1 LI,R4    0                 CLEAR ROMKEY
         STW,R4   PBUF              CLEAR PBUF FOR NON LIB LMNS
         STW,R4   ROMKEY
         B        CALEF
LIBER    EQU      %
         LB,SR1   SR3               GET CODE
         CI,SR1   X'43'             NO KEY..
         BE       TRYLIB            TRY THE NEXT IN SEQUENCE
         CI,SR1   6                 EOF
         BE       EOF
         CI,SR1   X'42'             BAD KEY..
         BE       KEYEDROM          YEP: PROBABLY GOT A KEYED ROM HERE
         B        ER6X
         USECT    MCRT
KEYEDROM LI,R5    0
         CAL1,1   PFIL0             BACK TO BOF
         B        READBIL1
TRYLIB   EQU      %                 LET'S SEE IF WE GOT A LIBRARY
         CI,R5    TXHEAD            ONLY ONE TRY
         BNE      TRYLIB2           MEBBE ROMLIB
         LCI      3
         LM,R4    *CROM1,R2
         STM,R4   PBUF
         STM,R4   BUF2              BUILD 'XXXX'HEAD IN BUF2
         MTB,4    BUF2              SAVE ROMNAME IN PBUF FOR ADLDMD
         LB,R5    BUF2
         LI,R6    K4
         LB,SR1   TXHEAD,R6
         STB,SR1  BUF2,R5
         AI,R5    -1
         BDR,R6   %-3
         LI,R5    BUF2
         B        CALEF
TRYLIB2  RES                        TRY A ROM LIBRARY ROM
         MTW,0    ROMKEY            IF WERE READING THE THING
         BNEZ     EOF               WE MUST BE DONE
         CI,R5    BUF2
         BNE      KEYEDROM          ELSE MUST HAVE NO XXXXHEAD
         MTB,2    PBUF
         LB,R5    PBUF
         LI,SR1   0
         STB,SR1  PBUF,R5
         AI,R5    -1
         STB,SR1  PBUF,R5
         LI,R5    PBUF
         CAL1,1   READEF            R4 AND R6 ARE STILL O.K.
         STW,R5   ROMKEY            IF IT WORKED
         B        READXIT           HUNKY
         PAGE
*                                   THIS ROUTINE FOLLOWS A TREE
*                                   STRUCTURE. R4 IS THE CURRENT
*                                   SEGMENT AND R5 CONTAINS THE BASE
*                                   SEG. THE RETURNS USE +1 FOR A
*                                   SUBLINK, +2 FOR AN OVERLAY AND
*                                   +3 FOR NO MORE SEGMENTS.
GETSEG   LW,R6    *R4
         CW,R6    *R5
         BL       SEGMENT0
         AI,R6    SBLNKDIS
         LW,R7    *R1,R6
         LH,R7    R7
         BNEZ     CHGCSEG
GOVERLAY AI,SR4   K1
GOVERLY1 LW,R7    *R1,R6
         AND,R7   M16
         BNEZ     CHGCSEG
         AI,R6    KN1
         LW,R6    *R1,R6
         AND,R6   M16
         LW,R7    R6
         CW,R6    *R5
         BE       SEGMENT0
         BL       CHGCSEG
         AI,R6    SBLNKDIS
         B        GOVERLY1
SEGMENT0 CI,R6    K0
         BNE      BACKSEG
         AI,SR4   K1
         B        *SR4
BACKSEG  AI,R6    ROM1DIS
         LW,R7    *R1,R6
         AND,R7   M16
CHGCSEG  STW,R7   *R4
         B        *SR4
         PAGE
*                                   GENERAL ERROR ROUTINE FOR PRINTING
*                                   A MESSAGE, THE LAST E.F. NAME AND
*                                   THE LAST SEQUENCE #.
ER1      EQU      X'01'
ER2      EQU      X'02'
ER3      EQU      X'03'
ER4      EQU      X'04'
ER5      EQU      X'05'
ER6      EQU      X'06'
ER7      EQU      X'07'
ER8      EQU      X'08'
ER9      EQU      X'09'
ERA      EQU      X'0A'
ERB      EQU      X'0B'
ERC      EQU      X'0C'
ERD      EQU      X'0D'
ERE      EQU      X'0E'
ERF      EQU      X'0F'
ER10     EQU      X'10'
ER11     EQU      X'11'
ER12     EQU      X'12'
ER13     EQU      X'13'
ER14     EQU      X'14'
ER15     EQU      X'15'
ER16     EQU      X'16'
ER17     EQU      X'17'
ER18     EQU      X'18'
ER19     EQU      X'19'
ER1A     EQU      X'1A'
ER1B     EQU      X'1B'
ER1F     EQU      X'1F'
ER20     EQU      X'20'
ER21     EQU      X'21'
ER22     EQU      X'22'
ER23     EQU      X'23'
* ER22 NO ROOM TO READ LIBRARY REF/DEF STACK.
*ER23  NO ROOM TO UPDATE LIBRARY                                     WRT
ER32     EQU      X'32'
IOMSG    RES
         DO       MODE=1
         LI,SR4   X'0300'           FIRST ACCESS ERRMSG
         SCD,SR3  8                 FILE FOR APPROPRIATE
         SLS,SR3  -1                CODE FOR C(SR3)
         SCD,SR3  8
         STW,SR4  ERFLAG
         BAL,SR4  BLANKER
         BNE      ONLINEMSG         PUT SHORT FORM MESSAGES
         CAL1,2   PRINT
         LW,R7    ERFLAG
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+1
         LI,R5    X'4040'
         STH,R5   PBUF+1
         STW,D4   PBUF+2
         LI,R5    PBUF
         CAL1,1   RDMSG
         LW,R4    M:MSG+13          GET RWS.
         AI,R4    14                ADD MESSAGE PREFIX.
         STB,R4   PBUF              STORE COUNT.
         CAL1,2   PRINT
         FIN
MESSAGE  RES
         LW,R4    Y0302
         STW,R4   ERFLAG
         AWM,R3   ERFLAG
         BAL,SR4  BLANKER
         BNE      ONLINEMSG         PUT SHORT FORM IF TO TERMINAL
         CAL1,2   PRINT
         LW,R7    ERFLAG
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+1
         LI,R5    X'4040'
         STH,R5   PBUF+1
         STW,D4   PBUF+2
         LI,R5    PBUF
         CAL1,1   RDMSG
         LW,R4    M:MSG+13          GET RWS
         AI,R4    14                ADD MESSAGE PREFIX.
         STB,R4   PBUF              STORE COUNT.
         CAL1,2   PRINT             PRINT IT
*                                   ABORT CONDITION
         BAL,SR4  BLANKER
*                                   MOVE COL. HEADINGS TO PBUF & PRINT
         LCI      3
         LM,R6    TXEF
         STM,R6   PBUF+1
         LCI      2
         LM,R6    TXSEQ
         STM,R6   PBUF+5
         LW,R7    CODE
         BEZ      VARDATA
         LCI      3
         LM,R6    TXCODE
         STM,R6   PBUF+8
VARDATA  EQU      %
         CAL1,2   PRINT
         BAL,SR4  BLANKER
*                                   PRINT EF NAME, SEQNUM AND CODE
         LB,R7    OPENEF+8          CHAR CNT OF FILENAME
         LB,R6    OPENEF+8,R7       MOVE NAME TO PBUF
         STB,R6   PBUF+1,R7
         BDR,R7   %-2
         LW,R7    SEQNUM
         BNEZ     MESSAGE4
         LI,R2    X'F0'
         STB,R2   PBUF+6
         B        %+4
MESSAGE4 EQU      %
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+5
         STW,D4   PBUF+6
         LW,R7    CODE
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+9
         STW,D4   PBUF+10
ERROUT   EQU      %
         CAL1,2   PRINT
         LI,R5    1                 DO WE SNAP
         SCS,R5   0,3
         SLS,R3   -5
         CW,R5    ERFLGS,R3
         BAZ      NOSNAP            NO
SNAP     LW,R5    EXPRBAS           PAGE,REF/DEF & EXPR. STACKS.
         CW,R5    EXPRSTK
         BLE      %+3
         XW,R5    EXPRSTK           IF EXPR. STACK IS INVERTED,
         STW,R5   EXPRBAS           EXCHANGE LIMITS FOR SNAP.
         CAL1,3   SNAPFPT
NOSNAP   EQU      %
         LI,R5    M:LL
         CAL1,1   CLOSE
         LI,D4    -1                SET BAD FLAG FOR PASS3
*
         B        LEAVE
ERFLGS   DATA     X'FFA8E500'       ERRS 1F TO 0
         DATA     X'8350E'          ERRS 3F TO 20
ONLINEMSG RES
         CAL1,1   RDMSG             GET THE ERROR MESSAGE
         LW,R3    M:MSG+13          SIZE OF IT
         AI,R3    3                 SKIP THE THREE BLANKS
         CB,D2    *R5,R3
         BLE      %+2               CLEAR CONTROL CHAR IF THERE
         STB,D2   *R5,R3
         ANLZ,R3  %-1               GEN BYTE ADDRESS
         CI,R3    BA(PBUF+16)       IF MESSAGE  IS TOO LONG, MAKE 2  LINES
         BLE      %+4
         CAL1,2   PRINT
         BAL,SR4  BLANKER
         LI,R3    BA(PBUF+3)
         AI,R3    1                 SPACE TO INFO
         CW,R4    Y0302             IS THIS IO ERROR
         BE       ONMSG1            ..NO
         LI,R4    X'1FFFF'          FIND DCB NAME
         AND,R4   CODE
         LW,R2    DECLSTK+512
         CW,R4    2,R2
         BE       %+2
         BDR,R2   %-2
         BAL,SR3  MOVMSG
         LW,R2    R4
         AI,R2    23
         LI,R4    '-'
         STB,R4   0,R3
         BAL,SR3  MOVFIL
ONMSGX   AI,R3    -BA(PBUF+3)
         STB,R3   PBUF+3
         CAL1,2   PRINT
         B        NOSNAP
MOVFIL   LW,D4    USID              CHECK FOR SPECIAL FILENAMES
         OR,D4    Y03
         EOR,D4   0,R2
         CI,D4    X'FFF00'
         BANZ     %+3
         OR,D4    TXAST0
         LI,R2    D4
MOVMSG   SLS,R2   2
         AI,R3    1                 SKIP A SPACE
         LB,SR4   0,R2
         STB,SR4  R3
         MBS,R2   1
         B        *SR3
*
EFMSG    TEXTC    'EF'
TXAST0   TEXTC    '** '
SEQMSG   TEXTC    'SEQ'
CODMSG   TEXTC    'CODE'
ONMSG1   LI,R2    X'20'             CHECK THAT EF IS OPEN
         LI,R4    '='
         CH,R2    M:EF
         BAZ      NOEFMSG
         LI,R2    EFMSG
         BAL,SR3  MOVMSG
         STB,R4   0,R3
         LI,R2    M:EF+23
         BAL,SR3  MOVFIL
         LI,R2    SEQMSG
         LW,R7    SEQNUM
ONMSG3   BAL,SR3  MOVMSG
         BAL,SR4  BINTHEXT
         STB,R4   0,R3
         BAL,SR3  MOVMSG+1
         B        ONMSGX
*
NOEFMSG  LI,R2    CODMSG
         LW,R7    CODE
         BEZ      ONMSGX
         B        ONMSG3
BADERMSG EQU      %
         B        *SR1              IGNORE THE PROBLEM
TXEF     TEXT     'INPUT FILE'
TXSEQ    TEXT     'SEQ. NO.'
TXCODE   TEXT     'CODE/SIZE/SL'
SNAPFPT  DATA     SNAPFPT2
         DATA     DECLSTK
         DATA     LOADER
         TEXT     'DATAPAGE'
SNAPFPT2 DATA     %+X'20005'
         GEN,1,31 1,RFDFBAS
         GEN,1,31 1,RFDFSTK
         TEXT     'RFDF STK'
         DATA     %+X'20005'
         GEN,1,31 1,EXPRBAS
         GEN,1,31 1,EXPRSTK
         TEXT     'EXPR STK'
         DATA     %+X'20005'
         GEN,1,31 1,LOCCT
         GEN,1,31 1,DECLSTK
         TEXT     'TABLES  '
         DATA     X'20000'
         DATA     M:LL
         DATA     KBMSG+7
         TEXT     'LDR DCBS'
         NOP
         B        NOSNAP
         PAGE
*                                   THIS ROUTINE FILLS PBUF WITH BLANKS.
BLANKER  EQU      %
         LI,R5    -11
         LW,D2    TXBLNK
         STD,D2   PBUF+22,R5
         BIR,R5   %-1
         LI,R5    87
         STB,R5   PBUF
         LI,R5    PBUF
         DO       MODE=1
         LI,D1    X'FF00'
         AND,D1   M:LL+1
         CI,D1    X'9000'
         BNE      %+4
         LI,R5    75
         STB,R5   PBUF+3
         LI,R5    PBUF+3
         FIN
         CI,R5    PBUF
         B        *SR4
        PAGE
*                                   THIS ROUTINE TAKES A BINARY # IN R7
*                                   AND CONVERTS IT TO AN 8-DIGIT
*                                   EBCDIC DOUBLEWORD IN D3 & D4 WITH
*                                   LEAD ZEROS SUPPRESSED.
BINTHEXT OR,SR4   Y8                SET FLAG FOR TEXTC OUTPUT
BINTOHEX LI,R1    K8
         LI,R2    K0
BXLOOP   LI,R6    K0
         SLD,R6   4
         CI,R6    K0
         BE       ZSUP
         LW,R2    R6
FORMX    CI,R6    K9
         BLE      DIGIT
         AI,R6    TXA-KA
         B        STOIT
DIGIT    AI,R6    KF0
STOIT    STB,R6   D3
         SCD,D3   8
         BDR,R1   BXLOOP
         DO       MODE=1
         LC       SR4
         BCR,8    *SR4
         LI,D2    6
         LI,R2    D2*4+3
         LC       D3
         BCS,8    %+3
         SLD,D3   8
         BDR,D2   %-3
         AI,D2    2
         FIN
         B        *SR4
ZSUP      CI,R2    K0
         BNE      DIGIT
         DO       MODE=1
         LC       SR4
         BCR,8    %+3
         CI,R1    2
         BLE      DIGIT
         FIN
         LI,R6    K40
         B        STOIT
TXA      EQU      X'C1'
         DO       MODE=1
         PAGE
         DEF      BINSRT            BINARY SORT ROUTINE FOR REF/DEF STACK
         DEF      BINSRT1           ALTERNATE ENTRY TO BINSRT
*,*                                 WILL ADD ENTRY IF NOT FOUND
BINSRT   EQU      %
         OR,SR4   Y8                SET SEARCH ONLY FLAG
BINSRT1  STW,SR4  BINRET
         LB,R5    *D4
         SCS,R5   -10
         AW,R5    D4
         SLS,R5   2
         OR,R5    Y03000001
         LW,R2    RDSYMS            # OF SYMBOLS IN SORT TABLE
         BNEZ     %+2               THIS WILL USUALLY BE THE CASE
         B        ADDTOEND          ADD FIRST SYMBOL
         AI,R2    -1                POINT TO LAST ENTRY
         AW,R2    RDPTRS
         LW,R4    RDPTRS
SRCHLOOP EQU      %
         LW,R3    R2                BOTTOM...
         AW,R3    R4                ... + TOP ...
         SLS,R3   -1                ... DIVIDED BY 2 = MIDPOINT
         LW,R6    0,R3
         SLS,R6   2
         LW,R7    R5
         CBS,R6   1                 MAKE THE TEST
         BL       GTMIDDLE
         BG       LTMIDDLE
*
*                                   NOTE: SIGMA 5 USERS MAY GENMD OUT
*                                   THE PRECEEDING CBS AND REPLACE IT
*                                   WITH A BRANCH TO S5CBS1
*
S5CBSEQ  EQU      %                 * COME HERE IF EQUAL
         LW,R7    0,R3
         LB,R6    *D4
         CB,R6    *R7
         BE       FOUND
*
LTMIDDLE AI,R3    -1                MOVE TOWARDS CLOSER NAMES
         LW,R2    R3                SET NEW BOTTOM
         B        %+3               DO LOOP TEST
GTMIDDLE EQU      %
         LW,R4    R3                TOP GETS MIDPOINT
         AI,R4    1                 BUT KEEP MOVING
         CW,R4    R2
         BLE      SRCHLOOP          ...END, IN WHICH CASE...
         AI,R3    1                 ....
ADDAFT   SW,R3    RDPTRS            MAKE DISPLACEMENT TYPE POINTER
         LC       BINRET            CAN WE ADD IT
         BCS,8    BINX              NO
         AI,R3    0                 ARE WE ADDING BEFORE TOP ENTRY
         BEZ      ADDTOTOP          YES
         CW,R3    RDSYMS            ARE WE ADDING AFTER END OF TABLE
         BL       NOTATEND          NO
ADDTOEND LW,R3    RDSYMS            YES, DO IT
         STW,D4   *RDPTRS,R3
         B        BUMPSYMS
*
*        SPECIAL ROUTINE TO PROVIDE SIGMA 5 USERS WITH A WAY TO
*        AVOID A HOT SPOT IN THE LOADER.....REPLACES CBS,6 1
*        ABOVE...
S5CBS1   EQU      %
         AI,R6    1                 * STANDARD CBS REPLACEMENT LOOP
         LB,SR4   0,R6              *
         CB,SR4   0,R7              *
         BL       GTMIDDLE          *
         BG       LTMIDDLE          *
         AI,R7    1                 *
         MTB,-1   R7                *
         BNEZ     S5CBS1            *
         B        S5CBSEQ
*
FOUND    AI,R7    -3                ADDRESS OF FOUND ENTRY
         LCI      8                 SET FOUND CONDITION CODE
         B        *BINRET
*
NOTATEND EQU      %
         LW,R7    D4                COPY PTR TO NEW SYMBOL
         LW,R5    RDSYMS            # OF ENTRIES
         SLS,R5   -1                DIVIDED BY 2
         CW,R3    R5
         BG       MOVEDOWN          GOES IN PAST MIDDLE
         MTW,-1   RDPTRS            OTHERWISE MOVE OTHER ENTRIES..
         XW,R7    *RDPTRS,R3        ... UP TO MAKE ROOM FOR NEW GUY
         BDR,R3   %-1
         STW,R7   *RDPTRS
         B        BUMPSYMS
Y03000001 DATA    X'3000001'
MOVEDOWN EQU      %
         SW,R3    RDSYMS            HOW MANY SLOTS FROM BOTTOM
         LW,R5    RDPTRS            MAKE A POINTER...
         AW,R5    RDSYMS            ...TO BOTTOM OF STACK
         AW,R5    R3
         XW,R7    0,R5
         AI,R5    1
         BIR,R3   %-2
         STW,R7   0,R5
         B        BUMPSYMS
ADDTOTOP EQU      %
         MTW,-1   RDPTRS
         STW,D4   *RDPTRS
BUMPSYMS MTW,1    RDSYMS
BINX     LCI      0
         B        *BINRET
         FIN
         PAGE
SATREF   LI,R5    SATT
         CAL1,8   SEGLOAD
         B        SAT
ADLEFC   GEN,8,24 1,CALLP1          ENTRY WORD
ADLEF    LW,R5    ADLEFC
         STW,R5   LMNSW             SET SWITCH
ADLEF1   XW,SR4   LMNSW
         LB,R5    SR4
         AI,R5    SATT              SATT IF 0, PS1 IF 1
SEGBSR4  CAL1,8   SEGLOAD
         BAL,SR4  *SR4
         B        ADLEF1            RETURN
         PAGE
         DO       MODE=0
         REF      XMEMEOF           ERROR HANDLER FOR EOF ON XMEM
*,*                                 CORE IMAGE FILE (BPM ONLY)
         DEF      XMEMEOFX          ENTRY POINT VIA THE ROOT TO XMEMEOF
XMEMEOFX B        XMEMEOF
         FIN
XMEM3X   B        XMRDERR
*E*      ERROR:   0200-01
*E*      MESSAGE: UNEXPECTED EOF
*E*      DESCRIPTION: AN EOF WAS ENCOUNTERED BEFORE THE END OF A ROM.
*E*      REGISTERS: SR3 HAS THE SYSTEM I/O ERROR INFORMATION.
ER1X     QUIT     ER1,,SR3
*E*      ERROR:   0200-02
*E*      MESSAGE: ILLEGAL RECORD I.D.
*E*      DESCRIPTION: THE TYPE OF RECORD READ WAS NEITHER ROM NOR
*E*                   LOAD MODULE.
*E*      REGISTERS: R1 HAS RECORD I.D. (BYTE 0 OF RECORD READ)
ER2X     QUIT     ER2,,R1
*E*      ERROR:   0200-04
*E*      MESSAGE: ILLEGAL RECORD SIZE
*E*      DESCRIPTION: THE NUMBER OF BYTES IN A ROM RECORD WAS LESS
*E*                   THAN 5 OR GREATER THAN X'6C'.
*E*      REGISTERS: R1 HAS RECORD SIZE.
ER4X     QUIT     ER4,,R1
*E*      ERROR:   0200-06
*E*      MESSAGE: ABNORMAL I/O
*E*      DESCRIPTION: ABNORMAL RETURN FROM READING A ROM OR LIBRARY
*E*                   LOAD MODULE
*E*      REGISTERS: SR3 HAS THE SYSTEM I/O ERROR INFORMATION.
ER6X     QUIT     ER6,,SR3
*E*      ERROR:   0200-07
*E*      MESSAGE: CANNOT OPEN E.F.
*E*      DESCRIPTION: AN ELEMENT FILE COULD NOT BE OPENED.
*E*      REGISTERS: SR3 HAS THE SYSTEM I/O ERROR CODE.
ER7X     QUIT     ER7,,SR3
*E*      ERROR:   0200-10
*E*      MESSAGE: BAD I/O RETURN FROM M:LM DCB
*E*      DESCRIPTION: THE LOAD MODULE FILE COULD NOT BE OPENED.
*E*      REGISTERS: SR3 HAS THE SYSTEM I/O ERROR INFORMATION.
ER10X    QUIT     ER10,,SR3
*E*      ERROR:   0200-0A
*E*      MESSAGE: ILL. ROM LANGUAGE
*E*      DESCRIPTION: THE OBJECT LANGUAGE IN A ROM WAS NOT TRANSLATABLE
*E*                   (ASSEMBLER OR COMPILER ERROR).
*E*      REGISTERS: R1 HAS BAD OBJECT CONTROL BYTE.
ERAX     QUIT     ERA,,R1
         PAGE
*                                   THIS ROUTINE CHECKS THE VALIDITY
*                                   OF DECLARATION NUMBERS INVOLVED IN
*                                   EXPRESSIONS.
DECLCHK  EQU      %
         LW,R3    DECLSTK+1
         AND,R3   M15
         CW,R7    R3
         BLE      *SR4
*E*      ERROR:   0200-28
*E*      MESSAGE: INVALID DECLARATION NUMBER REFERENCE (BAD ROM)
*E*      DESCRIPTION: A ROM EXPRESSION REFERS TO AN UNASSIGNED DECLAR-
*E*                   ATION NAME NUMBER (ASSEMBLER OR COMPILER ERROR)
         QUIT     X'28',,R7
         USECT    STUFF
         ERROR,15,%-DECLSTK>512 'LOADER DATA PAGE IS OVERFULL'
PATCHD   DO1      DECLSTK+512-%
         DATA     0
         END      LOADER

