ASMB,R,L,C
*     NAME:   LOADR 
*     SOURCE: 92070-18108 
*     RELOC:  92070-16108 
*     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 LOADR,3,99  92070-16108  REV.2026  800508 
* 
* 
*  THE RTE-L RELOCATING LOADER PROVIDES A MEANS OF LINKING
*  RELOCATABLE FILES PRODUCED BY COMPILERS OR ASSEMBLERS TO-
*  GETHER WITH ONE OR MORE LIBRARY FILES.  PROGRAMS MAY BE
*  RELOCATED TO EXECUTE ON THE EXISTING RTE-L OPERATING SYSTEM
*  OR ANY OTHER RTE-L OPERATING SYSTEM AS DEFINED  BY  THE
*  SNAPSHOT FILE.  THE RTE-L LOADER BUILDS  A  MEMORY  IMAGE
*  FILE CONTAINING THE PROGRAM'S ID SEGMENTS, BASE PAGE AREAS,
*  AND PROGRAM AREAS OF MAIN AND SEGMENTS.  THE PROGRAM MAY 
*  THEN RUN IN REAL-TIME OR BACKGROUND, ACCESS SYSTEM COMMON
*  OR LOCAL COMMON, HAVE APPENDED USER DBUGR, AND HAVE LINKS
*  IN THE CURRENT PAGE OR THE BASE PAGE.  THE LOADER ITSELF MAY 
*  RUN UNDER AN RTE-L SYSTEM OR AN RTE-IVC SYSTEM.
* 
*  THE LOADER CONSISTS OF A MAIN, THREE SEGMENTS, AND A NUMBER
*  OF SUBROUTINES.  THE MAIN SERVES TO DO THE FOLLOWING:
* 
*    *  DEFINE THE FLAGS AND BUFFERS WHICH ARE SHARED BY
*       SEGMENTS AND SUBROUTINES. 
* 
*    *  DEFINE FLOW OF CONTROL THROUGH THE LOAD PROCESS,
*       CONTROL THE SCHEDULING OF THE SEGMENTS. 
* 
*    *  PROVIDE COMMAND PROCESSING FOR THOSE COMMANDS WHICH 
*       MAY BE ENTERED AT ANY POINT IN THE LOAD.
* 
*    *  DEFINE  SUBROUTINES 'NAMRR' AND 'CKBKD'  WHICH
*       NEED TO BE ACCESSABLE THROUGHOUT THE LOAD.
* 
* 
*  CHANGE 11/30/79
*  UPPED THE MAX NUMBER OF USER LIBRARIES TO 10.  THIS CHANGED
*  BNAMR FROM 30 TO 60 WORDS AND LOAD1 TO CHECK FOR 10
*  AS UPPER LIMIT.
* 
*  CHANGED FMPER TO CALL LDRER ON A -12 ON OUTPUT FILE. 
*  LDRER OUTPUTS A 'OV OUT' ERROR.
* 
*  CHANGED MAIN SO AS TO ALLOW A LIBRARY TO BE SPECIFIED
*  AT ANY TIME. 
* 
*  CHANGED THE TIME AT WHICH A SCRATCH FILE IS RENAMED TO 
*  THE PROGRAM NAME.  TIME IS NOT IN LOAD2 WHEN NAME IS 
*  FIRST KNOWN. 
* 
*  CHANGE 1/06/80 
*  CHANGED LOAD2 TO NOT ALWAYS RESCAN A FILE WHEN A SEGMENT 
*  WAS READ.  IF NOT THE FIRST SEGMENT AND NO OTHER SEGMENTS
*  WERE FOUND PREVIOUSLY IN THE FILE THEN NO RESCAN IS DONE.
* 
*  ALONG WITH THIS I CHANGED LOAD2 TO CATCH THE NM SEG ERROR
*  ( NUMBER SEGMENTS READ GREATER THAN NUMBER SPECIFIED) BEFORE 
*  THE RESCAN AND SYSTEM LIBRARY SCAN IS DONE.
* 
* CHANGE 1/18 
*  CHANGED THE LENGTH OF ODCB TO 144 FROM 16.  THIS IS BECAUSE
*  I CHANGED THE RENAME TIME TO WHEN THE MAIN HAS BEEN RELOCATED. 
*  NAMF CLOSES THE FILE TO RENAME AND WRITES ON THE 128 WORDS OF
*  THE DCB EVEN THOUGH THE ACCESS IS TYPE 1.  THOSE 144 WORDS 
*  MUST BE ALLOCATED JUST TO BE WRITTEN ON BY NAMF AND OPENF. 
*  NOTE THAT IN RTE-IV NAMF AND OPENF DON'T WRITE ONE THE DCB.
* 
*  CHANGE 2/25/80 
*  FIXED BUG WITH BASE PAGE BUMP.   A BASE PAGE BUMP WAS NOT BEING
*  ZEROED OR PROPERLY PUT OUT TO THE PROGRAM FILE.  ENTRY ALC.B 
*  WAS ADDED TO ALLOCATE A BLOCK OF LINKS FOR A BUMP.  BLOCC IN 
*  THE MAIN AND LOAD2 WERE CHANGED TO CALL ALC.B ON A BUMP TO 
*  DO THE BUMP AND ZERO THE LINKS.
* 
* 
      LOD 5,SGMENTS,3 
      ENT #LIBS,#SENT,#SGMT,#SLIB,AB.RT, BCOM 
      ENT  BGBP, BGFW,BNAMR,BPFWA,BPLWA, CDCB 
      ENT CKBND, CKSM,C.LEN,CNAMR,COMAD,COMLN 
      ENT COMTP,DBFLG,ERMES,FDONE,FORCD,FWAFS 
      ENT FWAVB,FWSYB,I.ERR,ID.CB,INAMR,IN.TR 
      ENT IPBUF,IPTYP,ISTRC, LCOM, LDCB,LI.PR,LNAMR 
      ENT LOADR,LOGDV,LWABP,LWAFS,LWSYB, MERR 
      ENT MSEGF,MXREC,NAMRR,NEXTF,NLWBP,NOCMD 
      ENT NOUDF,NXTOP, ODCB,ONAMR,OTDFT,OUTBF 
      ENT OUTOP,PGFWA,PGLWA,PL.ST,PRERR,PROGN 
      ENT PROGT,P.ROR,  ROM, RTBP,RSTRT, RTFW 
      ENT RTNS2, SDCB,SLONG,SNAMR, SYBP,TMSTG 
