ASMB,L,Z,C
*RTLGN  USE 'ASMB,Z '  ALWAYS !!
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      HED RTE L GENERATOR SEGMENT 4 
      NAM RTLG4,5 92070-1X081 REV.1941 790906 
* 
* 
*     NAME:    RTE L  GENERATOR SEGMENT 4 
*     SOURCE:  92070-18081
*     PGMR:    B.C. 
* 
      ENT RTLG4 
* 
* 
      EXT EXEC
* 
      EXT DSTRG,IPBUF,DIPBF 
      EXT OP?,ASTRX 
      EXT EXIT
* 
      EXT SEGNM 
      EXT TDBP,LDBP,CSDBP,CUDBP 
      EXT L.ADD,LNKDR,.ENTR,CBP.L 
      EXT NUMID,ADDID,BPFWA 
* 
      EXT READ,NAMRR,DRKEY,SPACE,FCLOS,MOVE 
      EXT LOCC
      EXT ERRCT,CONSL,L.SYE,STCR1,PRERR 
* 
      SUP PRESS EXTRANIOUS LISTING
* 
      SKP 
      SKP 
* 
* 
RTLG4 JSB SPACE 
      LDA P12 
      STA CONSL     ECHO TO CONSOLE 
      LDB MES41 
      JSB DRKEY     PRINT " * MEM ALLOC " 
* 
      LDA D$PRT     FIND AND PATCH $PRTY (PARITY) 
      LDB P5
      JSB FSYBP 
      JSB MSENT 
* 
      LDA D$TBG     FIND & PATCH $TBG 
      LDB P6
      JSB FSYBP 
      JSB MSENT 
* 
      LDA D$MP      FIND & PATCH $MP (MEM PROTECT)
      LDB P7
      JSB FSYBP 
      JSB MSENT 
* 
      LDA D$UIT     FIND & PATCH $UIT ( UNIMPLEMENTED INST. ) 
      LDB P8
      JSB FSYBP 
      JSB MSENT 
* 
      JMP GTID      GET # OF ID SEGMENT 
* 
D$PRT DEF $PRTY 
$PRTY ASC 3,$PRTY 
* 
D$TBG DEF $TBG
$TBG  ASC 3,$TBG
* 
D$MP  DEF $MP 
$MP   ASC 3,$MP 
* 
D$UIT DEF $UIT
$UIT  ASC 3,$UIT
* 
MES41 DEF *+1 
      ASC 6,* MEM ALLOC 
* 
      SKP 
* 
MES42 DEF *+1 
      ASC 6,* # ID SEG? 
* 
* 
*     GET # ID SEGMENT
* 
GTID  JSB SPACE 
      LDA P12 
      LDB MES42 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA ID        ID SEGMENT? 
      JMP GTID#     YES 
IDERR LDA P2
      JSB LDRER 
      CLB,INB       FATAL ERROR 
      JMP STID
GTID# JSB NAMRR 
      SSA 
      JMP IDERR 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      CPA P1        IS IT NUMERIC?
      RSS           YES 
      JMP IDERR     NO , ERROR
      LDB IPBUF 
      SSB           POSITIVE ID 
      JMP IDERR     NO , ERROR
      SZB,RSS       NON ZERO ID?
      JMP IDERR     NO , ERROR
      LDA B 
      ADA N255
      SSA,RSS       IS LESS THAN 255? 
      JMP IDERR     NO , ERROR
STID  STB NUMID     POSITIVE AND NON ZERO 
* 
      LDA D$ID# 
      JSB FSYMB     FIND & PATCH # OF ID'S
      JSB MSENT     MISSING SYSTEM ENT POINT
* 
      LDA D$IDA 
      LDB LOCC
      STB ADDID     SAVE ADDRESS OF ID SEGMENT
      JSB FSYMB     FIND & PATCH ADDRESS OF 1ST ID SEG
      JSB MSENT     MISSING SYSTEM ENT POINT
* 
      LDA NUMID     SAVE # ID 
      MPY P30       EACH ID SEGMENT IS 30 WORDS 
      ADA LOCC
      STA LOCC
* 
*     MAKE SWAP TABLE SIZE EQUAL TO # OF ID SEGMENTS
* 
      LDA D$SWT 
      LDB LOCC
      JSB FSYMB     FIND SWAP TABLE POINTER AND PATCH ADDRESS 
      JSB MSENT     MISSING SYSTEM ENT POINT
      LDA NUMID 
      ADA LOCC
      STA LOCC
* 
      JMP GTSAM 
