ASMB,Q,R,C
      HED RT4G4 - LOADER SEGMENT. 
      NAM RT4G4,5,90 92067-16319 REV.2001 790817
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
      SPC 1 
******************************************************************
* 
*   NAME:           RT4G4 
*   SOURCE PART #:  92067-18319 
*   REL PART #:     92067-16319 
*   WRITTEN BY:     KFH,  JH, GAA 
* 
******************************************************************
      SPC 1 
* 
*   ENTRY POINT NAMES 
* 
      ENT \NLOD 
* 
*   EXTERNAL REFERENCE NAMES
* 
      EXT \ILST,\LSTX,\LSTS,\TLST 
      EXT \LST1,\LST2,\LST3,\LST4,\LST5 
      EXT \INID,\IDX,\TIDN
      EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7
      EXT \IFIX,\FIX,\PFIX,\TFIX
      EXT \FIX1,\FIX2,\FIX3,\FIX4 
      EXT \LNKX,\LNK,\LNKS
      EXT \LNK1,\LNK2,\LNK3 
      EXT \FMRR,\CFIL 
      EXT \PREL 
* 
      EXT \CPLM,\ADBP 
      EXT \LBUF,\TBUF,\CURL,\CPL2 
      EXT \RNT,\PRV 
      EXT \CONV,\SPAC,\RBIN,\MESS,\GNER,\ABOR 
      EXT \ABDO,\SRET 
      EXT \SYS,\USER
      EXT READF,RWNDF,\NDCB,\RNAM 
      EXT \PTYP,\ADSK,\ABCO,\MXAB,\TIME,\MULR 
* 
A     EQU 0 
B     EQU 1 
      SUP 
************************************************************************
* 
      SKP 
*************************************************************************** 
* 
*                                                              770913 
* 
*    THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, 
*    AND IS REFERENCED BY, EACH SEGMENT.  IT IS NOT OVERLAID
*    AS EACH NEW SEGMENT IS LOADED INTO MEMORY. 
* 
*    THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL
*    SEGMENTS.  IF A CHANGE IS MADE, MAKE THE SAME CHANGES
*    IN THE REST OF THE SEGMENTS. 
* 
*************************************************************************** 
* 
* 
TB30  BSS 160       TRACK MAP TABLE/HEADER RECORD BUFFER
* 
ILIST BSS 64        USER SYSTEM PROG IDENT ADDR LIST
CURIL BSS 1         CURRENT ILIST ADDRESS 
* 
SYSCH BSS 1         SUBCHANNEL OF SYSTEM UNIT.
DCHNL BSS 1         CHANNEL OF SYSTEM DISK UNIT 
AUXCH BSS 1         SUBCHANNEL OF AUX UNIT. 
DSIZE BSS 1         DISK SIZE -NO. OF TRACKS. 
#SUBC BSS 1         # DISC SUBCHANNELS DEF'D (7905/7920)
DAUXN BSS 1         AUXILIARY DISK SIZE.
ADS#  BSS 1         AUX DISC SECTORS/TRACK. 
* 
*             RELOCATION BASE TABLE.
RBTA  BSS 1         ABSOLUTE PROGRAM BASE.
TPREL BSS 1         CURRENT PROGRAM BASE ADDRESS. 
TPBRE BSS 1         BASE PAGE RELOCATION ADDRESS. 
COMAD BSS 1         CURRENT COMMON RELOCATION BASE. 
      BSS 1         ABS PROGRAM BASE FOR MR CODE. 