* 
      EXT  .MVW,ALC.B,CBP.L,CNFLT,CNUMO,  END 
      EXT  EXEC,FMPER,FOPEN,IECHO,L.BUF,LDRER 
      EXT  NAMR,NEXTL,OUTAB,PARST,PRMTR, PUDF 
      EXT READF,RE.LC,REMDR,SAVST,SEGLD,SE.MS 
      EXT SUMAP,SYOUT,SYSCN,TH1.L,TH2.L 
* 
A     EQU 0 
B     EQU 1 
* 
      SUP PRESS EXTRANIOUS LISTING
      HED BUFFERS AND FLAGS 
IPBUF BSS 10        PARSE BUFFER FOR NAMRR ROUTINE
IPTYP EQU IPBUF+3   TYPE WORD 
TMSTG BSS 15        BUFFER FOR TIME STRING
* 
LDCB  BSS 144       LIST DEVICE DCB 
ID.CB BSS 272       RELOCATABLE INPUT DCB 
ODCB  BSS 144       OUTPUT FILE DCB 
OUTBF BSS 128       OUTPUT FILE BUFFER
SDCB  BSS 144       SNAPSHOT DCB
CNAMR BSS 6         COMMAND NAMR BUFFER 
LNAMR BSS 8         LIST NAMR BUFFER
INAMR BSS 6         INPUT NAMR BUFFER 
ONAMR BSS 8         OUTPUT NAMR BUFFER
SNAMR BSS 6         SNAPSHOT NAMR BUFFER
BNAMR BSS 60        USER LIBRARY FILE NAMRS, 10 FILES MAX 
* 
#LIBS BSS 1         -VE NUMBER USER LIBRARIES 
OTDFT BSS 1         DEFAULT OUTPUT FILE USED
PL.ST DEC 1         LIST LEVEL FLAG 
P.ROR BSS 1         PROGRAM PRIORITY FLAG 
COMTP DEC -1        -1/ 2,  NO OR LOCAL/ SYSTEM COMMON
IN.TR BSS 1         INTERACTIVE FLAG
FDONE BSS 1         MAIN LOADED FLAG
DBFLG BSS 1         DEBG FLAG,  0/1,  NO/YES DEBG INCLUDED
FORCD BSS 1         FORCE LOAD FLAG 
#SGMT BSS 1         NUMBER OF SEGMENTS IN LOAD
OUTOP BSS 1         0/1, OUTPUT FILE OPEN FLAG
MXREC BSS 1         MAXIMUM RECORD WRITTEN IN PROGRAM FILE
I.ERR  BSS 1        FMP ERROR PARAMETER 
MERR  DEF ERMES+0   LOADER ERROR CODE 
PROGT BSS 1         PROGRAM TYPE WORD 
NEXTF BSS 1         NEXT LOAD FLAG
MSEGF BSS 1         FINAL SEGMENT FLAG
LOGDV BSS 1         LOG LU NUMBER 
* 
PGLWA BSS 1         PROGRAM LAST  WORD AVAILABLE
PGFWA BSS 1         PROGRAM FIRST WORD AVAILABLE
      BSS 1         DUMMY FILLER
