ASMB,R,L,C
*     NAME:   LOAD1 
*     SOURCE: 92070-18109 
*     RELOC:  92070-16109 
*     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 LOAD1,5,99  92070-1X109  REV.2026  800507 
* 
* 
*  THE FIRST SEGMENT HAS THREE MAIN FUNCTIONS:
* 
*    *  PARSE THE RUN STRING PARAMETERS,
* 
*    *  HANDLE THE COMMANDS WHICH MUST PRECEED RELOCATION,
* 
*    *  DO CONFLICT CHECKING JUST PRIOR TO RELOCATION.
* 
* 
*  CHANGE 01/08/80
*  CHANGED CNFLT SO AS TO DEAL WITH A LOCC INITIAL BUMP IN
*  TH2.L INSTEAD OF TH1.L AS BEFORE.  THIS ALLOWED AN AUTO- 
*  MATIC OUTPUT OF THE SET LOCC VALUE BEFORE RELOCATION HAS 
*  BEGUN. 
* 
*  CHANGED CNFLT SO AS TO UPDATE TH2.L AND CBP.L WITH PGFWA 
*  AND BPFWA IF AN ILLEGAL BOUND IS FOUND.  THE ERROR MESSAGE 
*  IS PRINTED AT ILLOC AND ILBPL RESPETIVELY.  JUST BEFORE
*  THE RETURN TO CALLER OF CNFLT TH2.L AND CBP.L AND UPDATED. 
* 
*  CHANGE 2/22/80 
*  FIXED A BUG WITH THE BASE PAGE BUMP PROCESS.  ONLY UPDATE
*  BPFWA WITH A BUMP VALUE FOR A REAL-TIME PROGRAM, NOT A 
*  BACKGROUND PROGRAM.
* 
* 
*  CHANGE 3/8/80
*  CHANGED CNFLT SO AS TO ALLOCATE THE EXACT AVAILABLE BASE 
*  PAGE FOR THE DUMMY AREA.  I WAS PREVIOUSLY ALLOCATING ONE
*  TOO MANY  ( I NEVER COULD SUBTRACT VERY WELL ).
* 
*  CHANGE 5/7/80 BW 
*  SET INL.L FLAG FOR 2026 LOADER LIBRARY CHANGE TO FORCE THE 
*  USE OF AN INDIRECT LINK IF JSB TO EXT OCCURS. THIS ALLOWS
*  A PROGRAM TO START RELOCATION ON THE SAME PAGE AS THE MEMORY 
*  RESIDENT PROGRAMS AND NOT CALL A SHARED ROUTINE WITHOUT HOLDING
*  OFF INTERRUPTS FOR ONE INSTRUCTION FETCH.
* 
* 
      HED LOADER INITIALIZATION SEGMENT 
      ENT CNFLT,LOAD1,NEXTL,PARST,REMDR 
* 
      EXT INL.L,RTFW
      EXT .MVW,.DFER, #LIBS,#SGMT,AB.RT,AFWA
      EXT ARECD, BCOM,BPFWA,BPLWA,C.LEN,CBP.L 
      EXT  CDCB, CFWA,CKBND,CNAMR,CNUMO,COMAD 
      EXT COMLN,COMTP,CPL.L,CRECD,DRKEY,DSNAP 
      EXT FMPER,FOPEN,FORCD,FWAVB,FWAFS,GETST 
      EXT HEADR,ID.CB,IECHO,IFTTY,INAMR,IN.TR 
      EXT IPBUF,ISTRC,L.BUF,L.CLS, LCOM,LDRER 
      EXT LI.PR,LNAME,LOGDV,LOGLU,LSTDF,LWABP 
      EXT NAMRR,NOCMD,NLWBP,NXTOP,ONAMR,OUTAB 
      EXT OUTDF,P.ROR,PGFWA,PL.ST,PNAME,PRERR 
      EXT PRMPT,PROGT,READF,RMPAR,SEG.L,SLONG 
      EXT SNAMR,SNPDF,SYOUT, TEST,TH2.L 
* 
A     EQU 0 
B     EQU 1 
* 
DEST  BSS 5 
DUMMY EQU DEST
* 
LOAD1 JSB RMPAR     RETRIEVE PARAMETERS FROM THE MAIN 
      DEF *+2 
      DEF DEST      DESTINATION ADDRESS 
      JMP DEST,I
