ASMB,R,L,C
*     NAME:   LOAD2 
*     SOURCE: 92070-18110 
*     RELOC:  92070-16110 
*     PGMR:   D.J.W.,B.W. 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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.       *
*  ***************************************************************
* 
* 
      NAM LOAD2,5,99  92070-1X110  REV.1941  800325 
* 
* 
*  THIS SEGMENT SERVES TO PROVIDE ROUTINES FOR FILE RELOCATION, 
*  SEARCH, SYSTEM LIBRARY SCAN, PRINTING UNDEFINED EXTERNALS, 
*  RELOCATION INITIALIZATION, AND COMPLETION OF RELOCATION. 
* 
* 
*  CHANGE 3/8/80
*  LOAD2 WAS CHANGED AT E.RRR PROCESSING TO JUMP DIRECTLY TO
*  AB.RT IN THE MAIN INSTEAD OF RETURNING TO THE CALLER OF
*  PRCSS WITH AN ERROR.  THIS HANDLES THE CASE WHERE ALLOC
*  WAS CALLED DURING THE SEARCH OF SYSTEM ENTRIES AND A BASE
*  PAGE OVERFLOW RESULTED.  BEFORE E.RRR ATTEMPTED TO RETURN
*  TO THE CALLER OF PRCSS WHEN PRCSS HAD NOT BEEN CALLED. 
* 
* 
* 
*  CHANGE 2/25/80 
*  CHANGED END PROCESSING IN PRCSS ROUTINE SO AS TO CLEAR THE 
*  VALID NAME READ FLAG, NM2.L, IF THE LATEST MODULE WAS LOADED 
*  OR NOT.  
* 
* 
* 
      ENT BHIGH,E.RRR,  END,LOAD2,PRENT, PUDF 
      ENT RE.LC,OFFBP,SE.MS,SHIGH,SYSCN,TABLE 
      ENT PRCSS 
      ENT &MNAM,&MLEN,&MODE,&NMOD 
* 
      EXT QUERY 
      EXT .DFER, .MVW,#LIBS,#SENT,#SGMT,#SLIB 
      EXT AB.RT,ABOUT,ALLOC,APOSN,BNAMR,BPFWA 
      EXT CBP.L, CFWA, CKSM,CNUMO,COMAD,COMLN 
      EXT COMTP,CUREC,  DB1, DB1X,DBFLG,DEBUG 
      EXT DRKEY,FDONE,FMPER,FOPEN,FORCD,FWAVB 
      EXT FWAFS,FWSYB,I.ERR,ID.CB,IFBRK,IGN.L 
      EXT INAMR,L.BUF,L.CLS,L.IFX,L.INT,L.LDF 
      EXT L.LUN,L.MAT,L.REL,L.SG0,L.SGN,L.SYE 
      EXT LBS.L,LDRER,LNAMR, LOCF,LWAFS,MSEGF,NAMF
      EXT NM1.L,NM2.L,NM4.L,NOFBP,NOFSB,NOR.L 
      EXT  ODCB,ONAMR, OPEN,OTDFT,OUTAB,OUTBP 
      EXT OUTBF,P.ROR,PGFWA 
      EXT PGLWA,PGT.L,PL.ST,POSNT,PRI.L,PRMAP 
      EXT PROGN,READF,RTNS2,RWNDF, SCAN, SDCB 
      EXT SEG.L,SGB.L,SNAMR,SPACE, SYBP,SYOUT 
      EXT SUMAP,TH1.L,TH2.L,TSY.L,WRITF 
      EXT ALC.B 
* 
A     EQU 0 
B     EQU 1 
* 
SGNAM BSS 60        SEGMENT NAM BUFFER
.BUF  EQU * 
      HED INITIALIZATION FOR LOADER LIBRARY 
**********************************************************************
* 
*  NOTE: THIS CODE IS OVERLAYED WITH THE BUFFER 'SGNAM'.
* 
**********************************************************************
* 
* 
      ORG SGNAM 
LOAD2 LDA CBP.L     SET THIS ASIDE IN CASE OF INITIAL BUMP
      STA TEMP1 
      JSB L.INT     INITIALIZE RELOCATION SUBROUTINES 
      DEF *+9 
      DEF FWAFS     STARTING ADDRESS OF FREE AREA 
      DEF LWAFS     ENDING ADDRESS FREE AREA
      DEF BPFWA     ACTUAL FWA BASE PAGE
      DEF COMAD     SYSTEM COMMON ADDRESS, OR ZERO
      DEF COMLN     LENGTH OF COMMON
      DEF TH2.L     PROGRAM RELOCATION BASE 
      DEF PGLWA     LWA PROGRAM AREA
      DEF TABLE     TABLE OF LIB SUBROUTINES
* 
      LDA DBFLG     HAS USER SPECIFIED DEBUG ?
      SZA,RSS 
      JMP NODBG     NO
      JSB L.SYE     YES, ENTER ".DBUG" INTO SYMBOL TABLE
      DEF *+6 
      DEF .DBUG     SYMBOL NAME 
      DEF P2        SET AS UNDEFINED
      DEF P0        VALUE = ZERO
      DEF P2        DO NOT OVERRIDE 
      DEF RESLT     RESULT RETURNED 
* 
NODBG LDA BPFWA     SET UP SOME BASE PAGE POINTERS AND
      CMA,INA       OFFSETS IN DUMMY BASE PAGE
      ADA FWAVB 
      STA OFFBP     OFFSET INTO DUMMY BASE PAGE 
      CMA,INA 
      STA NOFBP     -VE OFFSET
      LDA FWSYB 
      CMA,INA 
      ADA SYBP
      STA NOFSB     OFFSET INTO SYSTEM BASE PAGE
* 
      LDA TEMP1     GO OUTPUT ANY INITIAL BASE PAGE BUMP
      SZA             IF THERE IS ONE THAT IS 
      JSB ALC.B      AND USE ALC.B TO ALLOCATE AND ZERO 
* 
      LDA CKSM      STUFF SYSTEM CHECKSUM WORD
      STA SYCKM     INTO LONG ID SEGMENT
      LDA COMAD     SYSTEM COMMON REFERENCED ?
      CLB 
      SZA           WELL ?? 
      LDB B11       YES, SET STATUS WORD IN ID SEGMENT
      STB STATS     TO 'SYSTEM COMMON'
* 
      LDA PGFWA     SAVE PROGRAM FIRST WORD 
      STA LOMAN     AS LOW MAIN IN THE LONG ID
      LDA BPFWA     SAVE LOW BASE PAGE ADDRESS
      STA LOBSE     AS LOW BASE IN LONG ID
      JMP RTNS2     RETURN TO THE MAIN
* 
TEMP1 BSS 1         TEMP FOR CBP.L
B11   OCT 4000
.DBUG ASC 3,.DBUG   USER DBUGR SYMBOL ENTRY NAME
* 
*  TABLE OF SUBROUTINES CALLABLE BY THE LOADER LIBRARY
* 
TABLE DEF ALLOC+0   ALLOCATE A BASE PAGE LINK 
      DEF SCAN+0    SCAN FOR A MATCHING BASE PAGE LINK
      DEF OUTAB+0   OUTPUT AN ABSOLUTE WORD TO THE DISC 
      BSS .BUF-*
*CHECK EQU *-.BUF   CHECK FOR PROPER OVERLAY
**********************************************************************
* 
*  END OF OVERLAY AREA
* 
**********************************************************************
      HED RELOCATION FLOW OF CONTROL
* 
* 
*  THIS SUBROUTINE CONTROLS THE RELOCATION PROCESSING OF A FILE.
*  IT IS ASSUMED THE FILE IS OPENED AND POSITIONED TO THE FIRST 
*  MODULE TO BE RELOCATED.
* 
*  CALLING SEQUENCE:  JSB  RE.LC
* 
*  ON RETURN:         P+1:  ABORT,  A-REG < 0 = FMP ERROR CODE
*                     P+2:  GOOD LOAD 
* 
* 
RE.LC NOP 
      CLE           SET 'NEW LOAD' FLAG 
      CLA           SET 'NO RESCAN' FLAG
      STA RFLAG 
