ASMB,L,Z,C
* 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 XL  GENERATOR SEGMENT 4 
      NAM L20G4,5 92071-1X081 REV.2041 800715 
* 
* 
*     NAME:    RTE XL  GENERATOR SEGMENT 4
*     SOURCE:  92071-18081
*     PGMR:    B.C. 
* 
      ENT L20G4 
* 
* 
      EXT EXEC
* 
      EXT DSTRG,IPBUF,DIPBF 
      EXT OP?,ASTRX 
      EXT EXIT
* 
      EXT SEGNM,RECOF 
      EXT TDBP,LDBP,CSDBP,CUDBP 
      EXT L.ADD,LNKDR,.ENTR,CBP.L 
      EXT NUMID,BPFWA,CNUMD,CNUMO 
* 
      EXT READ,NAMRR,DRKEY,SPACE
      EXT LOCC,PARTN
      EXT ERRCT,CONSL,L.SYE,STCR1,PRERR,SLOCC 
      EXT L.BUF,L.LDF,INL.L 
* 
      SUP PRESS EXTRANIOUS LISTING
* 
      SKP 
      SKP 
* 
* 
L20G4 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 GTCLS     GET THE CLASS TABLE 
* 
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 
* 
*     GET CLASS # 
* 
GTCLS JSB SPACE 
      LDA P16 
      LDB DMS10     # OF I/O CLASSES ?
      JSB DRKEY     OUTPUT MESSAGE
      JSB READ      GET # OF CLASSES
      JMP EXIT      END OF FILE 
      LDA OP? 
      CPA CL        CLASS ? 
      JMP CL20      YES 
CL10  LDA P9
      JSB LDRER     PRINT  IT 
      JMP GTRSN      AND CONTINUE TO GET RESOURCE # 
CL20  JSB NAMRR     GET SPECIFICED SIZE 
      SSA 
      JMP CL10      END OF STRING 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDB A,I       GET TYPE
      CPB P1        IS IT NUMERIC 
      RSS 
      JMP CL10
      LDA DIPBF,I   GET THE # OF I/O CLASSES
      SSA           POSITIVE ?
      JMP CL10      NO
      STA TSIZE     YES , SAVE IT 
      LDB A 
      ADB N256
      SSB,RSS       LESS THAN 256?
      JMP CL10      NO , ERROR
      LDB LOCC      YES 
      JSB STCR1     OUTPUT # OF I/O CLASS 
* 
      LDA D$CLT 
      LDB LOCC
      JSB FSYMB     FIND CLASS POINTER AND PATCH
      JSB MSENT     MISSING SYSTEM ENTRY POINT
* 
      LDA TSIZE 
      ALS           MUTIPLY BY 2
      ADA LOCC
      INA 
      STA LOCC      UPDATE LOCATION COUNTER 
      JMP GTRSN     GET THE RESOURCE #
* 
DMS10 DEF MES10 
MES10 ASC 8,* I/O CLASSES?
* 
D$CLT DEF $CLTA 
$CLTA ASC 3,$CLTA 
* 
      SKP 
* 
*     GET # OF RESOURCE NUMBERS 
* 
GTRSN JSB SPACE 
      LDA P20 
      LDB DMS11     # OF RESOURCE # ? 
      JSB DRKEY     OUTPUT MESSAGE
      JSB READ      GET # OF RESOURCE # 
      JMP EXIT      END OF FILE 
      LDA OP? 
      CPA RE        RESOURCE ?
      JMP RS20      YES 
RS10  LDA P10 
      JSB LDRER     PRINT IT
      JMP GTID       AND CONTINUE TO GET ID 
RS20  JSB NAMRR     GET SPECIFICED SIZE 
      SSA 
      JMP RS10      END OF STRING 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDB A,I       GET TYPE
      CPB P1        IS IT NUMERIC 
      RSS 
      JMP RS10
      LDA DIPBF,I   GET THE # OF RESOURCE # 
      SSA           POSITIVE ?
      JMP RS10      NO
      STA TSIZE     YES , SAVE IT 
      LDB A 
      ADB N256
      SSB,RSS       LESS THAN 256?
      JMP RS10      NO , ERROR
      LDB LOCC      YES 
      JSB STCR1     OUTPUT # OF RESOURCE NUM
* 
      LDA D$RNT 
      LDB LOCC
      JSB FSYMB 
      JSB MSENT     MISSING SYSTEM ENTRY POINT
* 
      LDA TSIZE 
      ADA LOCC
      INA 
      STA LOCC
      JMP GTID      GET THE ID SEGMENT
* 
DMS11 DEF MES11 
MES11 ASC 10,* RESOURCE NUMBERS?
* 
D$RNT DEF $RNTA 
$RNTA ASC 3,$RNTA 
* 
      SKP 