* 
NEXTL JMP NXTOP     BEGIN NEXT LOAD 
      HED PARSE THE RUN STRING
* 
* 
*     PARST PARSES THE LOADER RUN STRING. 
* 
*  RU,LOADER,<COMMAND>,<INPUT>,<LIST>,<OUTPUT>,<SEGMENTS>,<OPTIONS> 
* 
* 
N80   DEC -80 
* 
PARST JSB GETST     GET THE RUN STRING
      DEF *+4 
      DEF L.BUF+3   ADDRESS OF 40 WORD STRING BUFFER
      DEF N80       LENGTH OF STRING (NEG CHAR LENGTH)
      DEF SLONG 
* 
      JSB LOGLU 
      DEF *+2 
      DEF DUMMY 
      STA LOGDV 
      CLA,INA       SET DEFAULT TO CURRENT PAGE LINKING 
      STA CPL.L     LOADER LIBRARY FLAG 
* 
*  PARSE COMMAND FILE NAMR
* 
      JSB NAMRR     NOW GET THE COMMAND FILE NAME 
      LDB IPBUF+3   GET NAMR TYPE 
      SZB           HAVE WE GOT SOMETHING ? 
      JMP GTCMD     YES, GO PROCESS 
* 
      CCA           NULL OR END OF STRING 
      STA CMDFL     SET 'NO COMMAND FILE FOUND' FLAG
      LDA LOGDV     YES, GET THE LOG DEVICE AS DEFAULT
      STA CNAMR     PUT INTO PARSE BUFFER 
      CLA,INA       SET TYPE WORD TO LU (NOT A FILE)
      STA CNAMR+3 
      JMP INTR? 
* 
CMDFL BSS 1         COMMAND FILE FOUND FLAG 
* 
GTCMD LDA AIPBF     GET THE NEG COUNT AGAIN 
      LDB ACNAM 
      JSB .MVW      AND MOVE NAME TO COMMAND NAMR 
      DEF P6        SOURCE OF MOVE
      NOP           COMMAND FILE NAME ADDRESS 
* 
      LDA CNAMR+3   GET THE PARSE TYPE WORD 
      AND P3        KEEP ONLY THE LEAST TWO BITS
      STA CNAMR+3 
* 
      CPA P1        IS IT AN LU ? 
      RSS           YES 
      JMP GTREL     NO, SO GO GET THE REL FILE
INTR? JSB IFTTY     IS THE LU INTERACTIVE ? 
      DEF *+2 
      DEF CNAMR 
      CMA,SSA,INA,RSS 
      STA IN.TR     SET INTERACTIVE FLAG TO 1 
* 
*  PARSE THE RELOCATABLE INPUT FILE NAMR
* 
GTREL JSB NAMRR     NOW GET THE INPUT FILE NAME 
      SSA           END OF STRING ? 
      JMP SEFIL     YES 
      LDA IPBUF+3 
      SZA,RSS 
      JMP GTLST 
      CCE 
      ALS,ERA 
      STA IPBUF+3 
      LDA AIPBF     NEG COUNT TO A REG FOR MOVE WORDS 
      LDB AINAM 
      JSB .MVW
      DEF P6
      NOP 
* 
*  PARSE THE LIST FILE NAMR 
* 
GTLST JSB NAMRR     NOW GO GET THE LIST DEVICE
      SSA 
      JMP SEFIL     NONE INPUT, GO GET DEFAULT
      JSB LSTDF     GOT A LIST FILE, OPEN IT
      JMP GTOUT     NO ERROR, GET OUTPUT DEVICE 
      STA TEMP      GOT AN ERROR, SAVE FOR LATER MESSAGE
      LDA AIPBF     AND SAVE NAMR CONTENTS
      LDB ATMP1     IN A TEMPORARY BUFFER 
      JSB .MVW
      DEF P4
      NOP 
* 
SEFIL LDA IN.TR     FIRST DEFAULT EQUALS THE COMMAND FILE 
      SZA,RSS       BUT ONLY IF INTERACTIVE 
      JMP SEFI2     NO
      LDA ACNAM     YES, LETS TRY IT
      LDB AIPBF 
      JSB .MVW
      DEF P6
      NOP 
      JSB LSTDF     OPEN THE FILE 
      JMP GTOUT     NO ERROR