* 
CONTU CLB           SET 'NOT A LIBRARY SCAN'
      STB LBS.L 
      INB 
      STB SCSEG     SET 'RETURN ON SEGMENT NAM' 
      JSB PRCSS     GO PROCESS THE FILE 
      JMP ERFM?     ERROR RETURN
      SSA,RSS       SEGMENT NAM READ ?
      JMP SEGMT     YES, GO RESCAN AND SEARCH SYSTEM LIBS 
      ISZ NOR.L     NO SEGMENT, WAS A SUBROUTINE LOADED ? 
      JSB RESCN     YES, RESCAN THE FILE  FIRST 
      ISZ RE.LC     NO SUBROUTINE LOADED, END OF FILE READ
      JMP RE.LC,I   RETURN TO CALLER
* 
*  SEGMENT NAM FOUND IN THE FILE
* 
SEGMT LDA #SGMT      HAVE WE READ TOO MANY SEGMENTS ? 
      CMA,INA 
      ADA SEG#       COMPARE TO THE MAXIMUM ALLOWED.
      SSA,RSS 
      JMP ER.RR      YES, GO OUTPUT ERROR MESSAGE 
* 
      ISZ FDONE     SET FLAG FOR 'MAIN LOADED'
      JSB RESCN     RESCAN THE FILE FIRST 
      ISZ RFLAG     NEXT TIME WE RESCAN 
      CLA           SCAN USER AND SYSTEM LIBRARIES
      JSB SYSCN     CHECK FOR UNDEFS IN CURRENT MAIN OR SEGMENT 
      JMP RE.LC,I   ERROR RETURN, MESSAGE HAS BEEN PRINTED
      STA TEMP
      JSB SUMAP     PRINT UPPER BOUNDS ON MAIN OR SEG 
      LDA TEMP
      LDB SEG.L     GET THE STATUS WORD 
      CPB P2        CURRENT MODULE MAIN OR SEGMENT ?
      SZA,RSS       SEGMENT, DOES IT HAVE UNDEFS ?
      JMP CONT      ITS A MAIN OR SEGMENT WITH NO UNDEFS
      LDA FORCD     IS THIS A FORCE LOAD ?
      SSA 
      JMP CONTX     YES, FORCE LOAD 
      CLA,INA       PRINT THE UNDEFS
      JSB PUDF
      LDA P7        AND LOADER ERROR 'UN EXT' 
OUTMS JSB LDRER 
      JMP RE.LC,I   AND FLUSH THE LOAD
* 
ER.RR LDA P6        OUTPUT LOADER ERROR 'NO SEG'
      JMP OUTMS 
* 
*  CONTINUE WITH THE LOAD 
* 
CONTX CLA           PRINT THE CURRENT UNDEFS
      JSB PUDF
      JSB L.IFX     FIX-UP ALL UNDEFINED EXTERNALS
      DEF *+1 
CONT  JSB END       FINISH PROCESSING CURRENT MAIN OR SEGMENT 
      JMP RE.LC,I   ERROR RETURN
* 
      ISZ SEG#
      JSB FOPEN 
      DEF *+5 
      DEF INAMR     NAMR ADDRESS
      DEF ID.CB     DCB ADDRESS 
      DEF IOPTN 
      DEF P272
      JMP RE.LC,I   ERROR RETURN ON OPEN
* 
      LDA INAMR+3   WAS THIS AN LU ?
      ERA,SLA 
      CCE,RSS 
      JMP CONTU     YES, SO NO REPOSITION 
* 
      JSB APOSN     REPOSITION TO SAVED LOCATION
      DEF *+6 
      DEF ID.CB     DCB ADDRESS 
      DEF I.ERR     ERROR PARM
      DEF IREC      RECORD NUMBER 
      DEF IRB       BLOCK NUMBER
      DEF IOFF      OFFSET
* 
      CCE,SSA       FMP ERROR ? 
      JMP ERFMP     YES, OUTPUT MESSAGE AND ABORT 
      JMP CONTU     CONTINUE WITH THE SEGMENT LOAD
* 
* 
NOSEG DEC 6 
RFLAG BSS 1         'RESCAN' FLAG 
P7    DEC 7 
P272  DEC 272 
* 
ERFM? SSA,RSS       IS THERE AND FMP ERROR ?
      JMP RE.LC,I   NO, JUST ABORT
ERFMP JSB FMPER     YES, OUTPUT ERROR MESSAGE 
      DEF INAMR+0   ON RELOCATABLE NAMR 
      JMP RE.LC,I   AND ABORT 
* 
*  RESCAN CURRENT FILE IN AN ATTEMPT TO SATISFY UNDEFS
* 
RESCN NOP 
      LDA INAMR+3   IS THIS A FILE OR LU ?
      ERA,SLA       ITS GOT TO BE ONE OF THE TWO
      RSS           FILE
      JMP RESCN,I   LU, SORRY, NO RESCAN !! 
* 
* 
      JSB LOCF      DETERMINE  CURRENT FILE LOCATION
      DEF *+6 
      DEF ID.CB+0    FILE DCB ADDRESS 
      DEF I.ERR+0    ERROR PARM 
      DEF IREC      NEXT RECORD NUMBER
      DEF IRB       RELATIVE BLOCK OF NEXT READ 
      DEF IOFF      BLOCK OFFSET OF NEXT RECORD 
* 
      SSA           FMP ERROR RETURNED ?
      JMP ERFMP     YES 
* 
      LDA SEG#      IS THIS THE FIRST SEGMENT ? 
      SZA,RSS 
      JMP R.SCN      YES, THEN RESCAN THE FILE
* 
      LDA RFLAG     DO WE REALLY WANT TO RESCAN ? 
      SZA,RSS 
      JMP RESCN,I    NO, RETURN TO CALLER 
* 
R.SCN JSB RWNDF     REWIND FILE 
      DEF *+3 
      DEF ID.CB+0    FILE DCB ADDRESS 
      DEF I.ERR+0    ERROR PARM 
* 
      SSA           ERROR RETURNED ?
      JMP ERFMP     YES 
* 
      JSB SE.MS     SCAN FILE FOR UNDEFS
      JMP RE.LC,I   ERROR RETURN
      JMP RESCN,I   RETURN TO CALLER
* 
* 
* 
IREC  NOP 
IRB   NOP 
IOFF  NOP 
TEMP  BSS 1 
P5    OCT 5 
      HED             PRINT UNDEFINED EXTERNALS 
* 
* 
*  PUDF OUTPUTS A LIST OF UNDEFINED EXTERNALS TO THE LIST DEVICE
*  OR COMMAND DEVICE USING SUBROUTINE 'SYOUT'.
* 
*  CALLING SEQUENCE:  JSB PUDF
*                     A-REG = 0/1, SEGMENT / MAIN AND SEGMENT 
* 
*  ON RETURN:         REGISTERS DESTROYED 
* 
* 
PUDF  NOP 
      STA MNSEG     SAVE MAIN-SEGMENT FLAG
      CLA           SET PNTR FLAG TO START OF EXTS
      STA PONTR 
      CMA           INITIALIZE 'FIRST TIME THROUGH' FLAG
      STA FIRST 
      JSB SPACE     AND SPACE UP A BLANK LINE 
* 
NXUDF JSB L.LUN     RETRIEVE UNDEFINED EXTERNAL 
      DEF *+4 
      DEF ADRS      ADDRESS OF SYMBOL NAME ARRAY
      DEF PONTR     ADDRESS POINTER TO BE CARRIED 
      DEF MNSEG     MAIN-SEGMENT FLAG 