* 
D$IDA DEF $IDA
$IDA  ASC 3,$IDA
* 
D$ID# DEF $ID#
$ID#  ASC 3,$ID#
* 
D$SWT DEF $SWTA 
$SWTA ASC 3,$SWTA 
* 
      SKP 
* 
MES43 DEF *+1 
      ASC 6,* # OF SAM? 
* 
D$SAM DEF $SAM
$SAM  ASC 3,$SAM
* 
MES44 DEF *+1 
      ASC 12,* MEM RES LIBR & SY COM
* 
D$RLI DEF $RLIB 
$RLIB ASC 3,$RLIB 
* 
*     GET # OF WORD FOR SAM 
* 
GTSAM JSB SPACE 
      LDA P12 
      LDB MES43 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA SA        # OF WORD FOR SAM 
      JMP GSAM# 
SAMER CLA 
      JSB LDRER 
      JMP ADSAM     PUT IN ZERO FOR # OF SAM
GSAM# JSB NAMRR 
      SSA 
      JMP SAMER 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      CPA P1        IS IT NUMERIC?
      RSS           YES 
      JMP SAMER     NO , ERROR
      LDA IPBUF 
      SSA           POSITVE?
      JMP SAMER     NO , ERROR
      STA NMSAM     SAVE # OF SAM 
* 
ADSAM LDA D$SAM 
      LDB LOCC
      JSB FSYMB     FIND & PATCH ADDRESS OF $SAM
      JSB MSENT     MISSING SYSTEM ENT POINT
      LDA NMSAM     GET # OF SAM
      ADA LOCC
      STA LOCC
* 
      LDA D$RLI     FIND & PATCH ADDRESS OF RES. LIB. 
      LDB LOCC
      JSB FSYMB 
      JSB MSENT     MISSING SYSTEM ENT POINT
* 
      SKP 
* 
      JSB SPACE 
      LDA P24 
      LDB MES44     MEM RES LIBR
      JSB DRKEY 
      JSB SPACE 
* 
      LDA P5
      STA SEGNM     UPDATE SEGMENT FLAG FOR 2ND TIME INTO SEG 2 
* 
*     ENTER .ZPRV INTO SYM TBL AS UNDEFINED 
* 
      JSB L.SYE 
      DEF *+6 
      DEF .ZPRV 
      DEF P2
      DEF VALUE 
      DEF P1
      DEF RESLT 
* 
*     ENTER .ZRNT INTO SYM TBL AS UNDEFINED 
* 
      JSB L.SYE 
      DEF *+6 
      DEF .ZRNT 
      DEF P2
      DEF VALUE 
      DEF P1
      DEF RESLT 
* 
      SKP 
* 
*     GET # OF DISC LU
* 
      JSB SPACE 
      LDA P16 
      LDB MES46     * # OF DISC LU? 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA CD
      JMP GETD#     GET # OF DISC 
CDERR LDA P4        ERROR 
      JSB LDRER 
      JMP MCLU
GETD# JSB NAMRR 
      SSA 
      JMP CDERR 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      CPA P1        IS IT NUMERIC?
      RSS 
      JMP CDERR     NO , ERROR
      LDA IPBUF 
      SSA           POSITIVE? 
      JMP CDERR     NO
      STA #DLU      YES 
* 
* 
* 
      SKP 
* 
*     GET THE LU TO MOUNT ON BOOTUP 
* 
MCLU  JSB SPACE 
      LDA P14 
      LDB MES48     LU TO MOUNT?
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA MC
      JMP GLMC
MCERR LDA P5
      JSB LDRER 
      JMP SSCD
GLMC  JSB NAMRR 
      SSA 
      JMP MCERR 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      CPA P1        IS IT NUMERIC?
      RSS           YES 
      JMP MCERR     NO , ERROR
      LDA IPBUF 
      STA LBOOT 
* 
* 
      SKP 
* 
*     GET THE SYSTEM SECURITY CODE
* 
SSCD  JSB SPACE 
      LDA P16 
      LDB MES50     SYS SEC CODE? 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA SS
      JMP GSS 
SSERR LDA P6
      JSB LDRER 
      JMP DNXT
GSS   JSB NAMRR 
      SSA 
      JMP SSERR 
      LDA IPBUF 
      STA MSC 
      JSB SPACE 
* 
*     ENTER $XECM INTO SYMBOL TABLE 
* 
DNXT  JSB L.SYE 
      DEF *+6 
      DEF $XECM 
      DEF P1
      DEF LOCC+0
      DEF P1
      DEF RESLT 
* 
*     PLACE MASTER SECURITY CODE INTO $XECM 
* 
      LDA MSC 
      LDB LOCC
      JSB STCR1 