SEFI2 LDA LOGDV     NEXT DEFAULT IS THE LOG LU
      STA IPBUF     SET THE LU INTO PARSE BUFFER
      CLA,INA 
      STA IPBUF+3   SET AS TYPE LU
      JSB LSTDF     OPEN THE TYPE 0 FILE
      JMP GTOUT     NO ERROR
      JMP AB.RT     ERROR ON FINAL DEFAULT
* 
* 
*  PARSE THE OUTPUT FILE NAMR 
* 
GTOUT JSB NAMRR     GET THE OUTPUT FILE NAME
      SSA           ANYTHING ENTERED ?
      JMP SEMOR     NO
      LDA AIPBF 
      LDB AONAM 
      JSB .MVW
      DEF P8
      NOP 
* 
*  PARSE THE OPTION PARAMETERS
* 
GETOP JSB NAMRR     NOW GO GET THE OPCODE PARMS 
      SSA 
      JMP SEMOR 
      LDA IPBUF+3 
      CPA P1
      JMP NSEGM     NUMBER OF SEGMENTS IN LOAD
      LDB IPBUF     GET THE 1ST OPCODE
      JSB TEST      CHECK IT OUT
      RSS           ERROR RETURNED
      JMP GETOP     NOW THE NEXT ONE
OPERR CCA 
      STA ERFLG 
      JMP SEMOR 
* 
NSEGM LDA IPBUF     SAVE THE NUMBER SEGMENTS IN THE 
      LDB A 
      ADB N64       CHECK THAT NOT LONGER THAN 63 
      SSA,RSS 
      SSB,RSS 
      JMP OPERR     OPTION ERROR, -VE NUMBER SEGMENTS 
      STA #SGMT     LOAD AND GET NEXT COMMAND 
      JMP GETOP 
* 
AINAM DEF INAMR+0 
AIPBF DEF IPBUF+0 
ERFLG BSS 1         ERROR FLAG ON OPTION PROCESSING 
TEMP  BSS 1 
      BSS 4 
P1    DEC 1 
P3    DEC 3 
* 
      SKP 
SEMOR JSB HEADR     OUTPUT HEADER MESSAGE TO LIST DEVICE
      JMP AB.RT     ERROR ON LIST FILE WRITE
      JSB PNAME     GET PROGRAM NAME FOR SYOUT
      DEF *+2 
      DEF LNAME     BUFFER IN SYOUT 
      LDA LNAME+2   SET A COLON INTO SIXTH CHARACTER
      AND LCHAR 
      IOR COLON 
      STA LNAME+2 
      JSB .DFER     MOVE NAME INTO PRMPT SUBROUTINE 
      DEF PRMPT 
      DEF LNAME 
      LDA TEMP      WAS THERE AN ERROR ON THE ORIGIONAL LIST ?
      SSA,RSS 
      JMP NOERR     NO ERROR
      JSB FMPER     YES, ERROR, OUTPUT MESSAGE TO GOOD LIST 
ATMP1 DEF TEMP+1
NOERR ISZ CMDFL     IS THERE A COMMAND FILE ? 
      JMP COMND     YES, OPEN IT
      LDA INAMR+3   NO, WAS AN INPUT FILE NAMED ? 
      SZA,RSS 
      JMP COMND     GO OPEN IT
      CLA           SET 'COMMAND NOT INTERACTIVE' FLAG
      STA IN.TR 
      ISZ ERFLG     ERROR ON RUN STRING OPTIONS ? 
      JMP NOCMD     NO, SO GO CHECK OUT THE INPUT STRING
      CLA           DO ERROR THING
      JSB LDRER     OUTPUT 'IL PRM' MESSAGE 
      JMP AB.RT     AND ABORT 
* 
COMND JSB FOPEN     OPEN COMMAND DEVICE 
      DEF *+5 
      DEF CNAMR 
      DEF CDCB
      DEF IOPTN 
      DEF P144      DCB LENGTH
      JMP AB.RT     ERROR RETURN
      ISZ ERFLG     ERROR ON OPTION PARAMETERS ?
      JMP NXTOP     GET FIRST COMMAND 
      JMP PRERR     YES, DO ERROR THING 
* 
ACNAM DEF CNAMR+0 
LCHAR OCT 77400 
COLON OCT 72
P144  DEC 144 
IOPTN OCT 1 
      HED COMMAND PROCESSOR 