BPLWA BSS 1         BASE PAGE LAST  WORD AVAILABLE
BPFWA BSS 1         BASE PAGE FIRST WORD AVAILABLE
* 
#SENT BSS 1         NUMBER SYSTEM ENTRIES IN SNAPSHOT 
#SLIB BSS 1         LOW BYTE  = NUMBER MEM RES LIB ENTRIES, 
*                     HIGH BYTE = NUMBER SYSTEM LIBS IN SNAP. 
ROM   BSS 1           LAST WORD BACKGROUND + 1
BGFW  BSS 1           FIRST WORD BACKGROUND AREA
RTFW  BSS 1           FIRST WORD REAL-TIME AREA 
SYBP  BSS 1           LAST WORD BACKGROUND BASE PAGE + 1
BGBP  BSS 1           FIRST WORD BACKGROUND BASE PAGE 
RTBP  BSS 1           FIRST WORD REAL-TIME BASE PAGE
BCOM  BSS 1           ADDRESS BLANK SYSTEM COMMON 
LCOM  BSS 1 
CKSM  BSS 1           SYSTEM ID CHECKSUM WORD 
* 
FWAFS BSS 1           FIRST WORD FREE SPACE 
LWAFS BSS 1           LAST WORD FREE SPACE
LWABP BSS 1           LAST WORD AVAILABLE BASE PAGE 
NLWBP BSS 1          -VE LWABP
FWAVB BSS 1           FIRST WORD AVAILABLE BASE PAGE
FWSYB BSS 1           FIRST WORD SYSTEM BASE PAGE 
LWSYB BSS 1           LAST WORD SYSTEM BASE PAGE
COMAD BSS 1           ADDRESS SYSTEM COMMON 
COMLN BSS 1           LENGTH SYSTEM COMMON
* 
PROGN BSS 3         PROGRAM NAME ARRAY
ERMES ASC 3,IL PRM  FMP ERROR RETURN
* 
SEG1  ASC 3,LOAD1 
SEG2  ASC 3,LOAD2 
SEG3  ASC 3,LOAD3 
CDCB  BSS 144       COMMAND DCB 
.DCB  EQU * 
      HED LOADER CONTROL
**********************************************************************
* 
*  OVERLAY AREA 
* 
**********************************************************************
* 
      ORG CDCB      START OF OVERLAY AREA 
LOADR JSB SAVST     SAVE THE RUN STRING FOR SEGMENT ONE 
      DEF *+1 
* 
      JSB SEGLD     LOAD SEGMENT ONE TO PARST THE RUN STRING
      DEF *+4 
      DEF SEG1      SEGMENT NAME ARRAY
      DEF I.ERR      ERROR PARAMETER
      DEF APARS     DESTINATION ADDRESS 
      JMP NOSEG     COULDN'T LOAD SEGMENT ONE 
* 
APARS DEF PARST+0   ADDRESS OF PARST SUBROUTINE 
* 
*  NO COMMAND FILE EXISTS, RELOCATE FILE SPECIFIED IN THE RUN 
*  STRING AND TERMINATE LOAD. 
* 
NOCMD CCA           DO SOME CHECKING
      JSB INITL 
      NOP 
      JSB RE.LC     RELOCATE THE MODULE 
      JMP AB.RT     ERROR ON RELOCATION 
      ISZ FDONE 
      JMP ENDX      TERMINATE THE LOAD
      ORG .DCB
* 
**********************************************************************
* 
*  END OF OVERLAY AREA
* 
**********************************************************************
      SKP 
TERM  JSB SEGLD     LOAD SEGMENT "LOAD3" FOR FINAL
      DEF *+4       PROCESSING
      DEF SEG3      SEGMENT NAME ARRAY
      DEF I.ERR      ERROR PARAMETER
      DEF P2
      JMP NOSEG     ERROR ON SEGMENT LOAD 
* 
* 
CMERR JSB FMPER 
      DEF CNAMR+0 
* 
AB.RT JSB SEGLD     LOAD SEGMENT THREE
      DEF *+4 
      DEF SEG3      SEGMENT NAME ARRAY
      DEF I.ERR      ERROR PARAMETER ON SEGMENT LOAD
      DEF N1
* 
NOSEG LDA P9
      JSB LDRER     COULDN'T LOAD THE SEGMENT 
      JSB EXEC      TERMINATE THE LOADER
      DEF *+2 
      DEF P6
* 
P9    DEC 9 
ENDR  JSB SEGLD     LOAD SEGMENT THREE
      DEF *+4 
      DEF SEG3      SEGMENT NAME ARRAY
      DEF I.ERR      ERROR PARAMETER
      DEF P0        DESTINATION ADDRESS 
      JMP NOSEG     ERROR RETURN ON SEGLD CALL