* 
WDCNT BSS 1         TEMPORARY WORD COUNTER. 
DSKSY BSS 1         INITIAL ID SEGMENT DISK ADDRESS 
IDSP  BSS 1         POSITION OF 1ST ID SEG. IN SECT 
TTYCH BSS 1         SYSTEM TTY CHANNEL NO.
* 
PLFLG BSS 1         PROGRAM LOAD. FLAG = -1/0 = L/NL
DSCNT BSS 1         DISK SEGMENT SECTOR COUNT 
* 
NXFLG BSS 1         ENT/EXT FLAG = -1/0 
EXCNT BSS 1         SYMBOL COUNTER
* 
LCNT  BSS 1         CURRENT \LBUF COUNT 
DCNT  BSS 1         CURRENT DBUF COUNT
CURAI BSS 1         CURRENT IBUF COUNT
* 
CPLS  BSS 1         ADDRESS OF TOP OF FIXED CP LINK IMAGE 
CPL1  BSS 1         ADDRESS OF LOW CURRENT PAGE LINK SPECS. 
CPL1H BSS 1         NUMBER OF CURRENT PAGE LINKS ASSIGNED 
CPL2H BSS 1         IN LOW AND HIGH AREA RESPECTIVELY 
URBP1 BSS 1         LWA R/T DISC RES BP LINK AREA 
CURAK BSS 1         CURRENT KBUF ADDRESS
* 
CURAT BSS 1         CURRENT \TBUF ADDRESS 
TCNT  BSS 1         CURRENT \TBUF COUNT 
* 
CURAP BSS 1         CURRENT PLIST ADDRESS 
* 
AMAD  BSS 1         CURRENT MLIST ADDRESS 
* 
IXCNT BSS 1         ID EXTENSION COUNT
IDEXC BSS 1         CURRENT ID EXT'S USED 
IDEX  BSS 1         ADDRESS OF ID EXTENSION TABLE 
* 
LICNT BSS 1         LONG ID SEGMENT COUNT 
SSCNT BSS 1         BG. SEG ID COUNT
* 
DSKID BSS 1         DISK ID SEGMENT ADDRESS 
KEYCN BSS 1         TOTAL KEYWORD COUNT 
KEYCT BSS 1         CURRENT KEYWORD COUNT 
* 
MLIST BSS 11        MEMORY MAP BUFFER 
* 
TEMP1 BSS 1 
TEMP2 BSS 1 
LWH1  BSS 1 
LWH2  BSS 1 
LWH3  BSS 1 
LWH4  BSS 1 
L01   BSS 1 
* 
FSYBP BSS 1         FIRST WORD SYS BP LINKAGE 
SYSAD BSS 1         CURRENT ID SEGMENT ADDRESS
* 
TBREL BSS 1         CURRENT BP RELOC ADDR 
PBREL BSS 1         INITIAL BP RELOC ADDR 
* 
RELAD BSS 1         CURRENT CORE RELOCATION ADDRESS 
* 
BSBAD BSS 1         BG SEGMENT BP RELOC ADDR
BSPAD BSS 1         BG SEGMENT PROG RELOC ADDR
* 
LFLAG BSS 1         PROGRAMS-LOADED FLAG
IMAIN BSS 1         CURRENT MAIN IDENT INDEX. 
HDFLG BSS 1         HEADING FORMAT FLAG 
CIDNT BSS 1         CURRENT MAIN IDENT INDEX. 
* 
AEQT  BSS 1         ADDRESS OF EQUIPMENT TABLE
CEQT  BSS 1         NO. ENTRIES IN EQUIPMENT TABLE
SPLCO BSS 1         SPOOL EQT COUNT 
DVMAP BSS 1         ADDRESS OF DRIVER MAP TABLE 
* 
DPFLG BSS 1         DP RELOCATION FLAG, 0=YES, -1=NO
DPLN BSS 1          PAGE LENGTH OF DRIVER PARTITION 
DPADD BSS 1         START ADDR OF DRIVER PARTITION
DSKDP BSS 1         DISK ADDRESS OF DP #2 
PAGE# BSS 1         NEXT PHYSICAL PAGE TO ALLOCATE
DPNUM BSS 1         CURRENT DP# -1, OR TOT DP PAGES 
SDID  BSS 1         IDENT IDEX OF SYS DISK DRIVER 
LWDP1 BSS 1         LAST WORD OF DP, +1 
FWSDA BSS 1         FIRST WORD OF SDA 
* 
ASQT  BSS 1         ADDR OF DEVICE REFERENCE TABLE
CSQT  BSS 1         NO. ENTRIES IN DEV. REF. TABLE
* 
AINT  BSS 1         ADDRESS OF INTERRUPT TABLE
* 
DSKIN BSS 1         DISK ADDR OF INT CODE RECORD
INTCN BSS 1         RECORD COUNT OF INT CODE
* 
IDSAV BSS 1         INDEX OF CURRENT IDENT. 
DSKMN BSS 1         INITIAL MAIN DISK ADDRESS 
BSSDP BSS 1         INITIAL DISK RES MAIN BSS DISP
PRENT BSS 1         PRIMARY ENTRY POINT 
DBLAD BSS 1         CURRENT DBL ADDRESS 
REKEY BSS 1         INSTRUCTION TYPE BYTE 
INSCN BSS 1         INSTRUCTION TYPE COUNTER
INSTR BSS 1         CURRENT INSTRUCTION 
PAGNO BSS 1         CURRENT PAGE NO.
OPRND BSS 1         CURRENT OPERAND 
PLGTH BSS 1         PROGRAM LENGTH
* 
DRT2  BSS 1         DISK DRT ENTRY ( SYSTEM)
DRT3  BSS 1         AUX DISK DRT ENTRY
* 
LIBFG BSS 1 
LDTYP BSS 1 
* 
SCH1  BSS 1         INDEX OF IDENT OF PGM TO BE SCHEDULED 
SCH3  BSS 1         ADDRESS OF CURRENT ID SEGMENT 
SCH4  BSS 1         ADDRESS OF THE SCHEDULED PGM ID SEG 
FGBGC BSS 1         BACKGROUND USING FG COMMON FLAG 
$LIBR BSS 1         INDEX OF $LIBR ENT
$LIBX BSS 1         INDEX OF $LIBX ENT
CUPRI BSS 1 
* 
BLLO  BSS 1         -(LOWER BUFFER LIMIT) 
BLHI  BSS 1         -(UPPER BUFFER LIMIT) 
* 
MEM6  BSS 1 
MEM12 BSS 1 
* 
COMRT BSS 1         MAXIMUM RT COM LENGTH 
COMBG BSS 1         MAXIMUM BG COM LENGTH 
COMSZ BSS 1         #WORDS COMMON DECLARED IN CURRENT MAIN
RTCAD BSS 1         RT COMMON ADDRESS 
BGCAD BSS 1         BG COMMON ADDRESS 
FPCOM BSS 1         FIRST PAGE OCCUPIED BY COMMON 
LPCOM BSS 1         LAST PAGE CONTAINING ANY COMMON 
* 
FPSAM BSS 1         1ST PAGE CONTAINING S.A.M.
FWSAM BSS 1         1ST WORD CONTAINING S.A.M.
SYMAD BSS 1         VALUE FOR AVMEM IN SCOM 
SAM#1 BSS 1         SIZE OF FIRST CHUNK OF SAM
SAM#2 BSS 1         SIZE OF SECOND CHUNK OF SAM 
SAM2P BSS 1         START PAGE OF SAM #2
LWTAI BSS 1         LAST WORD OF TABLE AREA I FOR SAM#0 
FWPRV BSS 1         FIRST WORD FOR PRIVILEGED PROGRAMS
* 
FWSYS BSS 1         FIRST WORD OF SYSTEM CODE 
LPSYS BSS 1         LAST PAGE CONTAINING SYS
LWSYS BSS 1         LAST WORD OF SYSTEM 
LPSLB BSS 1         LAST PAGE OF SLOW BOOT
LWSLB BSS 1         LAST WORD OF SLOW BOOT
MTYPE BSS 1         MAIN PROGRAMS'S TYPE
* 
HIBP  BSS 1         BP LINK MODE FOR FIXUP ENTRIES
LOLNK BSS 1         LOW LINK FOR SSGA,LIB, OR SYS 
HILNK BSS 1         HI LINK USED BY MEM RES PRG 
BPINC BSS 1         BP LINK ALLOCATION MODE, -1=DOWN,1=UP 
BPLMT BSS 1         LAST AVAIL BP LINK IN CURRENT MODE, +1
* 
TPMAX BSS 1         HWM FOR RELOCATION OF BG MAINS & SEGS 
MAXPT BSS 1         NUM PARTS. ALLOWED
MAT.  BSS 1         ADDRESS OF MEMORY ALLOCATION TABLE
* 
SSGA. BSS 1         FWA SSGA
MAP.  BSS 1         PTR TO MEU RES MAP
MPFT. BSS 1         PTR TO MPFT 
* 
EMLNK BSS 1         EMA SYMBOL'S LINK 
EMLST BSS 1         LST INDEX OF EMA SYMBOL 
EMDSK BSS 1         DISK ADDR OF EMA PROGRAM
* 
*     MEMORY RESIDENT AREA POINTERS 
* 
MRACM BSS 1         MR ACCESS COMMON FLAG (>0 IF YES) 
LBCAD BSS 1         FIRST WORD OF MEMORY RES LIBRARY
LEND  BSS 1         LAST  WORD OF MEMORY RES LIBRARY
FWMRP BSS 1         FIRST WORD OF MEMORY RES PROGRAM AREA 
EMRP  BSS 1         LAST  WORD OF MEMORY RES PROGRAM AREA 
FPMRP BSS 1         FIRST PAGE OF MEMORY RES PROGRAM AREA 
FPMBP BSS 1         PAGE # FOR MEMORY RES BASE PAGE 
MRP#  BSS 1         # PAGES OCCUPIED BY MRL & MRP'S 
DSKMB BSS 1         DISK ADDRESS OF MEMORY RES BASE PAGE
DSKMR BSS 1         DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA 
DSKBP BSS 1         SYSTEM DISK ADDRESS 
* 
DSKAV BSS 1         NEXT AVAILABLE DISK ADDRESS 
DSKLC BSS 1         DISK ADDRESS OF LIBRARY CODE
DSKLB BSS 1         DISK ADDR OF LIBRARY ENTRY PTS
DSKUT BSS 1         UTILITY PROG DISK ADDRESS 
DSKBS BSS 1         DISK ADDR OF MAIN BG DISK RES BP
DSKBR BSS 1         CURRENT MAIN BG DISK RES DISK AD
ADICT BSS 1         ADDR OF DISK DICTIONARY 
LBCNT BSS 1         RESIDENT LIBR ENTRY PT COUNT
SYCNT BSS 1         SYSTEM ENTRY POINT COUNT
KEYAD BSS 1         CURRENT KEYWORD ADDRESS 
* 
SYBAD BSS 1         ADDR OF FIRST BP LINK FOR BG
IDSAD BSS 1         ADDR OF FIRST ID SEGMENT
ABSID BSS 1         IDENT ADDR FOR NEXT BG SEG SCAN 
IDMBS BSS 1         BG MAIN ADDRESS FOR BS REF
* 
SYTRK BSS 1         DISK ADDRESS WHERE SYSTEM BEGINS - TRACK
SYSEC BSS 1         DISK ADDRESS WHERE SYSTEM BEGINS - SECTOR 
* 
SSGAF BSS 1         SSGA ACCESS FLAG
SPAR2 BSS 1         SPARE VARIABLE
SPAR3 BSS 1         SPARE VARIABLE
SPAR4 BSS 1         SPARE VARIABLE
SPAR5 BSS 1         SPARE VARIABLE
* 
********************************************************* 
*                                                       * 
*  END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS.        * 
*                                                       * 
********************************************************* 
* 
      SPC 2 