* 
      ISZ LOCC
* 
*     ENTER $CDIR INTO SYMBOL TABLE 
* 
      JSB L.SYE 
      DEF *+6 
      DEF $CDIR 
      DEF P1
      DEF LOCC+0
      DEF P1
      DEF RESLT 
* 
*     PLACE BOOT LU INTO $CDIR
* 
      LDA LBOOT 
      SSA,RSS 
      CMA,INA       NEGATE THE BOOT UP LU 
      LDB LOCC
      JSB STCR1 
* 
      LDA #DLU
      ALS,ALS 
      ADA LOCC
      STA LOCC
* 
      ISZ LOCC
* 
*     ENTER $MDSP INTO SYMBOL TABLE 
* 
      JSB L.SYE 
      DEF *+6 
      DEF $MDSP 
      DEF P1
      DEF LOCC+0
      DEF P1
      DEF RESLT 
* 
*     PLACE VALUE OF $MDSP ( END OF DISC TABLE ADDRESS )
* 
      LDA LOCC
      ADA N1
      LDB LOCC+0
      JSB STCR1 
* 
      ISZ LOCC
* 
*     ENTER         $CPU INTO SYMBOL TABLE
* 
      JSB L.SYE 
      DEF *+6 
      DEF $CPU
      DEF P1
      DEF LOCC+0
      DEF P1
      DEF RESLT 
* 
      LDA P1
      LDB LOCC
      JSB STCR1 
* 
      ISZ LOCC
* 
* 
NXSEG JSB EXEC
      DEF *+3 
      DEF P8
      DEF SEG2
* 
      JMP EXIT
* 
.ZPRV ASC 3,.ZPRV 
* 
.ZRNT ASC 3,.ZRNT 
* 
$XECM ASC 3,$XECM 
* 
$CDIR ASC 3,$CDIR 
* 
$MDSP ASC 3,$MDSP 
* 
$CPU  ASC 3,$CPU
* 
MES46 DEF *+1 
      ASC 8,* # OF DISC LU? 
* 
MES48 DEF *+1 
      ASC 8,* LU TO MOUNT?
* 
MES50 DEF *+1 
      ASC 8,* SYS SEC CODE? 
      SKP 
* 
* 
*     ROUTINE TO PRINT MISSING SYSTEM ENTRY POINT 
* 
MSENT NOP 
      LDA PRERR 
      SZA           PRINT ERROR?
      JMP MSENT,I   NO , PRINTED PREVIOUSLY 
      LDA P1
      JSB LDRER     PRINT " MS ENT "
      CCA 
      STA PRERR     SET ERROR PRINTED FLAG
      JMP MSENT,I 
* 
* 
      SKP 
* 
* 
*     THE BUFCL SUBROUTINE STUFFS A 40 WORD BUFFER WITH CALL+1
* 
* 
*     CALLING SEQUENCE: 
*       A = IGNORED 
*       B = ADDRESS OF BUFFER 
*       JSB BUFCL 
*       CALL+1 = DATA TO STUFFED
* 
*     RETURN: CONTENTS OF A AND B ARE DESTROYED 
* 
BUFCL NOP 
      LDB DSTRG 
      LDA N40 
      STA WDCNT     SET BUFFER LENGTH = 40
      LDA BUFCL,I   GET STUFF DATA
      STA B,I       CLEAR BUFFER WORD 
      INB 
      ISZ WDCNT     ALL WORDS CLEAR?
      JMP *-3       NO - CONTINUE CLEARING
      ISZ BUFCL 
      JMP BUFCL,I RETURN
* 
WDCNT NOP           TEMPORARY WORD COUNTER
* 
* 
*     SUBROUTINE TO CLEAR OUTPUT BUFFER 
* 
BUFC  NOP 
      JSB BUFCL 
      OCT 0 
      JMP BUFC,I
* 
* 
      SKP 
* 
* 
*     LDRER OUTPUTS ERRORS TO THE LIST DEVICE 
* 
*     CALLING SEQUENCE: 
*                       A-REG = +VE ERROR CODE
*                       JSB LDRER 
*                       RETURN
* 
* 
LDRER NOP 
      MPY P3        CALCULATE OFFSET INTO LIST OF ERROR CODE
      ADA EMESS     ADD STARTING ADDRESS OF LIST
      STA B         AND SAVE IN B-REG FOR OUTPUT
      LDA P6        LENGTH OF MESSAGE IN CHARACTERS 
      JSB DRKEY     PRINT IT
      ISZ ERRCT     BUMP UP ERROR COUNTER 
      JSB ASTRX     PRINT ******
      JSB SPACE 
      JMP LDRER,I   AND RETURN