* 
MES42 DEF *+1 
      ASC 7,* ID SEGMENT? 
* 
* 
*     GET # ID SEGMENT
* 
GTID  JSB SPACE 
      LDA P14 
      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
      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 GTPAR 
* 
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 
* 
*     GET PARTITION SIZE
* 
GTPAR JSB SPACE 
      LDA P14 
      LDB MES44     # OF PARTITIONS?
      JSB DRKEY 
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA PA
      RSS 
      JMP PA10
      JSB NAMRR 
      SSA 
      JMP PA10
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3        GET TYPE
      LDA A,I 
      CPA P1        IS IT NUMERIC?
      RSS           YES 
      JMP PA10      NO , ERORR
      LDA IPBUF 
      LDB A 
      ADB N256      LESS THAN 256?
      SSB           NO , ERROR
      JMP POK 
PA10  LDA P8
      JSB LDRER 
      CLA 
POK   STA PARTN 
      STA B 
      LDA D#MAT 
      JSB FSYMB     FIND & PATCH $MAT#
      JSB MSENT 
* 
      LDB LOCC
      LDA D$MAT 
      JSB FSYMB     FIND & PATCH $MATA
      JSB MSENT 
* 
      LDA PARTN 
      MPY P6
      ADA LOCC
      STA LOCC
      JMP GTCD
* 
D#MAT DEF $MAT# 
$MAT# ASC 3,$MAT# 
* 
D$MAT DEF $MATA 
$MATA ASC 3,$MATA 
* 
      SKP 
*     GET # OF DISC LU
* 
GTCD  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 GTSAM 
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 B         YES 
      ADB N64 
      SSB,RSS       LESS THAN 64? 
      JMP CDERR     NO , ERROR
      STA #DLU      YES 
      STA B 
      LDA D$CD#     FIND & PATCH $CD# 
      JSB FSYMB 
      JSB MSENT 
* 
      LDB LOCC
      LDA D$CDA 
      JSB FSYMB     FIND & PATCH $CDA 
      JSB MSENT 
* 
      LDA #DLU      # OF DISC CRN 
      MPY P4
      ADA LOCC
      INA 
      STA LOCC
* 
      JMP GTSAM     GET SAM 
* 
* 
D$CD# DEF $CD#
$CD#  ASC 3,$CD#
* 
D$CDA DEF $CDA
$CDA  ASC 3,$CDA
* 
      SKP 
* 
MES43 DEF *+1 
      ASC 8,* SYS AVAIL MEM?
* 
D$SAM DEF $SAM
$SAM  ASC 3,$SAM
* 
D$SM# DEF $SAM# 
$SAM# ASC 3,$SAM# 
* 
MES44 DEF *+1 
      ASC 8,* PARTITIONS? 
* 
* 
*     GET # OF WORD FOR SAM 
* 
GTSAM JSB SPACE 
      LDA P16 
      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
      STB TLOCC     SAVE LOCC TEMPORARY 
      JSB FSYMB     FIND & PATCH ADDRESS OF $SAM
      JSB MSENT     MISSING SYSTEM ENT POINT
      CLO           CLEAR OVERFLOW REG. 
      LDA NMSAM     GET # OF SAM
      ADA LOCC
      SOS           SKIP IF OVERFLOW IS SET 
      JMP SAM30 
      LDA P5        PRINT MEM OVERFLOW
      JSB LDRER 
      LDA B7777 
      JMP SAM40 
SAM30 STA LOCC
* 
      AND M2000 
      CPA LOCC
      RSS 
      ADA B2000 
SAM40 STA LOCC
      LDB TLOCC     START OF SAM
      CMB,INB 
      ADB LOCC
      STB ZTEM5 
      LDA D$SM# 
      JSB FSYMB     FIND & PATCH $SAM#
      JSB MSENT 
* 
      JSB CNUMD     CONVERT TO ASCII
      DEF *+3 
      DEF ZTEM5 
      DEF M52A
* 
      JSB CNUMO 
      DEF *+3 
      DEF TLOCC 
      DEF M52B
* 
      JSB SPACE 
      LDA P42 
      LDB MES52 
      JSB DRKEY     PRINT # AND ADDRESS OF SAM
* 
      JMP GTBGP 
* 
MES52 DEF *+1 
      ASC 1,* 
M52A BSS 3
      ASC 13, WORDS OF SAM STARTING AT
M52B  BSS 3 
      ASC 1,B 
* 
* 
      SKP 
* 
* 
*     GET THE BACKGROUND SWAP PRIORITY
* 
GTBGP JSB SPACE 
      LDA P22 
      LDB MES48     BACKGROUND SWAP PRIORITY? 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA BG
      JMP GLSW