MRTAD DEF TPREL 
RBTAD DEF RBTA
AMLST DEF MLIST 
AMEM5 DEF MLIST+5 
AMEM8 DEF MLIST+8 
      SKP 
* 
*                                   PROGRAM CONSTANT FACTORS
N1    DEC -1
N3    DEC -3
N5    DEC -5
N8    DEC -8
N11   DEC -11 
NDAY  OCT 177574,025000 
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
P5    DEC 5 
P6    DEC 6 
P7    DEC 7 
P11   DEC 11
P12   DEC 12
P13   DEC 13
P14   DEC 14
P15   DEC 15
P16   DEC 16
P34   DEC 34
P60   DEC 60
P99   DEC 99
P100  DEC 100 
P6K   DEC 6000
M7    EQU P7
M17   EQU P15 
M20   EQU P16 
M1760 OCT 176000
M1777 OCT 1777
M7400 OCT 177400
M7777 OCT 77777 
* 
BLANK OCT 040       BLANK 
MSIGN OCT 100000    NEGATIVE SIGN 
      SKP 
LODR  NOP 
* 
*     NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS 
* 
      LDA N         GET LOOP COUNTER
      STA TEMP1     SAVE IN TEMP LOCATION 
      LDB LSTAA     GET ADDRESS OF WHERE LIST ROUTINE LOCATED 