* 
* 
EMESS DEF *+1 
      ASC 3,SAM ER  SAM SPECIFICATION ERROR 
      ASC 3,MS ENT  MISSING SYSTEM ENTRY POINT
      ASC 3,ID ERR  # OF ID SEG NOT GIVEN 
      ASC 3,OV BSE  BASE PAGE LINKAGE OVERFLOW
      ASC 3,CD ERR  DISC CARTRIDGE DIRECTORY ERROR
      ASC 3,MC ERR  MOUNT CARTRIDGE ERROR 
      ASC 3,SS ERR  SYSTEM SECURITY CODE ERROR
* 
      SKP 
      SKP 
*     TO ALLOCATE A BASE PAGE LINK
* 
* 
*     JSB TABLE ENTRY #1,I  L.ABP 
*     DEF RETRN 
*     DEF DUMY      RETURNS DUMMY BP ADDRESS  NEG = ERROR 
*     DEF REAL      RETURNS REAL BP ADDRESS 
* 
DBP   NOP 
RBP   NOP 
L.ABP NOP 
      JSB .ENTR 
      DEF DBP 
      LDA LNKDR     GET LINK DIRECTION
      CPA N1        IS IT A SYSTEM LINK ? 
      JMP L.A10     YES 
      LDA CBP.L     GET CURRENT REAL BP 
      ADA LDBP      ADD LOWER BOUND FOR DUMMY BP
      CPA CSDBP     HAS IT REACH SYS BP AREA? 
      JMP L.A20     YES , ERROR 
      STA DBP,I 
      INA 
      STA CUDBP 
      LDA CBP.L     GET CURRENT USER REAL BP
      STA RBP,I 
      INA 
      STA CBP.L     UPDATE CURRENT REAL BP
      JMP L.ABP,I   RETURN
* 
*     SYSTEM LINK ALLOCATION
* 
L.A10 LDA CBP.L     GET CURRENT REAL BP 
      ADA LDBP      ADD LOWER BOUND FOR DUMMY BP
      CPA CUDBP     HAS IT REACH USER BP AREA?
      JMP L.A20     YES , ERROR 
      STA DBP,I     NO , STORE DUMMY BP 
      ADA N1
      STA CSDBP     UPDATE CURRENT SYS DUM BP 
      LDA CBP.L 
      STA RBP,I     STORE REAL BP 
      ADA N1
      STA CBP.L     UPDATE CURRENT SYS REAL BP
      JMP L.ABP,I 
* 
L.A20 CCA           ERROR 
      STA DBP,I 
      LDA P3
      JSB LDRER     BASE PAGE LINKAGE OVERFLOW
      JMP EXIT
* 
* 
* 
      SKP 
      SKP 
* 
* 
*     TO SCAN DUMMY BASE PAGE ( OR EXISTING BASE PAGE ) 
*     FOR AN EXISTING BASE LINK.
* 
*     JSB TABLE ENTRY #2,I  L.SCN 
*     DEF RETRN 
*     DEF VALUE     VALUE TO SCAN FOR 
*     DEF BPADR     +/-  ADDRESS TO USE / NOT FOUND 
* 
VALAD NOP           ADDRESS OF VALUE
BPADR NOP 
L.SCN NOP 
      JSB .ENTR 
      DEF VALAD 
      LDA VALAD,I   GET VALUE TO SCAN FOR 
      LDB TDBP      SCAN SYS DUMMY BP 
L.S20 CPB CSDBP     IS IT EQUAL TO CURRENT SYS DUM BP 
      JMP L.S30     YES , TRY USER BASE PAGE
      CPA B,I       IS IT EQUAL TO SEARCH VALUE 
      JMP FNDSY     YES , SYSTEM BP LINK
      ADB N1        NO, ADD LINK DIRECTION FOR NEXT BP VALUE
      JMP L.S20     NO CONTINUE SEARCH
FNDSY CMB,INB       CALCULATE REAL BP ADDRESS 
      ADB TDBP      ADD TOP OF DUMMY BP ADDRESS 
      CMB,INB       DIFFERENCE BETWEEN CURRENT AND TOP DUM BP 
      ADB B1777     SUBTRACT FROM TOP OF REAL BP
      STB BPADR,I   THIS IS THE REAL LINK 
      JMP L.SCN,I   RETURN
* 
L.S30 LDB LDBP      LOWER BOUND FOR USER DUMMY BP 
      ADB BPFWA     SET USER BP LOCATION