SWERR LDA P7
      JSB LDRER 
      LDB P30       USE DEFAULT OF 30 
      JMP GLSW0 
GLSW  JSB NAMRR 
      SSA           END?
      JMP SWERR     YES , USE DEFAULT 
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      CPA P1        IS IT NUMERIC?
      RSS           YES 
      JMP SWERR     NO , ERROR
      LDB IPBUF 
      SSB           POSTIVE?
      JMP SWERR     NO , ERROR
GLSW0 LDA D$BGP 
      JSB FSYMB     FIND & PATCH $BGPR
      JSB MSENT 
      JMP QUANT 
* 
D$BGP DEF $BGPR 
$BGPR ASC 3,$BGPR 
* 
      SKP 
* 
*     GET THE QUANTUM TIME SLICE
* 
QUANT JSB SPACE 
      LDA P32 
      LDB MES50     * QUANT PR'S? 
      JSB DRKEY 
      JSB BUFC
      JSB READ
      JMP EXIT
      LDA OP? 
      CPA QU
      JMP GSS 
QUERR LDA P6
      JSB LDRER 
      JMP GSS30 
GSS   JSB NAMRR 
      SSA 
      JMP QUERR     END OF INPUT , USE DEFAULT
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      SZA,RSS       NULL? 
      JMP GSS10     YES , USE DEFAULT 
      CPA P1        NO , NUMERIC? 
      RSS           YES 
      JMP QUERR     NO , ERROR
      LDA IPBUF 
      SSA           POSTIVE?
      JMP QUERR     NO , ERROR
      STA TSQU
GSS10 JSB NAMRR 
      SSA 
      JMP QUERR     END OF INPUT , USE DEFAULT
      LDA DIPBF     GET IPBUF ADDRESS 
      ADA P3
      LDA A,I       GET TYPE
      SZA,RSS       NULL? 
      JMP GSS30     YES , USE DEFAULT 
      CPA P1        NO , NUMERIC? 
      RSS           YES 
      JMP QUERR     NO , ERROR
      LDA IPBUF 
      SSA           POSITIVE? 
      JMP QUERR     NO , ERROR
      STA TSPR
      JSB SPACE 
* 
GSS30 CLB 
      LDA TSQU
      DIV P10       DIVIDE BY 10
      CMA,INA       AND NEGATE
      STA B 
      LDA D$TSQ 
      JSB FSYMB     FIND & PATCH $TSQU
      JSB MSENT 
* 
      LDB TSPR
      LDA D$TSP 
      JSB FSYMB     FIND & PATCH $TSPR
      JSB MSENT 
* 
      LDA CBP.L     REAL CURRENT BASE PAGE
      INA 
      STA TCBPL     TEMPORY CURRENT BASE PAGE 
      LDB A         GET CURRENT BASE PAGE 
      ADB LDBP      ADD LOWER DUMMY BP
EN100 STB TSDBP     DUMMY BP LOCATION 
      LDA B,I       GET VALUE 
      LDB TCBPL 
      JSB STCR1     OUTPUT
      LDA TCBPL 
      INA 
      STA TCBPL 
      LDB TSDBP 
      INB 
      CPB TDBP
      RSS 
      JMP EN100 
      LDA P3
      STA SEGNM 
* 
* 
      LDA LOCC
      AND M2000 
      CPA LOCC
      RSS 
      ADA B2000 
      SSA           MAX SIZE 100000?
      ADA N1        YES ,SUBTRACT 1 TO GET 32767
      STA LOCC      LENGTH OF SYSTEM ONLY 
      STA SLOCC     SAVE SYSTEM LOCC
* 
      CLB 
      LDA LOCC
      CPA B7777 
      JMP P32K
      DIV P128
      RSS 
P32K  LDA P256
      ADA N8
      STA RECOF     THIS IS THE NEXT REC # AFTER THE SYSTEM REC 
* 
      JSB SPACE 
      LDA P14 
      STA CONSL 
      LDB MES51 
      JSB DRKEY     PRINT ' SYSTEM COMMON RELOCATION '
      JSB SPACE 
* 
      SKP 
* 
*     ZAP OUT THE TYPE 6 AND TYPE 7 SYMBOLS IN
*     THE SYMBOL TABLE SO THAT SYSTEM COMMON MODULES
*     CAN NOT REFERENCE THEM .  THIS IS DONE BY 
*     SETTING THE PARITY ( BIT 7 OF THE WORD ) BIT OF 
*     THE 2ND CHARACTER OF THE SYMBOL 
* 
      CLA 
      STA PNTR
      STA CNT10 
* 
      LDA P3
      STA L.BUF+0 