LOOP  LDA B,I       HERE WE CHASE DOWN OUR OWN
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      STA B,I       AND SAVE IT AGAIN 
      INB 
      ISZ TEMP1     DONE? 
      JMP LOOP      NO
      JMP \SRET     RETURN TO MAIN FOR CALL 
*                                    TO \NLOD OR \LOAD. 
* 
      SPC 1 
N     DEC -4
LSTAA DEF *+1 
ATBUF DEF \TBUF+0 
LBUF5 DEF \LBUF+5 
ALBUF DEF \LBUF+0 
DNDCB DEF \NDCB+0 
      SKP 
      SKP 
* 
*                                   INITIATE MAIN PROGRAM LOADING 
* 
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = IGNORED
*    JSB LOAD     (FROM ANOTHER SEGMENT)
* 
*  RETURN: CONTENTS OF A AND B ARE DESTOYED.
* 
\NLOD NOP 
      LDA \PTYP     GET RELOCATION TYPE 
      CPA P5        IF A SEGMENT
      RSS 
      JMP NONES 
      JSB \LOAD     THEN JUST CALL \LOAD AND RETURN 
      JMP \NLOD,I 
* 
*     INDICATE VALIDITY OF SSGA REFERENCES
* 
NONES LDA \ID6,I     TYPE 
      AND M20       LOOK AT SSGA BIT
      STA SSGAF  SET SSGA FLAG (0=NO SSGA USE)
      CCB 
      STB HDFLG     SET HEADING FLAG
      LDB \PREL     PICK UP BASE ADDRESS
      LDA LIBFG     IF LIB LOAD 
      SZA 
      JMP NOADD     THEN IGNORE 
      LDA \ID6,I     GET TYPE AGAIN 
      AND M7        JUST PRIMARY BITS 
      CPA P1        IF MEMORY RESIDENT
      ADB P2        BUMP START ADDR FOR INDEX REG SAVE
      CPA P2        AND IF PROG IS DISK RESIDENT
      ADB P34       BUMP START FOR VIS + INDEX REG SAVE 
      CPA P3        (EITHER RT OR BG) 
      ADB P34       BUMP START FOR VIS + INDEX REG SAVE 
      CPA P4
      ADB P34       BUMP START FOR VIS + INDEX REG SAVE 