* 
* 
*  THIS  IS  THE FINAL SET OF COMMANDS.  THESE COMMANDS 
*  MUST BE ENTERED BEFORE RELOCATION BEGINS OR IN THE 
*  'LOD' PSUDO RECORD.
* 
*  CALLING SEQUENCE:  JSB REMDR 
* 
*  ON RETURN:  P+1:   NO MATCH
*              P+2:   MATCH FOUND 
* 
REMDR NOP 
      CPA SN        SNAPSHOT COMMAND ?
      JMP SNAP
      CPA LL        LIST COMMAND ?
      JMP LIST
      CPA OU        OUTPUT COMMAND ?
      JMP OUTPT 
      CPA SG       SEGMENTS ? 
      JMP SEGMT 
      CPA PR        PRIORITY COMMAND ?
      JMP PRIOR 
      CPA OP       OPTION ? 
      LDA IPBUF 
      LDB A 
      JSB TEST      LOOK FOR OPTION PARMS 
      JMP PRER      PARAMETER ERROR 
RETRN JMP REMDR,I   FOUNE A MATCH 
PRER  ISZ REMDR     NO MATCH
ERROR ISZ REMDR     LOADER OR FMP ERROR 
      JMP REMDR,I 
* 
* 
*  LIST OF VALID COMMANDS 
* 
SN   ASC 1,SN      SNAPSHOT,<NAMR>
LL   ASC 1,LL      LL,<NAMR>
OU   ASC 1,OU      OUTPUT,<NAMR>
OP   ASC 1,OP      OPTION,<OPTION>
SG   ASC 1,SG      SGMENTS,<NN> 
LO   ASC 1,LO      LOCC,<VALUE> 
BL   ASC 1,BL      BLOCC,<VALUE>
FO   ASC 1,FO      FORCE
PR   ASC 1,PR      PRIORITY,<VALUE> 
LI   ASC 1,LI      LIBRARY,<NAMR> 
      SKP 
* 
* 
*  PROCESS THE COMMANDS.
* 
SNAP  LDA IPBUF+3 
      SZA 
      JMP SNAPD     DEFINE SNAPSHOT FILE
* 
      JSB DSNAP     DISPLAY SNAPSHOT
      JMP ERROR     ERROR RETURN
      JMP RETRN     GOOD RETURN, GET NEXT OPCODE
* 
ASNAM DEF SNAMR+0 
* 
SNAPD LDA AIPBF     SNAPSHOT,NAMR 
      LDB ASNAM 
      JSB .MVW      SAVE NAMR IN SNAMR
      DEF P6
      NOP 
      LDA SNAMR+3   SAVE ONLY THE TYPE WORD FOR 
      AND P3        FIRST PARAMETER 
      STA SNAMR+3 
* 
      JSB SNPDF     DEFINE SNAPSHOT 
      JMP ERROR     FMP ERROR RETURN
      JMP RETRN     NO ERROR RETURN 
* 
LIST  JSB LSTDF     DEFINE LIST FILE
      JSB HEADR 
      JMP ERROR    FMP ERROR, IRRECOVERABLE 
      JMP RETRN     NO ERROR
* 
OUTPT LDA AIPBF     OUTPUT,NAMR 
      LDB AONAM 
      JSB .MVW      SAVE NAMR IN ONAMR
      DEF P8
      NOP 
      JMP RETRN 
* 
* 
SEGMT LDA IPBUF+3 
      LDB IPBUF 
      CPA P1
      SSB           +VE VALUE ? 
      JMP PRER      PARAMETER ERROR 
      LDA B 
      ADA N64       CHECK THAT NOT LARGER THAN 63 
      SSA,RSS 
      JMP PRER      YES, GIVE AN ERROR MESSAGE
      STB #SGMT 
      JMP RETRN 
P4    DEC 4 
N64   DEC -64 
* 
PRIOR LDA IPBUF+3   SET NEW PROGRAM PRIORITY
      LDB IPBUF 
      CPA P1        IS IT NUMERIC ? 
      SSB           +VE VALUE ? 
      JMP PRER      PARAMETER ERROR 
      STB P.ROR     SET NEW PROGRAM PRIORITY
      JMP RETRN 