GSYEN JSB L.LDF     GET A SYSTEM ENTRY
      DEF *+4 
      DEF ADDR
      DEF PNTR
      DEF P1        GIVE ME ALL OF THEM 
      LDA ADDR
      SZA,RSS 
      JMP ESYEN     END OF SYMBOL TABLE 
      STA ADDRX 
      STA B 
      LDA B,I 
      AND B7777     MASK OUT PRINT IT BIT 
      STA B,I 
      ADB P3        POINT TO WORD 4 OF SYMBOL 
      LDA B,I       LOAD WORD 4 AND CHECK 
      AND B40        TO SEE IF SHOULD BE EXCLUDED FROM SNAP 
      SZA,RSS 
      JMP GSYEN     NO
      ADB N3        POINT BACK TO WORD 1
      LDA B,I 
      IOR B200
      STA B,I 
      JMP GSYEN 
* 
      SKP 
* 
*     RESET LOCC , BLOCC , & DUM BP 
* 
ESYEN LDA B2000 
      STA LOCC
* 
      LDA B1777 
      STA CBP.L 
* 
      LDA TDBP
      STA CSDBP 
* 
      LDA LDBP
      STA CUDBP 
* 
      CLA 
      STA BPFWA 
* 
      CCA 
      STA INL.L     FORCE JSB EXTERNAL TO USE INDIRECT LINK 
* 
* 
* 
*     ENTER .ZPRV INTO SYM TBL AS UNDEFINED 
* 
      JSB L.SYE 
      DEF *+6 
      DEF .ZPRV 
      DEF P2
      DEF VALUA 
      DEF N1        OVERRIDE CURRENT DEFINITION 
      DEF RESLT 
* 
*     ENTER .ZRNT INTO SYM TBL AS UNDEFINED 
* 
      JSB L.SYE 
      DEF *+6 
      DEF .ZRNT 
      DEF P2
      DEF VALUA 
      DEF N1        OVERRIDE CURRENT DEFINITION 
      DEF RESLT 
* 
      JSB EXEC
      DEF *+3 
      DEF P8
      DEF SEG2
* 
      SKP 
* 
SEG2  ASC 3,L20G2 
* 
* 
.ZPRV ASC 3,.ZPRV 
* 
.ZRNT ASC 3,.ZRNT 
* 
* 
* 
D$TSQ DEF $TSQU 
$TSQU ASC 3,$TSQU 
* 
D$TSP DEF $TSPR 
$TSPR ASC 3,$TSPR 
* 
* 
MES46 DEF *+1 
      ASC 8,* DISC LU'S 
* 
MES48 DEF *+1 
      ASC 11,* BACKGROUND PRIORITY? 
* 
MES50 DEF *+1 
      ASC 16,* TIME SLICE QUANTUM , PRIORITY? 
* 
MES51 DEF *+1 
      ASC 7,* SYS COM REL 
      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,OV MEM  OVERFLOW MEMORY 
      ASC 3,TS/PR   TIME SLICE OR PRIORITY ERROR
      ASC 3,BG SWP  BACKGND SWAP PRIORITY ERROR 
      ASC 3,PA ERR  PARITITION SPECIFICATION ERROR
      ASC 3,CLS ER  CLASS SPECIFICATION ERROR 
      ASC 3,RSN ER  RESOURCE # SPECICATION 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 
ADDR  NOP 
      NOP 
      NOP 
ADDRX NOP 
CNT10 NOP 
NMSAM NOP 
PNTR  NOP 
TCBPL NOP 
TLOCC NOP 
TSIZE NOP 
TSDBP NOP 
TSPR  DEC 50
TSQU  DEC 1000
ZTEM5 NOP 
* 
*     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 
P9    DEC 9 
P10   DEC 10
P12   DEC 12
P14   DEC 14
P16   DEC 16
P20   DEC 20
P22   DEC 22
P30   DEC 30
P32   DEC 32
P42   DEC 42
P128  DEC 128 
P256  DEC 256 
* 
N1    DEC -1
N3    DEC -3
N8    DEC -8
N40   DEC -40 
N64   DEC -64 
N255  DEC -255
N256  DEC -256
* 
B40   OCT 40
B200  OCT 200 
B1777 OCT 1777
B2000 OCT 2000
B7777 OCT 77777 
* 
M2000 OCT -2000 
* 
BG    ASC 1,BG
CD    ASC 1,CD
CL    ASC 1,CL
ID    ASC 1,ID
PA    ASC 1,PA
QU    ASC 1,QU
RE    ASC 1,RE
SA    ASC 1,SA
      SKP 
*      BASE PAGE COMMUNICATION VALUES 
* 
A     EQU 0 
B     EQU 1 
* 
* 
      BSS 0         SIZE OF GENERATOR 
      SPC 3 
      END L20G4 
                                                                                                                                                          