* 
P0    DEC 0 
RSTRT JSB SEGLD 
      DEF *+4 
      DEF SEG1
      DEF I.ERR 
      DEF ANXTL 
      JMP NOSEG     ERROR ON SEGMENT LOAD 
ANXTL DEF NEXTL+0 
      HED COMMAND FILE PROCESSOR
* 
* 
NXTOP LDA IN.TR     ARE WE INTERACTIVE ?
      SZA 
      JSB PRMTR     YES, SO ISSUE PROMPT
FREAD JSB READF     READ THE COMMAND FILE 
      DEF *+6 
      DEF CDCB      COMMAND FILE DCB
      DEF I.ERR      ERROR PARAMETER
      DEF L.BUF+3   BUFFER STRNG
      DEF P40       BUFFER LENGTH, WORDS
      DEF C.LEN      LENGTH READ, WORDS 
* 
      SSA           ERROR ON COMMAND READ ? 
      JMP CMERR     YES 
* 
* 
      LDB C.LEN      GET LENGTH OF COMMAND JUST READ
      SZB,RSS       WAS IT ZERO ? 
      JMP FREAD     YES, SO DO IT AGAIN 
      SSB,RSS       WAS IT NEGATIVE (IE END OF FILE)
      JMP POSL      +VE LENGTH READ 
      LDA IN.TR     GET INTERACTIVE FLAG
      SZA           -VE LENGTH, INTERACTIVE DEVICE ?
      JMP NXTOP     INTERACTIVE, ISSUE READ AGAIN 
      JMP END??     -VE LENGTH, NON-INTERACTIVE 
POSL  CLE,ELB       NO, CONVERT TO CHAR COUNT (MULT BY 2) 
      STB SLONG     SAVE CHARS READ  FOR PARSE
* 
      LDA ECHO?     ARE WE ECHOING COMMANDS ? 
      SZA 
      JSB IECHO     YES, SO GO DO IT
* 
      CLA,INA       SET UP PARSING OFFSET TO START PARSING
      STA ISTRC     AT THE FIRST CHARACTER
      JSB NAMRR     PARSE THE OPCODE
      LDB IPBUF     GET 1ST AND 2ND CHARS 
      STB OP?       AND SET ASIDE 
      JSB NAMRR     PARSE REMAINDER OF STRING 
      LDA OP?       NOW CHECK OUT COMMAND 
      LDB FDONE 
      SKP 
* 
*     THESE COMMANDS MAY BE ENTERED ANY TIME
* 
* 
      CPA EN        END OF COMMAND FILE ? 
      JMP END?? 
      CPA .E        END OF COMMAND FILE ? 
      JMP END?? 
      CPA EX        AN EXIT COMMAND ? 
      JMP END?? 
      CPA SE        A SEARCH COMMAND ?
      JMP SECH
      CPA MS        A SEARCH MULTIPLE COMMAND ? 
      JMP MSCH
      CPA FO        A FORCE COMMAND ? 
      JMP FORCE 
      CPA RE        A RELOCATE COMMAND ?
      JMP RELC
      CPA DI        DISPLAY ? 
      JMP DSPLY 
      CPA EC        ECHO COMMAND ?
      JMP ECHO
      CPA LO        MODIFY RELOCATION BASE ?
      JMP LOCC
      CPA BL        MODIFY BASE PAGE RELOCATION BASE ?
      JMP BLOCC 
      CPA LI        ENTER NEW USER LIBRARY ?
      JMP LIBRY 
      CPA NE        NEXT ?
      JMP NEXT
      CPA /N        /NEXT ? 
      JMP NEXT
      CPA AB        ABORT ? 
      JMP AB.RT 
      CPA .A        ABORT ? 
      JMP AB.RT 
      AND M7740 
      CPA AS2RK     LEADING CHARACTER AN "*" ?
      JMP NXTOP 
* 
      SZB           HAVE WE LOADED THE MAIN ? 
      JMP PRERR     YES, PARAMETER ERROR
      LDA OP? 
      JSB REMDR     NO, CHECK OUT THE REMAINDER OF COMMANDS 
      JMP NXTOP     GET NEXT COMMAND
      JMP ERFMP     ERROR, CHECK IF WE CAN RECOVER
      SKP 
* 
* 
PRERR LDA IN.TR     PARAMETER ERROR 
      SZA,RSS       ARE WE IN THE INTERACTIVE MODE? 
      JMP DOERR     NO SO DO ERROR THING
      LDA P2        YES, INTERACTIVE
      LDB ??         SO SEND A ERROR MESSAGE
      JSB SYOUT       VIA SYOUT 
      JMP NXTOP     AND GIVE HER ANOTHER CHANCE 