* 
NOADD STB TPREL 
      LDA PBREL     GET BP RELOCATION ADDRESS 
      STA TBREL     SET CURRENT BP RELOC ADDRESS
      JSB \LOAD     LOAD PROGRAM
      LDA LIBFG     IF NOT LIB LOAD 
      SZA,RSS       THEN
      JSB \SPAC     NEW LINE
      JMP \NLOD,I   RETURN
      SKP 
* 
*                                   LOAD, LINK MAIN PROG & SUBS.
* 
*  \LOAD IS THE MAIN LOADING SUBROUTINE FOR GENERATING THE ABSOLUTE 
*  CODE AND LINKING ALL CALLED SUBROUTINES.  IT IS USED BY EACH 
*  PROGRAM TYPE FOR LOADING.  IT READS THE RELOCATABLE RECORDS FROM 
*  THE DESIGNATED FILE, AND WRITES THE ABSOLUTE CODE
*  INTO THE CORE-IMAGE OUTPUT FILE. 
* 
*  CALLING SEQUENCE:
*    A = IGNORED
*    B = IGNORED
*    JSB LOADS    (FROM ANOTHER SEGMENT)
* 
*  RETURN: CONTENTS OF A AND B ARE DESTOYED.
* 
\LOAD NOP           (WAS "LOADS") 
      JSB SFIX      SET UP A FIX UP ENTRY 
      CCA 
      STA PLFLG     SET FLAG = NO DBL RECS IN 
* 
LOADN LDA TPREL     CLEAR THE CP LINK IMAGE 
      JSB CCPLK     AREA
      LDA TPREL     SAVE FOR RESET
      STA LWH4       FOR NEXT PASS
      LDA TBREL 
      STA LWH3
      CLA 
LOADX STA L01 
* 
      LDA LWH3       BP LINK
      LDB TBREL       ADDRESSES 
      JSB CLRLT 
      LDA LWH3
      STA TBREL     RESTORE TBREL 
      JSB CLIST     BLANK MEMORY MAP BUFFER 
      CLA           CLEAR THE LIBRARY TRAP
      STA ADTRP     WORDS 
      STA LIBTP 
      LDA AMLST     AMLST = ADDR OF MEM MAP BUFFER
      STA AMAD      SET CURRENT MEMORY MAP ADDRESS
      LDA HDFLG     GET HEADING FORMAT FLAG 
      STA TEMP2 
      SSA,RSS       SKIP IF NEGATIVE (MAIN) 
      ISZ AMAD      INCR CURRENT MEM MAP ADDR 
      LDA \ID1,I     GET NAME 1,2 
      STA AMAD,I    SET NAME 1,2 IN MEMORY MAP
      ISZ AMAD      INCR CURRENT MEMORY MAP ADDRESS 
      LDA \ID2,I     GET NAME 3 4 
      STA AMAD,I    SET NAME 3,4 IN MEMORY MAP
      ISZ AMAD      INCR CURRENT MEMORY MAP ADDRESS 
      LDA \ID3,I    GET NAME 5
      AND M7400     ISOLATE UPPER CHAR
      IOR BLANK     ADD BLANK (OCT 40)
      STA AMAD,I    SET NAME 5 IN MEMORY MAP
      LDA \ID6,I     PICK UP TYPE 
      AND M177      AND ISOLATE 
      CPA P13       IF TABLE AREA II TYPE 
      RSS 
      CPA P15       OR TABLE AREA I TYPE
      RSS           THEN DON'T MASK BITS
      AND M7        MASK TO ACTUAL TYPE.
      STA LDTYP 
* 
*                                   READ NAM RECORD.
* 
      LDA ALBUF     READ NAM RECORD FROM FILE.
      STA \CURL 
      CCB 
      JSB \RNAM 
      JSB \ABOR     ERROR ON READ.
      SZA,RSS 
      JSB \ABOR     END OF FILE.
      CMA,INA       SET COUNT WORD. 
      STA LCNT