* 
      ISZ FIRST     FIRST TIME THROUGH LOOP ? 
      JMP UNDFS     NO, PRINT UNDEF 
      SZB,RSS       YES, DO UNDEFS EXIST ?
      JMP NODEF     NO, PRINT "NO UNDEFS" 
      LDA P14       YES, UNDEFS  EXIST
      LDB MESS3     PRINT HEADER MESSAGE FOR UNDEFS LIST
      JSB SYOUT     LET SYOUT DECIDE WHERE MESSAGE GOES 
      LDB ADRS      RESTORE THE ENTRY ADDRESS 
* 
*  UNDEFINED EXTERNALS EXIST
* 
UNDFS SZB,RSS       UNDEFS REMAIN ? 
      JMP PUDF,I    NO, RETURN TO CALLER
      LDA P5        YES, GET LENGTH OF MESSAGE IN CHARS 
      JSB SYOUT     OUTPUT TO LIST DEVICE 
      JMP NXUDF     GET NEXT UNDEF
* 
*  NO UNDEFS THIS TIME
* 
NODEF LDA P12       NO UNDEFS, GET MESSAGE LENGTH 
      LDB NMESS     AND ADDRESS 
      JSB SYOUT     OUTPUT TO LIST DEVICE 
      JMP PUDF,I    RETURN TO CALLER
* 
FIRST BSS 1         'FIRST TIME THROUGH' FLAG 
MNSEG BSS 1         0/1, SEGMENT/ MAIN AND SEGMENT
PONTR BSS 1         POINTER FOR L.LUN 
ADRS  BSS 1         ADDRESS OF SYMBOL TABLE ENTRY 
P12   DEC 12
P14   DEC 14
NMESS DEF *+1 
      ASC 6,  NO UNDEFS 
MESS3 DEF *+1 
      ASC 7,UNDEFINED EXTS
      HED RELOCATION PROCESS CONTROL
* 
*  PRCSS CONTROLS CALLS TO THE LOADER LIBRARY RELOCATION
*  ROUTINES   L.REL  AND  L.CLS.   THE FLAGS ARE SET, 
*  THE RECORD READ, CLASSIFIED, AND RELOCATED.  ALSO SOME 
*  PRE-PROCESSING AND POST-PROCESSING IS DONE ON THE
*  NAM AND END RECORDS RESPECTIVELY.
* 
*  CALLING SEQUENCE:  JSB PRCSS 
*                     E-REG = 0/1,  NEW LOAD/ CONTINUE SEGMENT LOAD 
* 
*  ON RETURN:         P+1:  ERROR CONDITION, ABORT LOAD 
*                     P+2:  GOOD LOAD,
*                     A-REG = 0/-1, SEGMENT READ, EOF 
* 
* 
IL    DEC 60         LENGTH OF L.BUF
LEN   NOP            LENGTH READ ON READF CALL
SUBTP EQU LEN       SUBTYPE PARM (EQU LEN FOR SPACE ONLY) 
RIC   NOP            RECORD INDICATOR WORD
&MODE DEC 1         DEFAULT TO SYMBOL SEARCH MODE (ALL MODULES) 
&MNAM BSS 3         3 WORD MODULE NAM BUFFER TEMPORAREY 
&MLEN BSS 1         LENGTH OF MODULE NAME IN WORDS
&NMOD DEC 0         0/1, N/1 MODULES TO SEARCH AND RELOCATE 
IGNN  BSS 1         0/<>0, PRC/IGNORE RECORDS UNTIL NAM HIT 
* 
PRCSS NOP 
      CLA 
      STA IGNN      LOOK AT ALL RECORDS INITIALLY 
      CCB           SET FLAGS FOR LOADER LIBRARY
      STB NOR.L     NO SUBROUTINES LOADED IN THE SCAN 
      STB NM1.L     NAM RECORD MUST BE FIRST
      SEZ           NEW LOAD, CONTINUE SEG LOAD ? 
      JMP CONTL     CONTINUE SEGMENT LOAD 
* 
      LDA FDONE     HAS THE NAM BEEN READ ? 
      SZA,RSS 
      JMP PRC02     YES, CLASSIFY THE RECORD
PRC00 JSB READF     READ RELOCATABLE RECORD 
      DEF *+6 
      DEF ID.CB+0    DCB ADDRESS
      DEF I.ERR+0      ERROR PARM 
      DEF L.BUF+0   DESTINATION BUFFER
      DEF IL        BUFFER LENGTH 
      DEF LEN       LENGTH READ 
      SSA           FMP ERROR ? 
      JMP PRCSS,I   RETURN TO CALLER
      LDA LEN       ZERO LENGTH RECORD READ ? 
      SZA,RSS 
      JMP PRC00     YES, ISSUE READ AGAIN 
      SSA           EOF ? 
      JMP EOF       YES, RETURN TO CALLER 
* 
PRC02 JSB L.CLS     NO, CLASSIFY RECORD TYPE
      DEF *+3 
      DEF RIC       RECORD TYPE WORD
      DEF SUBTP     SUBTYPE PARMETER
      SSA           ERROR RETURN ?
      JMP E.RRR     YES, OUTPUT MESSAGE AND ABORT 
      CPA P7        IF INDEX RECORD SET IGNORE RECORDS UNTIL
      RSS           NAM RECORD READ 
      JMP NTIDX 
      LDB SUBTP 
      CPB P9
      STA IGNN      IS INDEX SET IGNN <>0 
NTIDX LDB IGNN      TEST FOR IGNORE IF NOT NAM
      SZB,RSS 
      JMP OKPRC     PROCESSING ALL RECORDS
      CPA P1        IGNORE IF NOT NAM 
      RSS 
      JMP PRC00     IGNORE THIS NON NAM RECORD
      CLB           CLEAR FLAG TO RESUME SCANNING 
      STB IGNN      ALL RECORD TYPES
* 
* NOTE THIS NAM CODE MUST BE CHANGED FOR XNAM RECORDS 
* 
OKPRC CPA P1        NAM RECORD ?
      JSB PRCNM 
      CPA P6        EMA RECORD ?
      JMP EMA       EMA ACCESS IS ILLEGAL FOR RTE-L 
      JSB L.REL     RELOCATE THE RECORD 
      DEF *+2 
      DEF I.ERR+0      ERROR PARM 
      SZA           ERROR RETURN ?
      JMP E.RRR     YES, REPORT AND ABORT 
      LDB RIC       NO, CHECK RECORD TYPE 
      CPB P5        END RECORD ?
      JSB PRCED     YES, POST END PROCESSING
      JMP PRC00     NO, CONTINUE RELOCATION 
* 
EOF   CLB           EOF READ
      STB SCSEG     SET RETURN ON SEGMENT NAM FLAG
RTN   ISZ PRCSS     TAKE GOOD RETURN, P+2 
      JMP PRCSS,I 
      HED FATAL ERROR PROCESSING
E.RRR STA TEMP      LOADER ERROR, SAVE ERROR NUMBER 
      CPA P1        BASE PAGE OVERFLOW ?
      JMP MODNM     YES 
      SSA,RSS       ERROR +VE ? 
      JMP REPRT     YES, JUST REPORT THE ERROR
      CPA N4        IS THIS OV FIX ?? 
      JMP REPRT     YES, GO REPORT THE ERROR
      ADA P9        ERRORS -1 TO -9 GET MODULE NAME ALSO
      SSA           LESS THAN -9 ?
      JMP REPRT     YES, JUST GO REPORT 
* 
MODNM LDB NM2.L     ADDRESS OF MODULE NAME
      LDA B,I       CHECK THAT A VALID NAME PRESENT 
      SZA,RSS 
      JMP REPRT     NO, SKIP MODULE NAME OUTPUT 
      INB           YES, VALID NAME 
      LDA P5        GET LENGTH IN CHARS 
      JSB SYOUT     AND OUTPUT
      LDA TEMP      CHECK FOR DUPLICATE ENTRY ERROR 
      CPA N7        IS THIS IT ?
      JMP ENTNM     YES, PRINT ENTRY POINT NAME ALSO