* 
* 
DOERR LDA C.LEN      GET THE READ LENGTH
      SZA           IF NON-ZERO ECHO IT 
      JSB IECHO 
      CLA 
      JSB LDRER 
      JMP AB.RT 
* 
ERFMP LDA IN.TR 
      SZA,RSS 
      JMP AB.RT 
      CLA 
      JMP NXTOP 
* 
* 
OP?   DEC 1         LAST OPCODE 
??    DEF *+1 
      ASC 2,??
C.LEN  BSS 1           CHARACTER LENGTH OF INPUT STRING 
P2    DEC 2 
P6    DEC 6 
P40   DEC 40
M7740 OCT 77400 
      SKP 
* 
*  THE FOLLOWING ARE THE LEGAL COMMANDS 
* 
DI    ASC 1,DI      DISPLAY,KEYWORD 
EC    ASC 1,EC      ECHO
RE    ASC 1,RE      RELOCATE,NAMR 
SE    ASC 1,SE      SEARCH,NAMR 
MS    ASC 1,MS      MSEARCH,NAMR
FO    ASC 1,FO      FORCE 
LO    ASC 1,LO      LOCC ,VALUE 
BL    ASC 1,BL      BPLOCC ,VALUE 
LI    ASC 1,LI      LIBRARY,VALUE 
.E    ASC 1,/E      /END
EN    ASC 1,EN      END 
EX    ASC 1,EX      EXIT
NE    ASC 1,NE      NEXT
/N    ASC 1,/N      /NEXT 
.A    ASC 1,/A      /ABORT
AB    ASC 1,AB      ABORT 
AS2RK OCT 25000     AN "*" CHARACTER
ECHO? BSS 1         ECHO FLAG 
      SKP 
*********************************************************************** 
* 
*  ECHO 
* 
**********************************************************************
ECHO  CCA           SET ECHO FLAG 
      STA ECHO? 
      JMP NXTOP 
* 
* 
      SKP 
**********************************************************************
* 
*  FORCE
* 
**********************************************************************
FORCE CCA           SET THE FORCE 
      STA FORCD     FLAG
      JMP NXTOP 
      SKP 
**********************************************************************
* 
*  LOCC,<VALUE> 
* 
**********************************************************************
LOCC  LDA IPBUF+3   GET THE CURRENT TYPE WORD 
      SZA,RSS       IS THIS A DISPLAY REQUEST ? 
      JMP DISPL     YES, DISPLAY CURRENT VALUE OF LOCC
* 
      ADA N1        HAS USER ENTERED A NUMERIC VALUE ?
      SZA           YES 
      JMP PRERR     ILLEGAL BOUND VALUE 
* 
      LDA IPBUF 
      CLE,SZB,RSS   HAS THE MAIN BEEN LOADED ?
      JMP LOCC1     NO, CHECK VALUE LATER 
      JSB CKBND     CHECK OUT THE BOUND 
      JMP ILBND     ILLEGAL BOUND 
      CLA 
      LDB IPBUF 
      ADB N1
      JSB OUTAB     BOUND GOOD, CALL OUTAB TO ZERO
      DEF NXTOP 
* 
LOCC1 STA TH2.L     AND TH2.L SO WILL DISPLAY NEW VALUE 
      JMP NXTOP 
* 
DISPL LDA PL.ST     BUT FIRST, ARE WE LISTING ? 
      SZA,RSS 
      JMP NXTOP     NO, GET NEXT COMMAND
      JSB CNUMO     MOVE CURRENT TH2.L VALUE
      DEF *+3 
      DEF TH2.L 
      DEF VALUL     INTO THE MESSAGE BUFFER 
* 
      LDB MESSL     GET MESSAGE ADDRESS 
      LDA P14       AND LENGTH IN CHARACTER 
      JSB SYOUT     OUTPUT TO COMMAND OR LIST DEVICE
      JMP NXTOP 
* 
ILBND LDA P5        OUTPUT 'IL BND' ERROR 
      JSB LDRER 
      JMP ERFMP     CHECK FOR RECOVERY
* 
N1    DEC -1
P5    DEC 5 
MESSL DEF *+1 
      ASC 4,LOCC  = 
VALUL ASC 3,
P14   DEC 14
      SKP 
**********************************************************************
* 
*  BLOCC,<VALUE>
* 
**********************************************************************
BLOCC LDA IPBUF+3   GET TYPE WORD 
      SZA,RSS       IS THIS A DISPLAY COMMAND ? 
      JMP DISPB     YES 
* 
      ADA N1        RESET TO INTEGER VALUE ?
      SZA           YES 
      JMP PRERR     NO, BOUND MUST BE ILLEGAL 
      LDA IPBUF     GET NEW VALUE 
      CCE,SZB,RSS   HAS MAIN BEEN LOADED ?
      JMP BPLO1     NO, JUST GO SAVE NEW VALUE
      JSB CKBND     YES, CHECK OUT THE BOUND
      JMP ILBND     ILLEGAL BOUND 
      LDA IPBUF     GET BUMP VALUE AGAIN
      JSB ALC.B     GO ALLOCATE A BLOCK OF LINKS AND ZERO 
      JMP NXTOP     OK, DO NET OPERATION