* 
      LDA \ID5,I     CHECK IF NAM RECORD HAS
      RAL            A MODIFIED VERSION.
      SSA,RSS 
      JMP LOADC     NO. 
* 
      JSB RWNDF     YES. SEARCH NEW NAM FILE
      DEF *+3        FOR REPLACEMENT RECORD.
      DEF \NDCB+0 
      DEF \FMRR+0 
* 
      LDA DNDCB     GET DCB ADDRESS IN CASE OF ERROR
      JSB \CFIL 
      JSB \ABOR 
* 
CREAD JSB READF 
      DEF *+6 
      DEF \NDCB+0 
      DEF \FMRR+0 
      DEF \LBUF 
      DEF P60 
      DEF LEN 
* 
      LDA DNDCB     GET DCB ADDRESS IN CASE OF ERROR
      JSB \CFIL 
      JSB \ABOR 
* 
      LDA LEN       BETTER BE THERE!
      CPA N1
      JSB \ABOR 
* 
      LDB ALBUF     COMPARE NAM IN \LBUF
      ADB P3
      LDA B,I        AGAINST
      CPA \ID1,I       NAM IN IDENT.
      INB,RSS 
      JMP CREAD     NO MATCH. 
      LDA B,I 
      CPA \ID2,I
      INB,RSS 
      JMP CREAD     NO MATCH. 
      LDA B,I 
      XOR \ID3,I
      AND M7400 
      SZA 
      JMP CREAD     NO MATCH. 
* 
LOADC JSB ZLOAD     LOADING?
      JMP LH7        NO 
* 
      LDA L01 
      SZA           1ST PASS? 
      JMP LH7        YES
* 
      ISZ TEMP2      NO - TEST TEMPORARY HDFLG
      JMP SUBHD 
* 
      JMP LH8 
* 
LPAR  OCT 50        LEFT PAREN. 
* 
LH7   ISZ HDFLG     TEST REAL THING 
      JMP SUBHD     SKIP PRIORITY OUTPUT FOR SUB