L.S60 CPB CUDBP     IS IT EQUAL CURRENT USER DUM BP?
      JMP NOTF      YES , RETURN NOT FOUND
      CPA B,I 
      JMP FNDUS     YES , FOUND USER BP 
      INB           NO , GET NEXT ADDRESS 
      JMP L.S60     IS IT EQUAL TO CURRENT BP?
FNDUS LDA LDBP      FOUND USER BP 
      CMA,INA 
      ADB A 
      STB BPADR,I 
      JMP L.SCN,I 
* 
NOTF  CCB           NOT FOUND 
      STB BPADR,I 
      JMP L.SCN,I 
* 
      SKP 
* 
* 
*     ROUTINE TO FIND SYSTEM SYMBOL AND PATCH UP ITS VALUE
* 
*     CALLING SEQUENCE
* 
*     LDA ADDRESS OF SYMBOL 
*     LDB VALUE TO PATCH IN 
*     JSB FSYMB 
*     ERROR RETURN
*     NORMAL RETURN 
* 
FSYMB NOP 
      STA SYBAD     PUT SYMBOL ADDRESS INTO CALLING SEQUENCE
      STB PVAL      SAVE PATCH VALUE
      JSB L.ADD     FIND SYMBOL 
      DEF *+5 
SYBAD DEF * 
      DEF VALUA 
      DEF SADDR 
      DEF RESLT 
      LDA RESLT     GET RESULT
      SZA           ANY ERROR 
      JMP ERTN      YES , ERROR 
      LDA PVAL      PATCH VALUE 
      LDB VALUA 
      JSB STCR1 
      ISZ FSYMB     NORMAL RETURN 
ERTN  JMP FSYMB,I 
* 
VALUA NOP 
SADDR NOP 
RESLT NOP 
PVAL  NOP 
      SKP 
* 
*     ROUTINE TO FIND SYMBOL,SCAN,ALLOCATE BP AND PATCH 
*     TRAP CELL LOCATION
* 
*     CALLING SEQUENCE
*     LDA ADDRESS OF SYMBOL 
*     LDB ADDRESS OF TRAP LOCATION
*     JSB FSYBP 
*      RETURN TO (P+1) = ERROR
*      RETURN TO (P+2) = OK 
* 
FSYBP NOP 
      STA SYMA      SAVE SYMBOL ADDRESS 
      STB TRPLO     SAVE TRAP LOCATION
* 
      JSB L.ADD     FIND ENTRY POINT ADDRESS
      DEF *+5 
SYMA  DEF * 
      DEF VALUA 
      DEF SADDR 
      DEF RESLT 
      LDA RESLT     SYMBOL DEFINED? 
      SZA 
      JMP RTERR     NO , RETURN ERROR 
* 
      JSB L.SCN     SCAN FOR A BP 
      DEF *+3 
      DEF VALUA 
      DEF BPADR 
      LDA BPADR 
      SSA,RSS       DOES ENTRY HAVE BP LINK?
      JMP SETRP     YES , SET TRAP LOC
* 
      JSB L.ABP     NO , ALLOCATE A BP LINK 
      DEF *+3 
      DEF DUMBP 
      DEF BPADR 
* 
      LDA VALUA 
      STA DUMBP,I   PUT LINK IN DUMMY BP
SETRP LDA BPADR 
      IOR IJSB      CONSTRUCT JSB LINK,I FOR TRAP LOC 
      LDB TRPLO 
      JSB STCR1     OUTPUT
      ISZ FSYBP 
      JMP FSYBP,I 
* 
RTERR CLA 
      STA VALUA 
      JMP FSYBP,I 
* 
DUMBP NOP 
TRPLO NOP 
IJSB  JSB 0,I 
      SKP 
* 
* 
#DLU  NOP 
LBOOT NOP 
MSC   NOP 
NMSAM NOP 
VALUE NOP 
      SPC 1 
* 
*     CONTANTS
* 
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
P5    DEC 5 
P6    DEC 6 
P7    DEC 7 
P8    DEC 8 
P12   DEC 12
P14   DEC 14
P16   DEC 16
P24   DEC 24
P30   DEC 30
* 
N1    DEC -1
N40   DEC -40 
N255  DEC -255
* 
B1777 OCT 1777
* 
* 
CD    ASC 1,CD
ID    ASC 1,ID
MC    ASC 1,MC
SA    ASC 1,SA
SS    ASC 1,SS
SEG2  ASC 3,RTLG2 
      SKP 
*      BASE PAGE COMMUNICATION VALUES 
* 
A     EQU 0 
B     EQU 1 
* 
* 
      BSS 0         SIZE OF GENERATOR 
      SPC 3 
      END RTLG4 
        