* 
BPLO1 STA CBP.L     MAIN NOT LOADED, SAVE IN CBP.L
      JMP NXTOP 
* 
DISPB LDA PL.ST     ARE WE LISTING ?
      SZA,RSS 
      JMP NXTOP     NO, GET NEXT COMMAND
      JSB CNUMO     MOVE CURRENT BP AVAILABLE 
      DEF *+3       INTO MESSAGE BUFFER 
      DEF CBP.L 
      DEF VALUB 
* 
      LDB MESSB     GET MESSAGE ADDRESS 
      LDA P14       AND LENGTH IN CHARACTERS
      JSB SYOUT     OUTPUT TO COMMAND OR LIST DEVICE
      JMP NXTOP 
* 
MESSB DEF *+1 
      ASC 4,BLOCC = 
VALUB BSS 3 
      SKP 
**********************************************************************
* 
*  LIBRARY,<NAMR> 
* 
**********************************************************************
LIBRY JSB LI.PR     CALL ROUTINE TO PROCESS THE LIBRARY 
      JMP ERFMP     GOT AN ERROR ON THIS
      JMP NXTOP     NO ERROR, GET NEXT OPERATION
* 
LI.PR NOP           ROUTINE TO ENTER A NEW LIBRARY
      LDB #LIBS     GET CURRENT NUMBER USER LIBRARIES (-VE) 
      ADB N1        AND INCREMENT (DECREMENT -VE) 
      STB A         SET ASIDE 
      ADA MXLIB     HAVE WE EXCEEDED MAX LIMIT ?
      SSA 
      JMP BERR      YES, 'LB LIM' ERROR 
      STB #LIBS     NO, SET NEW NUMBER USER LIBRARIES 
      STB A 
      CMA           +VE VALUE IN A-REG
      MPY P6        CALCULATE OFFSET INTO BNAMR BUFFER
      ADA ABNAM     AND ACTUAL ADDRESS
      STA B         SET AS DESTINATION ADDRESS
      LDA AIPBF     SOURCE ADDRESS
      JSB .MVW      MOVE NAMR INTO BNAMR
      DEF P6
      NOP 
      ISZ LI.PR     TAKE GOOD RETURN
      JMP LI.PR,I 
* 
BERR  LDA P4        MAX NUMBER OF LIBRARIES EXCEEDED
      JSB LDRER     OUTPUT THE ERROR MESSAGE
      JMP LI.PR,I   TAKE ERROR EXIT 
* 
ABNAM DEF BNAMR     ADDRESS OF THE LIBRARY NAMR BUFFER
P4    DEC 4 
MXLIB DEC 10        MAX NUMBER OF USER LIBRARIES
      SKP 
**********************************************************************
* 
*  RELOCATE,<NAMR>
* 
**********************************************************************
* 
RELC  LDA IPBUF+3   IS THERE A NAMR SPECIFIED ? 
      SZA,RSS 
      JMP PRERR     IL PRM  ( WHO YOU TRING TO FOOL !!) 
      SZB           MAIN LOADED YET ? 
      JMP LDSUB     YES 
* 
      LDA INAMR+3   RELOCATABLE IN  RUN STRING ?
      SZA 
      JMP RUNST     YES, RUNSTRING RELOCATABLE
* 
      LDA AIPBF     NO, MOVE NAMR INTO INAMR
      LDB AINAM 
      JSB .MVW
      DEF P6
      NOP 
      CLA,RSS       SET NO RUN STRING FLAG
RUNST CCA 
      STA TEMP      SET CHECK FLAG
      CCA           SET CHECK FLAG
      JSB INITL     INITIALIZE AND CHECK
      JSB RE.LC     RELOCATE THE MODULE 
      JMP AB.RT     ERROR RETURN
      ISZ FDONE     NOW MAIN IS LOADED
      ISZ TEMP      WAS THIS A RUN STRING ? 
      JMP NXTOP     NO, GET NEXT OPCODE 
* 
LDSUB JSB IOPEN     MOVE NAMR INTO INAMR AND OPEN 
      JSB RE.LC     RELOCATE THE FILE 
      JMP AB.RT     ERROR RETURN ON RE.LC 
      JMP NXTOP     GOOD RETURN 
* 
AINAM DEF INAMR+0 
AIPBF DEF IPBUF+0 
* 
INITL NOP           DO INITIAL CHECKING FOR FIRST RELOCATABLE 
      JSB CNFLT     CONFLICT CHECKING 
      JMP ERROR     ERROR RETURN
      JSB SEGLD     OK, SO LOAD SEGMENT 2 
      DEF *+3 
      DEF SEG2
      DEF I.ERR 
      JMP AB.RT     ERROR, ABORT