* 
P2    DEC 2 
MXLIB DEC 5         MAXIMUM NUMBER USER LIBRARIES 
P5    EQU MXLIB 
AONAM DEF ONAMR+0 
P6    DEC 6 
* 
FORCE CCA 
      STA FORCD 
      JMP READ
LOCC  STB TH2.L 
      JMP READ
BLOCC STB CBP.L 
      JMP READ
LIBRY JSB LI.PR      PROCESS A USER LIBRARY 
      JMP RECV?      ERROR ON THIS, CAN WE RECOVER
      JMP READ       NO ERROR, READ NEXT COMMAND
      HED FINAL CONFLICT CHECK
* 
*  CNFLT HANDLES THE FINAL CONFLICT CHECKING AND THE
*  CHECK FOR LOADER INFORMATION RECORDS.
* 
* 
P272  DEC 272 
IOPT2 OCT 111 
N1    DEC -1
* 
CNFLT NOP 
      SSA,RSS       DOES CALLER WANT TO LOOK FOR LOD RECORDS ?
      JMP OUT       NO, SKIP THAT SECTION OF CODE 
* 
*  OPEN THE FILE AND READ AND CLASSIFY THE RECORDS UNTIL
*  A RECORD OTHER THAT A TYPE 7 (LOD AND GEN) RECORD IS 
*  FOUND, PROCESSING THESE RECORDS ALONG THE WAY. 
* 
      JSB FOPEN     OPEN THE FILE OR LU 
      DEF *+5 
      DEF INAMR 
      DEF ID.CB 
      DEF IOPT2 
      DEF P272      DCB LENGTH
      JMP CNFLT,I   YES, TAKE ERROR EXIT
* 
      LDA AIPBF     SAVE THE CURRENT CONTENTS OF IPBUF
      LDB AITMP     WE'LL WANT TO SEE IT LATER
      JSB .MVW
      DEF P6
      NOP 
READ  JSB READF     NOW READ FOR LOD RECORDS
      DEF *+6 
      DEF ID.CB+0 
      DEF I.ERR 
      DEF L.BUF 
      DEF P60       MAXIMUM LENGTH
      DEF C.LEN      LENGTH READ
      SSA 
      JMP CMERR     FMP ERROR 
      LDB C.LEN      GET THE LENGTH READ
      SZB,RSS       IS IT A ZERO LENGTH RECORD ?
      JMP READ      YES, TRY AGAIN
* 
      JSB L.CLS     IS THIS A LOD RECORD ?
      DEF *+3 
      DEF TYPE
      DEF SUBTP 
      CPA P7
      RSS 
      JMP OUT       NOT A LOD RECORD
      LDB SUBTP     IS IT A LOD RECORD ?
      CPB P5
      RSS 
      JMP READ      NO, BUT KEEP ON READING 
* 
*  GOT A LOD RECORD 
* 
      LDB C.LEN 
      ADB N3
      CLE,ELB       CONVERT TO CHARACTER COUNT
      STB SLONG     SAVE FOR PARSER 
      CLA,INA 
      STA ISTRC     SET STARTING CHARACTER
      JSB NAMRR 
      LDA IPBUF 
      STA OP? 
      JSB NAMRR     MAKE SURE NAMRR PRESERVES A-REG ! 
      LDB IPBUF 
      LDA OP? 
* 
      CPA LO       LOCC,<VALUE> ? 
      JMP LOCC
      CPA BL        BLOCC,<VALUE> ? 
      JMP BLOCC 
      CPA FO       FORCE ?
      JMP FORCE 
      CPA LI       LIBRARY ?
      JMP LIBRY 
      JSB REMDR     COMPARE TO REMAINDER OF COMMANDS
      JMP READ      MATCH FOUND 
      JMP RECV?     ERROR RETURNED, CAN WE RECOVER ?
      LDA C.LEN     GET THE RECORD LENGTH 
      SZA           IF NON-ZERO THEN ECHO IT
      JSB IECHO 
      CLA 
      STA INAMR+3   THIS RELOCATABLE NO GOOD
      JSB LDRER     OUTPUT 'IL PRM' ERROR 
RECV? LDA IN.TR     ARE WE INTERACTIVE ?
      SZA,RSS 
      JMP AB.RT     NO, NO RECOVERY 
      JMP NXTOP 