* 
LH8   LDA \ID6,I     SET CURRENT LOAD TYPE
      AND M17       LOOK AT PRIMARY & REVERSE COMMON BITS 
      CPA P5        DON'T CHANGE COMMON 
      JMP COMOK      FOR SEGMENTS (USE MAIN'S)
      LDB \ID4,I     THIS IS A MAIN 
      RBL,CLE,ERB    GET RID OF M,S BIT 
      STB COMSZ     SET HIS COM SIZE AS LIMIT.
      LDB BGCAD     GET BACKGROUND COMMON BOUND 
      CPA P1        IF FORGROUND
      RSS 
      CPA P2
      RSS 
      CPA P11       OR PRIVILEGED USING FORGROUND COMMON
      RSS 
      CPA P12       OR BACKGROUND USING FOREGROUND COMMON 
      LDB RTCAD     USE FORGROUND COMMON ADDRESS
      STB COMAD     SET THE COMMON BASE ADDRESS 
COMOK LDA \ADSK     GET CURRENT DISK ADDRESS
      LDB L01 
      SZB,RSS       IF 1ST PASS,
      STA DSKMN     SAVE INITIAL MAIN DISK ADDRESS
      LDA \PTYP     IF FOURCED SUBROUTINE 
      AND M17        OR SSGA ROUTINE
      CPA P14         LOAD
      JMP SUBHD        SEND SUB HEAD MAP
* 
      LDA LPAR      GET LEFT PAREN (OCT 50) 
      IOR AMAD,I    CHANGE NAME 5, BLANK TO NAME 5,(
      STA AMAD,I    SET NAME 5, LEFT PAREN IN MAP 
      LDA \LBUF+10   GET PRIORITY FROM THE NAM RECORD 
      SZA,RSS       IF ZERO SET 
      LDA P99       TO 99 
      SZB,RSS       UNLESS SYSTEM WHICH 
      CLA           SET TO ZERO 
      STA CUPRI     SET FOR THE ID-SEG GENERATION 
      CMA,INA       SET TO NEGATIVE FOR DECIMAL CONV
      LDB ATBUF     GET MESSAGE ADDRESS 
      JSB \CONV     CONVERT TO DECIMAL/OCTAL
      LDA \TBUF+1    GET HIGH TWO CHARACTERS
      STA MLIST+3   SET IN MAP
      LDA \TBUF+2    GET 2 LEAST SIGNIFICANT DIGITS 
      STA MLIST+4   SET PRIORITY IN MEMORY MAP
      LDA \LBUF+12   SET UP THE TIME PARAMETERS 
      ASL 4         FIRST THE RESOLUTION
      LDB \LBUF+11   AND MULTIPLE 
      BLS 
      ASR 4         COMBINE 
      STA \MULR      SET FOR ID SEG GENERATOR 
      LDA \LBUF+15   GET THE SECONDS
      MPY P100      CONVERT TO 10'S OF MS.
      ADA \LBUF+16   ADD 10'S OF MS.
      STA TEMP1     SAVE TEMP 
* 
      LDA \LBUF+13   GET THE HOURS
      MPY P60       CONVERT TO MIN. 
      ADA \LBUF+14   ADD MIN. 
      MPY P6K       CONVERT TO 10'MS
      CLE           PREPARE FOR ADD 
      ADA TEMP1     ADD 10'S MS.
      SEZ,CLE       IF OVERFLOW 
      INB           STEP HIGH ORDER PART
      ADA NDAY+1    SUBTRACT ONE DAY OF 10'S MS.
      SEZ,CLE       IF OVER FLOW
      INB           STEP HIGH ORDER DIGIT 
      ADB NDAY
      DST \TIME      SAVE DOUBLE WORD \TIME FOR ID-SEG. 
* 
SUBHD LDA TPREL     GET CURRENT PROG RELOC ADDR 
      LDB AMEM5     SET B = ADDR OF MEMORY MAP + 5
      JSB \CONV     CONVERT TO DECIMAL/OCTAL
      LDA MLIST     PUT A ")" IN THE
      CPA BLNKS     HIGH PART OF THE
      JMP SUBH2     ADDRESS IF NOT A SUBHEAD
* 
      LDA MLIST+5   I.E. IF MAIN
      ADA B4400     CONVERT BLANK TO )
      STA MLIST+5   RESTORE IT. 
SUBH2 LDA \LBUF+1    GET RIC
      ALF,RAR       ROTATE TO LOW A 
      AND M7        ISOLATE RIC 
      CPA P1        NAM RECORD? 
      RSS           YES - CONTINUE
      JSB \ABOR     INVALID DISK RECORD 
      LDA \LBUF+6    GET PROGRAM LENGTH 
      STA PLGTH     SAVE PROGRAM LENGTH 
      RAL,CLE,ERA   REMOVE POSSIBLE SIGN BIT
      ADA TPREL     COMPUTE THE LAST WORD ADDRESS 
      ADA N1
      LDB AMEM8     AND 
      JSB \CONV     CONVERT TO THE MAP
* 
*         SET RELOCATION BASE FOR ORB STUFF 
      SPC 1 
      JSB ZLOAD     IGNORE IF A PSEUDO-LOAD OF AN MRP 
      CLB,RSS 
      LDB \LBUF+7    GET SIZE OF BASE PAGE CODE 
      LDA BPINC      AND FIGURE OUT IF WE'RE GOING
      SSA             UP OR DOWN IN BASE
      JMP SUBH3        PAGE.
      SPC 1 
      LDA TBREL     GOING UP, SET 
      STA TPBRE      ORB BASE AT TBREL
      ADB TBREL     INCREMENT LINK BASE 
      LDA BPLMT     SUBTRACT LIMIT
      CMA,INA        FROM 
      ADA B           NEXT ADDR TO CHECK FOR
      JMP SUBH4        BASE PAGE OVERFLOW.
      SPC 1 
SUBH3 CMB,INB       GOING DOWN...SUBTRACT ORB LENGTH
      ADB TBREL      FROM LINK BASE 
      INB             ADD ONE 
      STB TPBRE        TO GET ORB BASE. 
      ADB N1        GET NEXT AVAILABLE LINK ADDR. 
      LDA B 
      CMA,INA       SUBTRACT NEW BASE FROM LIMIT
      ADA BPLMT      TO CHECK FOR OVERFLOW. 
      SPC 1 
SUBH4 SSA,RSS       IF LIMIT IS EXCEEDED, WE
      JMP E16RR      HAVE AN ERROR. 
* 
CONLD STB TBREL     BASE PAGE 
      LDA TPBRE 
      JSB SETBP     SET PROGRAM BASE PAGE IMAGE TO -1 
      LDA \LBUF      GET RECORD SIZE
      ALF,ALF       LOW ORDER A 
      STA \LBUF      SAVE IN RIGHT HALF 
      JSB ZLOAD     LOADING?
      JMP NOLD      NO, SKIP
* 
      LDA L01       FIRST PASS? 
      SZA,RSS       NO, DO MAP
      JMP NOMP      YES, NO MAP 
* 
      ISZ LFLAG     BUMP THE LOADED FLAG
      NOP           IN CASE OF LEAP 
      LDA \ID5,I     CHECK FOR "MAP MODULES". 
      RAR 
      SLA,RSS 
      JMP NOMP      NO. BIT 1 NOT SET.
* 
      LDB LBUF5     THE SIXTH WORD IN \LBUF 
      LDA N11       NUMBER OF WORDS 
      STA TCNT      TO MOVE TO \LBUF
      LDA AMLST     ADDRESS OF NAME BUFFER
      STA WDCNT     SAVE FOR POINTER
LH1   LDA WDCNT,I   GET NAME WORD, AND ADDRESS
      STA B,I       STORE IN \LBUF
      INB           BUMP B
      ISZ WDCNT     BUMP NAME ADDRESS 
      ISZ TCNT      ALL DONE? 
      JMP LH1       NO, DO MORE 
* 
      LDA BLNKS     GET TWO BLANKS
      STA B,I       PUT THEM IN \LBUF BEFORE THE COMMENTS 
      LDA \LBUF      GET RECORD SIZE
      ADA N5        REDUCE TO MAP LENGTH
      ALS           TIMES 2 FOR CHARACTER COUNT 
      LDB LBUF5     ADDRESS OF MAP AND COMMENTS 
      JSB \MESS     PRINT ALL 
* 
*     THE FOLLOWING ROUTINES LINK A PROGRAM THROUGH CURRENT PAGE
*     LINKS WHEN POSSIBLE.  THIS IS POSSIBLE WHEN THE LENGTH
*     OF THE PROGRAM IS KNOWN AND WHEN THE PROGRAM IS NOT AN
*     ASSEMBLED TYPE 2, 3, 4, OR 5 PROGRAM. 
* 
NOMP  LDA \ID4,I     COMPARE
      AND M7777 
      CMA,INA        THIS MODULE'S COMMON 
      ADA COMSZ       DECLARATION TO MAIN'S 
      SSA,RSS          ERROR IF GREATER.
      JMP NOM2
      LDA ERR54 
      CMA,INA 
      JSB \GNER 
NOM2  LDA L01       1ST OF 2 PASSES?
      SSA 
      JMP NOLD       NO - 1 PASS ONLY 
* 
      SZA,RSS       IF PASS ONE 
      JMP LH12      GO CHECK FOR OPTION 
      SPC 1 
      LDA CPL1      PASS TWO SO SET UP THE NOW
      STA \CPL2      KILL THE UPPER AREA
      JSB \LNKS      SET FOR DEFINING CODE
      JMP LH10      GO SET THE BOUNDRYS 
      SPC 1 
LH12  JSB GETCP     SET UP A CURRENT PAGE LINK AREA 
      STA CPL1      USE FOR BOTH
      CLA           AREAS 
      STA CPL1H     CLEAR THE COUNT WORDS 
      STA CPL2H 
      LDB \ID5,I     DOES OPERATOR WANT CURRENT PAGE
      SSB            LINKS IF POSSIBLE?  IF YES - 
      JMP LH222     GO SET UP 
* 
LH2   CCA 
      JMP LOADX     RESTART 
      SPC 1 
LH222 LDA PLGTH 
      SSA,RSS       NO CURRENT PAGE LINKS 
      LDA LDTYP      IF ASSEMBLED TYPE 2, 3,4, OR 5 
      CPA P2
      JMP LH2 
      CPA P3
      JMP LH2 
      CPA P4
      JMP LH2 
      CPA P5
      JMP LH2 
* 
      LDA TPREL     GET ADDR
      STA B          OF LAST WD 
      IOR M1777      OF PAGE
      SPC 1 
      CMB,INB       COMPUTE # WDS 
      INB            REMAINING
      ADB A          ON PAGE
      STB TEMP2 
      SPC 1 
      LDA PLGTH     COMPUTE # WDS 
      RAL,CLE,ERA    OF PROGRAM 
      CMB,INB        THAT FALL
      ADB A          BEYOND THIS
      STB TEMP1      PAGE 
      SPC 1 
      SSB           PROGRAM FIT ON
      RSS            THIS PAGE? 
      SZB,RSS       NO - SKIP 
      JMP NOLOW     YES GO SET UP THE HIGH AREA 
      SPC 1 
      LDA TEMP2     COMPUTE MINIMUM OF: 
      ARS            HALF # WDS OF PROG 
      CMB,INB         ON CURRENT PAGE-OR- 
      ADB A          # WDS OF PROG ON 
      SSB,RSS         NEXT PAGE 
      SPC 1 
      LDA TEMP1     DIVIDE THIS 
                        