RTNS2 JMP INITL,I   RETURN FROM SEGMENT 1 
* 
ERROR CLA           ERROR RETURN FROM CNFLT 
      STA INAMR+3   CLEAR OUT THE GOOD NAMR FLAG
      JMP ERFMP     AND SEE IF WE CAN CONTINUE
* 
IOPEN NOP           MOVE NAMR INTO INAMR AND OPEN THE FILE
      LDA AIPBF     SOURCE
      LDB AINAM     DESTINATION 
      JSB .MVW      MOVE NAMR 
      DEF P6
      NOP 
      JSB FOPEN     OPEN FILE AND CHECK ERROR 
      DEF *+5 
      DEF INAMR     PASSING NAMR ADDRESS
      DEF ID.CB             DCB ADDRESS 
      DEF IOPTN     OPEN OPTION WORD
      DEF P272              DCB SIZE
      JMP ERFMP     ERROR RETURN
      JMP IOPEN,I   GOOD RETURN 
P272  OCT 272 
IOPTN OCT 111       BINARY  NON-EXCLUSIVE OPEN
* 
      SKP 
**********************************************************************
* 
*  SEARCH,<NAMR>
* 
**********************************************************************
MULT  BSS 1 
SECH  CCA,RSS       SET NO MULTIPLE SCAN FLAG 
MSCH  CLA           MULTIPLE SCAN 
      STA MULT
      SZB           MAIN LOADED ? 
      JMP SEC00     YES 
* 
      LDA INAMR+3   RUN STRING RELOCATABLE ?
      SZA 
      JMP RUNSG     YES 
      JSB INITL     NO CHECKING FOR LOD RECORDS 
      ISZ FDONE 
      JMP SEC00 
* 
RUNSG CCA           CHECK FOR LOD RECORDS 
      JSB INITL 
      JSB RE.LC     RELOCATE THE RUN STRING FILE
      JMP AB.RT     ERROR RETURN
      ISZ FDONE 
* 
SEC00 LDA IPBUF+3   IS THIS A SYSTEM LIB SEARCH ? 
      SZA,RSS 
      JMP SEC01 
      JSB IOPEN 
      LDA MULT
      JSB SE.MS 
      RSS           CHECK FOR ERROR RETURN
      JMP NXTOP 
      SSA,RSS      FMP? OR LOADR? 
      JMP AB.RT     DON'T PRINT LOADR ERRORS
      JSB FMPER     PRINT FMP ERRORS
      DEF INAMR+0 
      JMP AB.RT 
* 
SEC01 CLA,INA 
      JSB SYSCN 
      JMP AB.RT 
      JMP NXTOP 
      SKP 
**********************************************************************
* 
*  END,/END,EXIT,NEXT,/NEXT 
* 
**********************************************************************
NEXT  CCB 
      STB NEXTF     NEXT FLAG SET 
END?? LDB FDONE 
      SZB           HAS MAIN BEEN LOADED YET ?
      JMP ENDX      YES 
      LDA INAMR+3   IS THERE A RELOCATABLE IN THE RUN STRING ?
      SZA,RSS 
      JMP ENDR      NO, TERMINATE THE LOAD
      CCA           YES, SET TO CHECK FOR LOD INFORMATION 
      JSB INITL     OPEN THE FILE 
      JSB RE.LC     RELOCATE THE MODULE 
      JMP AB.RT     ERROR RETURN
ENDX  CLA,INA 
      JSB SYSCN     MUST HAVE BEEN AN END, CHECK FOR UNDEFS 
      JMP AB.RT     ERROR RETURN
      SZA,RSS       UNDEFS REMAINING ?
      JMP DONE      NO, TERMINATE LOAD
      JSB SUMAP     YES, UNDEFS, PRINT UPPER BOUNDS ON MAIN OR SEG
      CLA,INA       PRINT ALL CURRENT UNDEFS
      JSB PUDF      YES, PRINT UNDEFS 
      LDA FORCD     DID SHE WANT TO FORCE LOAD ?
      SZA 
      JMP DONEF     YES, FORCE LOAD 
      LDA P7
      JSB LDRER     NO FORCE, ABORT WITH 'UN EXT' 
      JMP AB.RT 
* 
P7    DEC 7 
* 
DONE  JSB SUMAP     PRINT UPPER BOUNDS ON MAIN OR SEG 
DONEF ISZ MSEGF     SET FINAL SEGMENT FLAG
      JSB END       TERMINATE THE LOAD
      JMP AB.RT     ERROR RETURN
      JMP TERM      CALL SEGMENT THREE
* 
* 
      SKP 