* 
REPRT LDA TEMP      REPORT THE ERROR TO THE LIST DEVICE 
PRINT JSB LDRER     OUTPUT ERROR MESSAGE
      JMP AB.RT     GO ABORT !!!!!!!!!!!
* 
N4    DEC -4
N7    DEC -7
P9    DEC 9 
N2    DEC -2
* 
ENTNM LDB TSY.L     OUTPUT THE CURRENT SYMBOL TABLE ENTRY 
      ADB N5        BACK UP TO PROPER SYMBOL ENTRY
      LDA B,I       GET THE FIRST WORD OF THE SYMBOL ENTRY
      RAL,CLE,ERA   SHIFT OUT ANY SIGN BIT
      STA B,I       AND REPLACE (CAUSE WE'RE GOING TO ABORT)
      LDA P5        GET LENGTH
      JSB SYOUT     AND OUTPUT
      JMP REPRT     NOW GO REPORT THE ORIGIONAL ERROR 
* 
EMA   LDA N11       GOT AN EMA RECORD 
      JMP PRINT     NO EMA ALLOWED AT ALL !!! 
* 
N5    DEC -5
N11   DEC -11 
      HED RELOCATION PROCESS CONTROL
* 
P1    DEC 1 
* 
*  POST PROCESSING ON END RECORD
* 
PRCED NOP 
      JSB CKBRK     CHECK FOR BREAK FLAG SET
      LDB IGN.L     WAS THIS MODULE LOADED ?
      SZB 
      JMP EN.CK     NO, SO GET OUT OF HERE
* 
      LDA PRI.L     PRIMARY ENTRY POINT ? 
      SZA,RSS 
      JMP NOPRE     NO
* 
* PROCESS ID SEGMENT VALUES 
* 
      JSB BLDID 
      JMP NOPRE     THIS WAS A SUBROUTINE 
      JMP PRE       THIS WAS A SEGMENT, GO SET SOME FLAGS 
      JSB RENAM     THIS WAS THE MAIN, SAVE THE NAME AND RENAME 
      JMP NOPRE     EVERYTHING OK, SKIP SETTING SEGMENT FLAGS 
      JMP PRCSS,I   GOT AN ERROR ON THE RENAME  GO ABORT
* 
PRE   CLB,INB       SET 'RETURN ON SEGMENT NAM' FLAG
      STB SCSEG 
      CLA,INA       AND 'LIBRARY SCAN IN PROGRESS' FLAG 
      STA LBS.L 
NOPRE JSB PRMAP     PRINT MEMORY MAP
      JSB DEBUG     CHECK FOR DBUGR ACCESS
* 
*BW CODE ADDED TO ALLOW 1 MODULE TO BE LOADED ONLY
* 
EN.CK CLA           CLEAR THE VALID NAME FLAG IN THE LOADER LIB 
      STA NM2.L,I   THAT IS SET THE WORD COUNT TO ZERO
      LDA &NMOD     SEE IF MORE MODULES REQUIRED
      SZA,RSS 
      JMP PRCED,I   YES, RETURN TO CALLER 
      CLA 
      STA &NMOD     RESET FLAG TO ALLOW DEFAULTING
      CMA           NO, SET A -1 FOR EOF RETURN FAKE
      JMP RTN 
* 
ASGNM DEF SGNAM+0 
* 
* 
CONTL LDA ASGNM     CONTINUE THE LOAD 
      LDB ALBUF     MOVE SEGMENT NAM BUFFER BACK INTO L.BUF 
      JSB .MVW
      DEF P60 
      NOP 
      CLA           CLEAR 'RETURN ON SEGMENT NAM' FLAG
      STA SCSEG 
      JMP PRC02     GO PROCESS
* 
PRCNM NOP           PRE-PROCESSING ON NAM RECORDS 
      LDB SCSEG     ARE WE SCANNING TILL SEGMENT ?
      SZB,RSS 
      JMP PRCNM,I   NO, NO PROCESSING NECESSARY THEN
      LDB L.BUF+9   YES, WELL HAVE WE GOT A SEGMENT ??
      CPB P5        THE CLUE IS PROGRAM TYPE = 5
      RSS           WE GOT ONE !! 
      JMP PRCNM,I   NOPE
      LDA ALBUF     SAVE THE SEGMENT NAM RECORD 
      LDB ASGNM     IN A SPECIAL BUFFER 
      JSB .MVW
      DEF P60 
      NOP 
      CLA           TELL CALLER WE GOT A SEGMENT
      JMP RTN       TAKE GOOD RETURN
* 
* 
ALBUF DEF L.BUF+0 
      ENT SCSEG     QUERY SETS THIS FLAG SAME AS EOF IN PRCSS 
SCSEG NOP           0/1, ARE NOT/ ARE CURRENTLY SCANNING TILL 
*                                    NEXT SEGMENT FOUND 
P60   DEC  60 
      HED SEARCH RELOCATABLE FILE 
* 
* 
*  SE.MS CONTROLS THE SINGLE OR MULTIPLE SCAN OF A RELOCATABLE
*  FILE.  SE.MS ASSUMES THE FILE IS POSITIONED TO THE FIRST 
*  MODULE TO BE SCANNED.
* 
* 
*  CALLING SEQUENCE:  JSB SE.MS 
*                     A-REG >= 0, MULTIPLE SCAN DESIRED,
*                           <  0, SINGLE SCAN ONLY. 
* 
*  ON RETURN:   P+1:  FMP ERROR, A-REG = ERROR NUMBER 
*               P+2:  NO ERROR
* 
* 
SE.MS NOP 
      STA MULT      SAVE MULTIPLE SCAN FLAG 
      CCA           SET 'CURRENTLY SCANNING LIBRARY' FLAG 
      STA LBS.L     FOR THE LOADER LIBRARY
      CLA,INA 
      STA FDONE     SET MAIN NOT LOADED FLAG
SER00 CLA,CLE 
      STA SCSEG     SET 'DON'T RETURN ON SEGMENT NAM' FLAG
      JSB QUERY     GO PROCESS THE FILE(MAY BE INDEXED) 
      JMP SE.MS,I   ERROR RETURNED FROM PRCSS 
* 
      LDA MULT      NO ERROR, SO WE'VE HIT EOF
      SSA           YES, SCAN MULTIPLE TIMES ?
      JMP SERC0     SINGLE SCAN ONLY
      ISZ NOR.L     MULTIPLE SCAN, ANYTHING LOADED ?
      JMP RWND      YES, GO REWIND AND RESCAN 
* 
SERC0 ISZ SE.MS     TAKE GOOD RETURN
      JMP SE.MS,I 
* 
RWND  JSB RWNDF     BEGIN RESCAN WITH FILE REWIND 
      DEF *+3 
      DEF ID.CB 
      DEF I.ERR+0 
* 
      CPA N3        IS THIS A REWINDABLE DEVICE ? 
      JMP SERC0     YES, NO RESCAN
      SSA,RSS       FMP ERROR RETURNED ?
      JMP SER00     NO, PROCESS THE FILE
* 
      JMP SE.MS,I   PRINT MESSAGE AND ABORT 
* 
MULT  NOP           >= 0 , RESCAN MULTIPLE TIMES
*                                     <  0 , SCAN ONCE
N3    DEC -3
      HED         SYSTEM LIBRARY SCAN 
* 
* 
*  THIS ROUTINE PERFORMS  A SCAN OF THE SNAPSHOT FILE AND ALL 
*  NAMED SYSTEM LIBRARY FILES IN AN ATTEMPT TO SATISFY UNDEFS.
*  FIRST THE USER LIBRARY FILES ARE SCANNED, THESE ARE THE FILES
*  NAMED DURING THE LOAD PROCESS AS LIBRARIES.  NEXT, IF THIS IS
*  THE FIRST SYSTEM LIBRARY SCAN THE MEMORY RESIDENT LIBRARY, 
*  ABSOLUTE, AND RPL ENTRIES ARE READ FROM THE SNAP AND PUT INTO
*  THE SYMBOL TABLE.  THEN THE SYSTEM LIBRARIES ARE SCANNED.
*  FINALLY THE SNAPSHOT IS READ TO SATISFY ANY REFERENCES FROM
*  LOADED SYSTEM LIBRARY SUBROUTINES.  IF UNDEFINED EXTERNALS 
*  STILL REMAIN AND SOME MODULE WAS LOADED FROM THE SYSTEM
*  LIBRARIES, THEN THESE LIBRARIES AND SCANNED AGAIN, AND THE 
*  SNAPSHOT SCANNED.
* 
*  CALLING SEQUENCE:  JSB SYSCN 
*                     A-REG = MAIN/SEGMENT FLAG 
* 
*  ON RETURN:         A-REG >= 0, NO UNDEFS REMAINING 
*                           <  0, UNDEFS STILL REMAIN 
* 
* 
SYSCN NOP 
      STA MNSG?     SAVE MAIN-SEG FLAG
      LDA PRENT,I   CAN'T BE SCANNING SYSTEM LIBS IF NO 
      SZA,RSS       PRIMARY ENTRY POINT DEFINED 
      JMP LOERR     YES, 'TR ADD' ERROR 
* 
      JSB UNDF?     ARE THERE ANY UNDEFS ?
      JMP RNDEX     NO, SO GET OUT OF HERE !
* 
      CCA           SET FLAGS FOR 
      STA LBS.L     LIBRARY SCAN IN PROGRESS
      CLA           DON'T RETURN ON A SEGMENT NAM 
      STA SCSEG 
* 
      LDA PL.ST     ARE WE LISTING ?
      SZA 
      JSB SPACE     YES, SPACE UP CAUSE WE GOT UNDEFS 
* 
* 
      JSB URLIB     SCAN USER LIBRARIES FIRST 
      JSB SETUP     CHECK FOR FIRST SYSLIB SCAN 
RSCN  JSB LBLOK     SEARCH SYSTEM LIBRARIES 
      JSB SYLOK     NOW SCAN THROUGH SYSTEM ENTRIES 
* 
* 
* 
      JSB UNDF?     FINALLY, UNDEFS EXIST ? 
      JMP RNDEX     NO UNDEFS, RETURN TO CALLER 
      LDA SLOAD     UNDEFS STILL EXIST
      SZA,RSS       ANYTHING LOADED FROM SYSTEM LIBRARIES ? 
      JMP RSCN      YES, SO RESCAN THE SYSTEM LIBS AND SNAP 
      RSS 
RNDEX CLA 
      ISZ SYSCN     NO ERROR ON SCAN
      JMP SYSCN,I   RETURN TO CALLER
* 
LOERR LDA P2        ILLEGAL SNAPSHOT ERROR
ERROR JSB LDRER     SIGNAL USER 
      JMP SYSCN,I   AND ABORT 
* 
P2    DEC 2 
      SKP 
* 
* 
UNDF? NOP 
      CLA           INITIALIZE SEARCH TO START OF SYMBOL TABLE
      STA PNTR? 
      JSB L.LUN     UNDEFS EXIST IN SYMBOL TABLE ?
      DEF *+4 
      DEF ADDR?     ADDRESS OF SYMBOL 
      DEF PNTR? 
      DEF MNSG?     SCAN CURRENT MODULE 
* 
      SZB           UNDEFS ?
      ISZ UNDF?     YES 
      JMP UNDF?,I   NO
* 
ADDR? NOP 
PNTR? NOP 
MNSG? NOP 
      SKP 
* 
*  SET UP FOR THE FIRST SYSTEM LIBRARY SCAN.  PUT ALL 
*  RESIDENT LIBRARY ENTRIES INTO THE USER SYMBOL TABLE. 
*  IF SYSTEM COMMON HAS BEEN REFERENCED, THEN PUT ALL 
*  LABELLED COMMON ENTRIES IN ALSO. 
* 
SETUP NOP 
      ISZ FRSCN     IS THIS THE FIRST SYSLIB SCAN ? 
      JMP SETUP,I   NO, RETURN TO CALLER
* 
      LDA #SLIB     GET NUMBER RESIDENT LIB ENTRIES 
      ALF,ALF       ISOLATE IT
      AND RHALF 
      CMA,INA       NEGATE AND
      STA COUNT     SAVE AS A COUNT 
      LDA #SENT     GET TOTAL COUNT ALSO
      CMA,INA 
      STA #SYMB     SAVE AS -VE 
      CLA 
      STA NM2.L,I   CLEAR VALID NAME FLAG 
      JSB POSNT     POSITION TO FIRST ENTRY 
      DEF *+5 
      DEF SDCB      SNAP DCB
      DEF I.ERR     ERROR PARM
      DEF P2        RECORD 2
      DEF P2        TREAT ABOVE AS A RECORD NUMBER
      SSA           FMP ERROR ? 
      JMP SNFMP     YES, GO REPORT
* 
NXENT JSB READ      READ AN ENTRY OFF THE SNAP
      LDA SNAME+1   SET SIGN BIT AS ALREADY LISTED
      IOR B15 
      STA SNAME+1 
      LDA SNAME+4   GET SYMBOL TYPE WORD
      LDB COUNT     GET THE CURRENT COUNT 
      SSB,RSS       ARE WE PAST THE MEM RES SYMBOLS ? 
      CPA COMTP     IS THIS A LABELLED COMMON ENTRY ? 
      JSB ENTER     MEMORY RESIDENT OR LABELLED COMMON
      ISZ COUNT     UP THE COUNT
      NOP           DON'T CARE ABOUT THE SKIP 
      ISZ #SYMB     UP THE TOTAL COUNT
      JMP NXENT     NOT DONE YET, GET NEXT ONE
      JMP SETUP,I   DONE, RETURN TO CALLER
* 
ENTER NOP 
      ALF,ALF       SET TYPE INTO UPPER BYTE
      STA SNAME+4   FOR THE LOADER SYMBOL TABLE 
      JSB L.SYE     PUT THE SYMBOL IN THE SYMBOL TABLE
      DEF *+6 
      DEF SNAME+1   SYMBOL NAME 
      DEF SNAME+4   SYMBOL TYPE 
      DEF SNAME+5   SYMBOL VALUE
      DEF P2        NO NOT OVERRRIDE ANY CURRENT DEFINITION 
      DEF RESLT     ERROR FLAG RETURNED 
      SSA           ERROR ? 
      JMP ERROR     YES, GO REPORT
      JMP ENTER,I   NO, RETURN
* 
RESLT BSS 1         ERROR FLAG
FRSCN DEC -1        FIRST TIME FLAG 
#SYMB BSS 1         -VE TOTAL COUNT FOR SYMBOLS IN SNAPSHOT 
B15   OCT 100000
      SKP 
* 
*  SCAN THE SYSTEM ENTRIES FROM THE SNAPSHOT
* 
SYLOK NOP 
      JSB POSNT     POSITION TO START OF RESIDENT LIB ENTS
      DEF *+5 
      DEF SDCB      SNAP DCB
      DEF I.ERR     ERROR PARM
      DEF P2        POSITION TO SYSTEM ENTRIES
      DEF P2        TREAT ABOVE AS A RECORD NUMBER
      SSA           ERROR ? 
      JMP SNFMP     YES 
      LDA #SENT     NUMBER SYSTEM ENTRIES 
      CMA,INA 
      STA COUNT     SAVE AS COUNT 
      CLA 
      STA NM2.L,I    CLEAR VALID NAME READ FLAG 
* 
READS JSB READ      READ SNAP ENTRY 
      LDA SNAME+4   CHECK FOR COMMON ACCESS 
      CPA P2        IS THIS AN COMMON SYMBOL ENTRY ?
      JMP SKIP      YES, IF SHE ASKED FOR IT, SHES ALREADY GOT IT 
      JSB L.MAT     FIXUP PREVIOUS REFERENCES 
      DEF *+5 
      DEF SNAME+1   SNAP ENTRY
      DEF SNAME+4 
      DEF SNAME+5 
      DEF RESLT     RESULT
* 
SKIP  ISZ COUNT     HAVE WE READ ALL ?
      JMP READS     NO, READ NEXT ENTRY 
      JMP SYLOK,I   YES,  RETURN TO CALLER
* 
* 
READ  NOP 
      JSB READF     READ ENTRY OFF SNAPSHOT FILE
      DEF *+5 
      DEF SDCB
      DEF I.ERR 
      DEF SNAME 
      DEF P10       RECORD LENGTH 
      SSA,RSS       ERROR RETURNED ?
      JMP READ,I    NO, RETURN
* 
SNFMP JSB FMPER 
      DEF SNAMR+0 
      JMP SYSCN,I 
* 
RHALF OCT 377 
SNAME BSS 10
COUNT EQU FIRST 
NCNT  BSS 1 
P10   DEC 10
      SKP 
* 
*  SCAN USER NAMED LIBRARY FILES
* 
URLIB NOP 
      LDA #LIBS     -VE NUMBER USER LIBRARIES 
      SZA,RSS       HAS USER SPECIFIED A LIBRY ?
      JMP URLIB,I   NO, SCAN SYSTEM LIBRARIES 
      STA COUNT     YES, SAVE COUNT VARIABLE
      LDA ABNAM 
NXTNM STA NAM 
      JSB FOPEN     OPEN THE USER LIBRARY FILE
      DEF *+5 
NAM   BSS 1 
      DEF ID.CB+0 
      DEF IOPTN 
      DEF P272
      JMP SYSCN,I   ERROR RETURN
* 
      CLA           SET SEARCH MULTIPLE FLAG
      JSB SE.MS     SEARCH THE FILE 
      JMP FMER?     ERROR RETURN
* 
      LDA NAM       INCREMENT TO NEXT NAMR ADDRESS
      ADA P6        EACH ARE SIX WORDS LONG 
      ISZ COUNT     HAVE WE SEARCHED ALL ?
      JMP NXTNM     NO, OPEN NEXT FILE
      JMP URLIB,I 
* 
FMER? SSA,RSS 
      JMP SYSCN,I   ERROR EXIT, NOT FMP 
      JSB FMPER 
      DEF NAM,I 
      JMP SYSCN,I 
      SKP 
* 
*  SEARCH THE SYSTEM LIBRARIES FROM THE SNAPSHOT
* 
LBLOK NOP 
      CCB           INITIALIZE THE SYSTEM LIB LOADED FLAG 
      STB SLOAD     SET TO 'NONE LOADED'
      LDA #SLIB     NUMBER OF LIBRARIES IN SNAP 
      AND RHALF 
      SZA,RSS       HAVE WE GOT ANY ? 
      JMP LBLOK,I   NO, RETURN TO CALLER
      CMA,INA       YES, NEGATE NUMBER TO BE SEARCHED 
      STA COUNT     AND SAVE AS A COUNT 
      LDA #SENT     DETERMINE RECORD NUMBER ALSO
      ADA P2
      STA RECRD 
* 
      JSB POSNT     POSITION TO SYSTEM LIBRARY NAMRS
      DEF *+5 
      DEF SDCB
      DEF I.ERR+0 
      DEF RECRD 
      DEF P2
* 
      SSA           FMP ERROR ? 
      JMP SNFMP     YES, GO REPORT AND ABORT
* 
NEXT  JSB READF     READ NAMR FROM SNAPSHOT 
      DEF *+5 
      DEF SDCB      SNAP DCB
      DEF I.ERR+0      ERROR PARAMETER
      DEF SNAME     LIBRARY NAMR BUFFER 
      DEF P10       BUFFER LENGTH OF 10 WORDS 
* 
      SSA           ERROR ON READ ? 
      JMP SNFMP     YES, REPORT ERROR 
      CLA,INA 
* 
      JSB FOPEN     AND OPEN THE FILE 
      DEF *+5 
      DEF SNAME 
      DEF ID.CB+0 
      DEF IOPTN 
      DEF P272
      JMP SYSCN,I   ERROR RETURN
* 
      CCA           CLEAR SEARCH MULTIPLE FLAG
      JSB SE.MS     SEARCH THE FILE 
      JMP ERFP?     ERROR RETURN
      ISZ NOR.L     WAS ANYTHING LOADED ? 
      CLA,RSS       YES, SET SLOAD FLAG 
      JMP NLOAD     NO, SO DON'T ALTER SLOAD FLAG 
      STA SLOAD     YES, SET SOMETHING LOADED FLAG
NLOAD ISZ COUNT     HAVE WE SEARCHED ALL THE FILES ?
      JMP NEXT      NO, OPEN THE NEXT ONE 
      JMP LBLOK,I   YES, RETURN TO CALLER 
* 
SLOAD BSS 1         0/-1, YES/NO A SYSTEM LIB MODULE WAS LOADED 
ERFP? SSA,RSS 
      JMP SYSCN,I 
      JSB FMPER 
      DEF SNAME 
      JMP SYSCN,I 
* 
ABNAM DEF BNAMR+0 
P6    DEC 6 
IOPTN OCT 111 
RECRD BSS 1 
      HED TERMINATE MODULE LOAD 
* 
* 
*  PROCEDURE 'END' IS CALLED TO COMPLETE THE CURRENT MAIN OR
*  SEGMENT LOAD,  THAT IS, PRINT ENTRIES, FINISH THE ID SEGMENT,
*  AND SET UP FOR THE NEXT SEGMENT. 
* 
* 
*  CALLING SEQUENCE:  JSB END 
* 
*  ON RETURN:   P+1:  ERORR RETURN
*               P+2:  GOOD RETURN 
* 
* 
END   NOP 
      LDA PL.ST     GET LISTING WORD
      ARS           ARE WE LISTING THE ENTRIES ?
      SLA,RSS 
      JMP NOLST     NO, SKIP LIST 
* 
*  LIST ENTRIES IN CURRENT MAIN OR SEGMENT
* 
      JSB SPACE     YES, SPACE UP ONE LINE
      LDA MESS8     OUTPUT HEADER MESSAGE 
      LDB P12       (NOTE: THERE MUST BE AT LEAST ONE 
      JSB DRKEY      ENTRY POINT IN THE MODULE!)
      JSB SPACE     SPACE UP ONE BLANK LINE 
      CLA           INITIALIZE PNTR FOR L.LDF 
      STA PNTR
* 
ELIST JSB L.LDF     GET THE NEXT ENTRY POINT
      DEF *+4 
      DEF SYMBL 
      DEF PNTR
      DEF N1        MARK ENTRIES AS LISTED
      SZB,RSS       GOT ANY ? 
      JMP NOLST     NOPE, END OF LIST 
      ADB P4
      STB ADRX
      JSB .DFER 
      DEF NAMEE 
      DEF SYMBL,I 
      JSB CNUMO 
      DEF *+3 
ADRX  BSS 1 
      DEF VALUE 
* 
      LDA EMES      OUTPUT MESSAGE
      LDB P16       TO USER 
      JSB DRKEY     VIA DRKEY 
      SSA,RSS 
      JMP ELIST     PRINT NEXT DEFINED ENTRY
      JSB FMPER 
      DEF LNAMR+0 
      JMP AB.RT 
* 
P4    DEC 4 
P16   DEC 16
PNTR  NOP 
EMES  DEF *+1 
      ASC 1, *
NAMEE ASC 4,
VALUE BSS 3 
SYMBL BSS 1 
MESS8 DEF *+1 
      ASC 6,ENTRY POINTS
OFFBP BSS 1         OFFSET INTO DUMMY BASE PAGE 
* 
*  ANY BASE PAGE TO BE OUTPUT ? 
* 
NOLST LDA SGB.L     GET CURRENT BASE ADDRESS
      CMA,INA 
      ADA CBP.L     CURRENT AVAILABLE - CURRENT BASE
      LDB OFFBP 
      ADB SGB.L     GET THE DUMMY ADDRESS 
      JSB OUTBP     AND OUTPUT TO FILE VIA OUTBP
* 
      JSB FINID     FINISH OFF THE ID SEGMENT 
      JMP NXSEG     PREPARE FOR NEXT SEGMENT
      JMP NTRMO     REALLY DONE ! 
      JSB L.SG0     YES, SET CONDITIONS FOR FIRST SEGMENT 
      DEF *+2 
      DEF TEMP
      LDA TH2.L 
      STA CFWA
      ISZ SEG.L     BUMP SEG-MAIN FLAG TO 2 
      JMP MSGP2     AND CONTINUE
* 
* 
NXSEG JSB L.SGN     NO, SET CONDITIONS FOR NEXT SEGMENT 
      DEF *+2 
      DEF TEMP
* 
MSGP2 LDA DBFLG     NO, IS DEBUG SPECIFIED
      SZA,RSS 
      JMP MSGP4     NO
      JSB L.SYE     YES, ENTER UNDEFINED SYMBOL INTO LST
      DEF *+6 
      DEF .DBSG     SYMBOL NAME ARRAY 
      DEF P2        SET AS UNDEFINED
      DEF P0        VALUE = ZERO
      DEF P2        DO NOT OVERRIDE 
      DEF RESLT     RESULT RETURNED 
* 
      JSB .DFER 
      DEF DB1X+0
      DEF .DBSG 
      JSB .DFER 
      DEF DB1+0 
      DEF .STDB 
MSGP4 LDA PL.ST     ARE WE LISTING ?
      SZA,RSS 
      JMP NLIST     NO
      JSB SPACE     YES, OUTPUT THREE BLANK LINES 
      JSB SPACE 
      JSB SPACE 
* 
NLIST ISZ END       NO LIST 
      JMP END,I     COMPLETED END PROCESSING
* 
P0    DEC 0 
.STDB ASC 3,.STDB 
* 
NTRMO JSB WRITF     NORMAL TERMINATION PROCESSING 
      DEF *+6       POST CURRENT RECORD BUFFER TO THE FILE
      DEF ODCB      OUTPUT DCB
      DEF I.ERR+0   ERROR PARM
      DEF OUTBF+0   BUFFER
      DEF P128      LENGTH
      DEF CUREC     CURRENT RECORD NUMBER 
* 
* 
      ISZ END       TAKE GOOD RETURN
      JMP END,I 
.DBSG ASC 3,.DBSG 
P128  DEC 128 
      HED BUILD PROGRAM ID SEGMENTS 
* 
*  BLDID AND FINID ARE THE TWO ROUTINES WHICH BUILD THE ID
*  SEGMENTS, LONG AND SHORT.  ALNID POINTS TO THE DUMMY LONG ID 
*  IN MEMORY, ASHID POINTS TO THE DUMMY SHORT.  THESE ARE LOCATED 
*  BETWEEN THE TWO ROUTINES.
* 
*  CALLING SEQUENCE:    JSB BLDID 
* 
*  ON RETURN      P+1:  THIS IS A SEGMENT OF SUBROUTINE THAT
*                       WE JUST PROCESSED 
*                 P+2:  THIS IS THE MAIN
* 
* 
* 
BLDID NOP 
      LDB PRENT,I   HAS THE PROGRAM PRIMARY ENTRY 
      SZB           BEEN DEFINED ?
      JMP BLDID,I   NO, SO WE CAN'T DO MUCH HERE
* 
      ISZ BLDID     GO ON TO NEXT CASE
      STA PRENT,I   SET PRIMARY ENTRY POINT ADDRESS 
      LDA NM2.L     MOVE NAME INTO ID SEGMENT 
      INA 
      LDB NAME
      JSB .MVW
      DEF P3
      NOP 
* 
      LDB NAME      CLEAR OUT THE SIXTH CHARACTER 
      ADB P2        IN THE SEGMENT NAME 
      LDA B,I 
      AND LCHAR 
      STA B,I 
* 
      LDA PGT.L     IS CURRENT MODULE A SEGMENT ? 
      CPA P5
      JMP BLDID,I   YES, RETURN 
* 
      LDA NM4.L,I   NO, THIS IS THE MAIN, GUYS
      STA PRIOR     SAVE PRIORITY 
      ISZ BLDID     ONE MORE ISZ FOR THE ROAD 
      JMP BLDID,I   AND RETURN
* 
* 
LCHAR OCT 77400 
PRENT DEF PENT      ADDRESS OF MAIN/SEG PRIMARY ENT 
HIMAN DEF HIMN      MAIN/SEG HIGH MAIN + 1
HIBSE DEF HIBS      MAIN/SEG HIGH BASE PAGE + 1 
NAME  DEF PNAME     ADDRESS OF MAIN'S NAME
      HED DUMMY ID SEGMENTS 
ALNID DEF *+1       ADDRESS OF LONG ID SEGMENT
      DEC -1        LIST LINKAGE WORD 
      BSS 5 
PRIOR BSS 1         PROGRAM PRIORITY
PENT  BSS 1         PRIMARY ENTRY POINT 
      BSS 4 
PNAME BSS 3         PROGRAM NAME
STATS BSS 1         STATUS WORD 
      BSS 4 
LOMAN BSS 1         LOW MAIN ADDRESS
HIMN  BSS 1         HIGH MAIN ADDRESS + 1 
HIMN1 BSS 1         ALSO SET TO HIGH MAIN + 1 
LOBSE BSS 1         # ID SEGMENTS /LOW BASE PAGE
HIBS  BSS 1         HIGH BASE PAGE + 1
      BSS 5 
SYCKM BSS 1         SYSTEM CHECKSUM WORD
      BSS 1         ID SEGMENT CHECKSUM VALUE 
SHIGH BSS 1         HIGHEST SEGMENT ADDRESS + 1 
BHIGH BSS 1         HIGHEST BASE PAGE ADDRESS + 1 
* 
* 
ASHID DEF *+1       ADDRESS OF SHORT ID SEGMENT 
      BSS 3         PROGRAM NAME
      BSS 1         PRIMARY ENTRY POINT ADDRESS 
      BSS 1         HIGH SEGMENT + 1
      BSS 1         HIGH BASE PAGE ADDRESS + 1
      BSS 1 
      BSS 1         CHECKSUM VALUE FOR ID SEGMENT 
      HED FINISH OFF THE ID SEGMENTS
* 
* 
FINID NOP           FINISH ID SEGMENT PROCESSING
      LDA CBP.L     CURRENT WORD AVAILABLE BASE PAGE
      STA HIBSE,I   SET AS HIGH BASE ADDRESS + 1
      LDB BHIGH     CHECK FOR NEW ALL TIME HIGH 
      CMB,INB 
      ADB A 
      SSB,RSS       IS THIS HIGH THE LARGEST SO FAR ? 
      STA BHIGH 
      LDA TH2.L     HIGH ADDRESS + 1
      STA HIMAN,I   SAVED AS HIGH MAIN + 1
      LDB SHIGH 
      CMB,INB 
      ADB A 
      SSB,RSS 
      STA SHIGH 
      LDB SEG.L 
      CPB P2        ARE WE A SEGMENT ?
      RSS           YES, FINISH OFF THE ID
      JMP FINI0     NO, MAIN
* 
      LDA ASHID     ADRESS OF SHORT ID
      LDB P8        AND LENGTH
      JSB CCKSM     CALCULATE CHECKSUM
      LDA SEG#      GET CURRENT SEGMENT NUMBER
      ADA N1        STARTING AT 0 
      MPY P8
      DIV P128      DETERMINE RECORD, WORD
      ADA P2        ADD IN STARTING RECORD NUMBER 
      JSB ABOUT     GET RECORD IN MEMORY
      ADB AOUTB     GET OUTBF ADDRESS 
      LDA ASHID     SOURCE ADDRESS
      JSB .MVW
      DEF P8
      NOP 
      CLA 
      STA PRENT,I 
* 
      LDB MSEGF     IS THIS THE FINAL SEGMENT ? 
      SZB,RSS 
      JMP FINID,I   NO
      JMP FIN02     AND FINISH OFF THE MAIN 
* 
N1    DEC -1
P8    DEC 8 
AOUTB DEF OUTBF+0 
SEG#  DEC 0 
* 
* 
* 
FINI0 STA HIMN1     FINISH OFF THE MAIN ID
      LDA MSEGF     IS THIS THE FINAL SEGMENT ? 
      SZB           ARE WE SEGMENTED ?
      SZA 
      JMP FIN02     UNSEGMENTED OR NO SEGMENTS RELOCATED
      LDA ASHID     SET UP FOR SHORT ID PROCESSING
      STA NAME
      ADA P3
      STA PRENT 
      INA 
      STA HIMAN 
      INA 
      STA HIBSE 
      ISZ FINID 
      ISZ FINID 
      JMP FINID,I 
* 
* 
P3    DEC 3 
FIN02 LDA SEG#
      ALF,ALF 
      RAL,RAL 
      IOR LOBSE 
      STA LOBSE 
      LDA P.ROR     WAS A PRIORITY SPECIFIED FOR THIS PROGRAM ? 
      SZA 
      STA PRIOR     YES, SET OVERRIDING PRIORITY
      LDA ALNID     CALCULATE THE CHECKSUM ON THE ID
      LDB P32 
      JSB CCKSM 
      CLA,INA       LONG ID GOES IN RECORD ONE
      JSB ABOUT     GET THIS RECORD IN MEMORY 
      LDA ALNID     AND MOVE IN THE ID
      LDB AOUTB 
      JSB .MVW
      DEF P34 
      NOP 
      ISZ FINID 
      JMP FINID,I   DONE !
* 
P32   DEC 32
P34   DEC 34
      SKP 
* 
CCKSM NOP 
      CMB,INB 
      INB 
      STB LENID 
      CLB 
LOOP  ADB A,I 
      INA 
      ISZ LENID 
      JMP LOOP
      STB A,I 
      JMP CCKSM,I 
* 
LENID NOP 
      HED CHECK BREAK FLAG
* 
* 
*  CKBRK CHECKS THE BREAK FLAG AND IF SET -VE JUMPS TO 'ABORT'
*  IN THE MAIN. 
* 
* 
*  CALLING SEQUENCE:  JSB CKBRK 
* 
*  ON RETURN:         NO RETURN IF BREAK, ELSE P+1
* 
* 
CKBRK NOP 
      JSB IFBRK     DO IF BREAK THING 
      DEF *+1 
      SSA           BREAK ? 
      JMP AB.RT     YUP, GO TO IT 
      JMP CKBRK,I   NO, RETURN TO CALLER
      HED RENAME OUTPUT FILE
* 
* 
*  RENAM IS CALLED TO DETERMINE IF A SCRATCH FILE WAS USED
*  FOR THE OUTPUT FILE AND IF SO, TO RENAME THE FILE TO THE 
*  PROGRAM NAME.  IF AN FMP ERROR RESULTS FROM THE RENAME,
*  RENAM RENAMES THE FILE TO THE PROGRAM NAME WITH THE FIRST
*  TWO CHARACTERS REPLACED WITH '..'.  IF THIS RESULTS IN AN
*  FMP ERROR ALSO, RENAM TAKES THE ERROR EXIT.
* 
* 
*  CALLING SEQUENCE:  JSB RENAM 
* 
*  ON RETURN:   P+1:  GOOD RETURN, PROGRAM RENAMED IF NECESSARY 
*               P+2:  ERROR ON RENAME, ABORT THE LOAD 
* 
* 
* 
RENAM NOP           RENAME OUTPUT FILE ?
      JSB .DFER 
      DEF PROGN     FIRST SAVE THE NAME IN THE MAIN 
      DEF PNAME     FROM THE ID SEGMENT VALUE 
* 
      LDA PROGN+2   ALSO NEED TO BLANK THE 6TH CHARACTER
      AND O7400 
      IOR BLNK2 
      STA PROGN+2 
* 
      LDA OTDFT     NOW, DO WE NEED TO RENAME ? 
      SZA,RSS       DEFAULT NAME USED (IE  SCRATCH FILE) ?
      JMP RENAM,I   NO, NO RENAME OF THE OUTPUT FILE
* 
      CCB           NEED TO FIRST POST THE CURRENT RECORD 
      JSB OUTAB     TO THE PROGRAM FILE 
      DEF *+1 
RENM1 JSB NAMF      RENAME TO PROGRAM NAME
      DEF *+7 
      DEF ODCB+0    OUTPUT DCB
      DEF I.ERR+0   ERROR PARM
      DEF ONAMR+0   OLD NAME
      DEF PROGN+0   NEW NAME
      DEF ONAMR+3   SECURITY CODE 
      DEF ONAMR+4   CR NUMBER 
* 
      CPA N2        DUPLICATE NAME ?
      JMP DUNAM     DUPLICATE NAME, CHECK FOR ..
      SSA,RSS       ANY OTHER FMP ERROR ON RENAME ? 
      JMP RENM2     NO, FINISH UP THE RENAME
* 
      JSB FMPER     YES, OUTPUT FMP ERROR MESSAGE 
      DEF PROGN+0   ON THE PROGRAM NAME 
      ISZ RENAM     DO ABORT PROCESSING 
      JMP RENAM,I 
* 
DUNAM LDB PROGN     DUPLICATE NAME OUT THERE
      CPB ..        HAVE WE ALREADY TRIED ..XXX ? 
      JMP ERFM      YES, WELL THEN WE GOT AN ERROR
* 
      LDA ..        NO, SO GIVE ..XXX A TRY 
      STA PROGN     SET NEW PROGRAM NAME
      JMP RENM1     GO TRY RENAME ONCE MORE 
* 
ERFM  LDA P8        GOT AN ERROR, OUTPUT 'DU PGM' 
      JSB LDRER 
* 
      JSB REOPN     NOW MUST REOPEN, EVEN FOR ERROR PROCESSING
      ISZ RENAM     GO DO ABORT PROCESSING
      JMP RENAM,I 
* 
RENM2 JSB .DFER     MUST ALSO UPDATE ONAMR
      DEF ONAMR+0   DESTINATION 
      DEF PROGN+0   SOURCE
      JSB REOPN     MUST REOPEN THE FILE, NAMF CLOSES IT
      JMP RENAM,I   NO ERROR, RETURN TO THE CALLER
* 
..    ASC 1,..
O7400 OCT 77400 
BLNK2 OCT 40
* 
* 
REOPN NOP           REOPEN THE OUTPUT FILE AFTER A RENAME 
      JSB OPEN
      DEF *+7 
      DEF ODCB      OUTPUT FILE DCB 
      DEF I.ERR     ERROR PARM
      DEF ONAMR     OLD NAMR
      DEF IOPT      OPEN OPTION 
      DEF ONAMR+4   SECURITY CODE 
      DEF ONAMR+5   CARTRIDGE NUMBER
      JMP REOPN,I   RETURN TO CALLER
* 
IOPT  OCT 4 
      END LOAD2 
                                                                                                                                                                                                                                                