* 
OP?   BSS 1 
SUBTP BSS 1         SUBFIELD TYPE PARM ON CLASSIFY
N3    DEC -3
HIGHB OCT 70000 
AITMP DEF *+1 
      BSS 6 
CMERR JSB FMPER 
      DEF INAMR+0 
      JMP CNFLT,I 
* 
*  CHECK THAT SNAP IS DEFINED AND OPEN, CHECK FOR AN INITIAL
*  LOCC OR BLOCC BUMP, OPEN THE OUTPUT FILE AND CHECK FOR 
*  MEMORY OVERFLOW. 
* 
OUT   LDA SNAMR+3   HAS THE SNAPSHOT BEEN DEFINED ? 
      SSA 
      JMP CNFL1 
      JSB SNPDF 
      JMP CNFLT,I 
CNFL1 LDA AITMP     RESTORE IPBUF CONTENTS
      LDB AIPBF 
      JSB .MVW
      DEF P6
      NOP 
* 
      LDA #SGMT     IS THIS A SEGMENTED PROGRAM ? 
      SZA,RSS 
      JMP NOSEG     NO
      AND HIGHB     CHECK FOR POSSIBLE OVERFLOW 
      SZA 
      JMP OVFLW 
      LDA #SGMT 
      INA           INCREMENT A FOR DS !!!
      ALS,ALS 
      ALS 
      STA AMNT      AMOUNT REQUIRED FOR SHORT ID'S
* 
NOSEG LDA CBP.L     HAS USER DESIRED AND INITIAL BUMP FOR BP ?
      CCE,SZA,RSS   BUMP ?
      JMP CKPGM 
      JSB CKBND     YES, CHECK OUT THE BOUND
      JMP ILBPL     BOUND IS ILLEGAL
      LDB PROGT     GET PROGRAM TYPE
      SZB           IS THIS A REAL-TIME PROGRAM ? 
      STA BPFWA     YES, SET NEW BASE PAGE FIRST WORD 
* 
CKPGM LDB PROGT 
      SZB 
      JMP RTIME 
      LDA TH2.L     HAS USER DESIRED INITIAL BUMP FOR PROGRAM?
      CLE,SZA,RSS 
      JMP NOBMP     NO BUMP 
      JSB CKBND     CHECK OUT THE NEW BOUND 
      JMP ILLOC     BAD VALUE 
      JMP CKMEM 
NOBMP LDA PGFWA 
      STA TH2.L 
CKMEM CLO 
      LDB PGFWA     IS AMOUNT REQUIRED FOR SEGMENTS LARGER ?
      ADB AMNT
      SOC 
      JMP OVFLW 
      CMA,INA 
      ADA B 
      SSA,RSS 
      STB TH2.L     YES, SET NEW TH2.L
      JMP CONTU 
RTIME LDA TH2.L     USER REQUESTED INITIAL BUMP ? 
      CLE,SZA,RSS 
      JMP NOBP      NO BUMP 
      JSB CKBND 
      JMP ILLOC     BAD VALUE 
      STA PGFWA     SET NEW PROGRAM FIRST WORD
      JMP CONTW 
NOBP  LDA PGFWA 
CONTW CLO 
      ADA AMNT      ADD IN FOR SHORT ID'S 
      SOC 
      JMP OVFLW 
      STA TH2.L     SET NEW PROGRAM FIRST WORD
* 
CONTU JSB OUTDF     NOW OPEN THE OUTPUT FILE
      JMP CNFLT,I   ERROR EXIT
      LDA PGFWA     GET PROGRAM FIRST WORD
      STA CFWA      SET AT CURRENT FIRST WORD 
      STA AFWA      ABSOLUTE FIRST WORD 
      LDB TH2.L     HIGH SO FAR 
      ADB N1         SUBTRACT OFF A 1 
      STA TH2.L 
      LDA P2        SET INITIAL 
      STA CRECD     CURRENT RECORD
      STA ARECD     ABSOLUTE RECORD 
      CLA 
      JSB OUTAB     FILL BUMP WITH ZEROES 
      DEF *+1 
* 
      LDA #SGMT     ARE WE SEGMENTED ?
      SZA 
      JMP SGMTD     YES 
      STA SEG.L     NO, SET FLAG
      JMP CNFLD 