**********************************************************************
* 
*  DISPLAY UNDEFS 
* 
**********************************************************************
DSPLY LDA IPBUF 
      SZB,RSS       HAVE WE BEGUN THE RELOCATION ?
      JMP UNDF1     NO, THUS NO UNDEFS
      CLA,INA       PRINT UNDEFS IN MAIN AND CURRENT SEG
      JSB PUDF      YES, PRINT LIST OF UNDEFS 
      JMP NXTOP     AND RETURN FOR NEXT COMMAND 
* 
UNDF1 LDA P12       OUTPUT MESSAGE "NO UNDEFS"
      LDB NMESS 
      JSB SYOUT     OUTPUT
      JMP NXTOP     AND RETURN FOR NEXT COMMAND 
* 
NMESS DEF *+1 
NOUDF ASC 6,  NO UNDEFS 
P12   DEC 12
      HED PARSE NAMRR 
* 
* 
*     THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY 
*     PARSING ROUTINE NAMR.  THE INPUT TO NAMR IS A STRING
*     OF ASCII CHARACTERS.
*     THE OUTPUT IS A 10 WORD BUFFER PARSED AS :
*     PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6
*     PARAMETERS BETWEEN COMMAS ARE PARSED.  SUBPARAMETERS ARE
*     DELINEATED BY COLONS.  THE TYPE WORD DESCRIBES ALL
*     PARAMETERS AS ASCII, NUMERIC, OR NULL.
*     THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE
*     THE INPUT.
*      15,14 13,12  11,10  9,8  7,6  5,4  3,2   1,0 
*     ------------------------------------------------
*     !       S6   ! S5   ! S4 ! S3 ! S2 ! S1 ! PRAM !
*     ------------------------------------------------
* 
*     PRAM = 0 ...NULL       PRAM1 = PRAM2 = PRAM3 = 0
*     PRAM = 1....NUMERIC  (ONLY PRAM1 USED) PRAM1 = #
*     PRAM = 2 ...NOT USED
*     PRAM = 3 ... ASCII  (USES PRAM1,PRAM2,PRAM3 ) 
* 
*     S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY
* 
* 
NAMRR NOP 
      JSB NAMR      THIS IS THE RELO LIBR PARSING ROUTINE 
      DEF *+5       RETURN ADDR 
      DEF IPBUF     ADDRESS OF 10 WORD PARSED BUFFER
      DEF L.BUF+3   ADDRESS OF BUFFER TO BE PARSED
      DEF SLONG     CHARACTER LENGTH
      DEF ISTRC     CHAR OFFSET IN STRNG FOR NEXT PRAM
      JMP NAMRR,I   RETURN TO CALLER
* 
* 
ISTRC DEC 1 
SLONG BSS 1         CHARACTER LENGTH OF BUFFER
      HED CHECK OUT MEMORY BOUNDS 
* 
*  THIS SUBROUTINE CHECKS THAT THE DESIRED LOCC OR BLOCC IS 
*  WITHIN THE CURRENT MEMORY BOUNDS.
* 
*  CALLING SEQUENCE:
*                     A-REG = VALUE TO BE CHECKED 
*                     E-REG = 0/1  MEMORY/BASE PAGE 
*                     JSB CKBND 
*            P+1 :    ILLEGAL BOUND 
*            P+2 :    GOOD BOUND
*                     A-REG = BOUNDRY VALUE 
* 
* 
CKBND NOP 
      STB TEMP
      CLB 
      ERB 
      CMA,INA 
      STA VALUE 
      LDA PGLWA     ASSUME MEMORY 
      SZB 
      LDA BPLWA     NO, BASE PAGE 
      ADA VALUE 
      SSA,RSS       HIGH - NEW < 0 => ERROR 
      SZA,RSS 
      JMP CKBND,I 
* 
      LDA FDONE     HAVE WE LOADED THE MAIN YET ? 
      SZA,RSS 
      JMP NOMAN     NO
      LDA TH2.L     YES, ASSUME MEMORY
      SZB 
      LDA CBP.L     NO, BASE PAGE 
      ADA VALUE 
      SSA           LOW - NEW <= 0 => OK
      JMP RETRN 
      SZA 
      JMP CKBND,I 
* 
RETRN LDA VALUE 
      CMA,INA 
      LDB TEMP
      ISZ CKBND 
      JMP CKBND,I 
* 
NOMAN LDA PGFWA     ASSUME MEMORY 
      SZB 
      LDA BPFWA     NO, BASE PAGE 
      ADA VALUE 
      SSA           IF -VE
      JMP RETRN 
      SZA           OR ZERO THEN OK 
      JMP CKBND,I 
      JMP RETRN 
VALUE BSS 1 
TEMP  BSS 1 
      END LOADR 
                                                                                                                                                                                                                                                  