SGMTD CLA,INA       SET FLAG
      STA SEG.L 
      LDA PL.ST     ARE WE LISTING ?
      SZA,RSS 
      JMP CNFLD     NO
      JSB CNUMO     YES,  OUTPUT BOUNDS OF ID SEGMENTS
      DEF *+3 
      DEF PGFWA     STARTING ADDRESS
      DEF LBND+3
      CCA 
      ADA AMNT      CALCULATE UPPER BOUND 
      ADA PGFWA 
      STA TEMP      AND SAVE
      JSB CNUMO 
      DEF *+3 
      DEF TEMP
      DEF LBND+7
      LDA ASHRT     GET ADDRESS OF THE MESSAGE
      LDB P20       AND LENGTH IN CHARS 
      JSB DRKEY     OUTPUT TO THE LIST DEVICE 
* 
CNFLD CLB           HAVE WE REFERENCED SYSTEM COMMON ?
      LDA COMTP     GET COMMON TYPE FLAG
      SSA           -1 = NO COMMON, 2 = SYSTEM COMMON 
      JMP NOCOM     NO SYSTEM COMMON
      LDB BCOM      YES, SET ADDRESS OF BLANK SYSTEM COMMON 
      STB COMAD     FOR RELOCATABLE LIBRARY 
      LDB LCOM      AND SET LENGTH OF SYSTEM COMMON 
      STB COMLN 
* 
NOCOM LDA BPFWA     GET THE LIMITS ON BASE PAGE 
      CMA,INA 
      ADA BPLWA     AMOUNT OF USER BASE PAGE ALLOWED
      ADA FWAVB     GET CORRESPONDING DUMMY BASE PAGE LIMITS
      ADA N1        MINUS ONE  - FIX 3/8/80 
      STA LWABP     SET LAST WORD AVAILABLE DUMMY BASE PAGE 
      CMA 
      STA NLWBP     SAVE -VE VALUE
      CMA,INA 
      STA FWAFS     SET FIRST WORD REMAINDER FREE SPACE 
* 
* IF PROGRAM STARTS ON SAME PAGE AS THE END OF MEMORY RESIDENT LIBRARY
* THEN FORCE JSB EXT DIRECT INSTRUCTIONS TO USE AN INDIRECT LINK. 
* THIS PREVENTS A SHARED ROUTINE FROM BEING INTERRUPTED ON THE CALL!
* 
      CLB 
      LDA RTFW
      ADA N1        CALCULATE LAST WORD OF MEMORY RESIDENT LIBRARY
      AND =B076000  ISOLATE PAGE BITS 
      STA TEMOP 
      LDA TH2.L     FIRST INSTRUCTION WORD OF PROGRAM 
      AND =B076000  ISOLATE PAGE BITS 
      CPA TEMOP     SAME PAGE AS MEM RES LIB? 
      CCB           YES 
      STB INL.L     0/-1, NO/YES FORCE JSB EXT TO INDIRECT
* 
      ISZ CNFLT     TAKE ERROR FREE EXIT
      JMP CNFLT,I 
* 
ILLOC JSB CNUMO 
      DEF *+3 
      DEF TH2.L+0 
      DEF VALUL 
      LDA P5
      JSB LDRER 
      LDB MESSL 
      LDA P14 
      JSB SYOUT 
      LDA PGFWA 
      STA TH2.L 
      JMP CNFLT,I 
* 
ILBPL JSB CNUMO 
      DEF *+3 
      DEF CBP.L+0 
      DEF VALUB 
      LDA P5
      JSB LDRER 
      LDB MESSB 
      LDA P14 
      JSB SYOUT 
      LDA BPFWA 
      STA CBP.L 
      JMP CNFLT,I 
* 
* 
TEMOP BSS 1         TEMPORARY STORAGE 
AMNT  BSS 1         AMOUNT REQUIRED FOR SHORT ID'S
OVFLW LDA N3
      JSB LDRER 
      JMP CNFLT,I   ERROR RETURN
MESSB DEF *+1 
      ASC 4,BLOCC = 
VALUB ASC 3,
MESSL DEF *+1 
      ASC 4,LOCC  = 
VALUL ASC 3,
P14   DEC 14
P8    DEC 8 
P20   DEC 20
ASHRT DEF *+1 
LBND  ASC 10,IDSEG
I.ERR  BSS 1
TYPE  BSS 1 
P7    DEC 7 
P60   DEC 60
      END LOAD1