ASMB,R,L,C     RTRLC
*     NAME:   RTRLC 
*     SOURCE: 91740-18054 
*     RELOC:  91740-16054 
*     PGMR:   MIKE SCHOENDORF 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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-M SYSTEM GENERATOR-LOADER 
      NAM RTRLC,8 91740-16054 REV 1826 780421 
* 
*   ENTRY POINT NAMES 
* 
      ENT ABL1,ABL2,.ABR,AB#RT,ABRC1,ABREC
      ENT ABRT1,ADDRS,ADTRP,AFILE,AL,ATABL,ATBUF,ATTBL
      ENT BAKUP,BLINE,BPAG4,BPAGA,BPLOC,BU#ER 
      ENT CFILE,CKS 
      ENT CLBPL,CLFL2,CLFL3,CLFL4 
      ENT CLFL5,CLFL6 
      ENT CMDLU,CMER,CNT,COML,COMOR 
      ENT CONSL,CONSO,CONV,CPAGE
      ENT CRTIN,DBTAD,DCB1
      ENT DCB2,DCB3,DCB4,DCB5,DCB6,DCB7 
      ENT DIAG,DIAG2,ECFIL,ECHO1,ECHOS,EFILE,EKHOS
      ENT EMSAM,ERACT,ERDVC,ERREX,ER#OR,EXEC0,EXEC6 
      ENT FFLAG,FL1OP,FRTRU,FT#ME 
      ENT FUT1,FUT2,FUT3,FUT4,FUTA,FUTI 
      ENT FUTP,FUTS,FWABP,FWAC,FWAM,GLWAM 
      ENT ICR,IDCB,IERR#,IFILE,IL,INACT,IN#CK,IOPTN 
      ENT ISECU,JLU,JMPNO 
      ENT KONSO,KTABL,LBF10,LBUF5,LBUF#,LBUFA 
      ENT LDGEN,LDSEG,LDSG3,LENGT,LER3,LER5 
      ENT LFILE,LGER2,LIBFL,LINTP 
      ENT LIST,LISTO,LITBL,LNKDR,LOCFS
      ENT LST1,LST2,LST3,LST4,LST5
      ENT LST,LSTA,LSTI,LSTM,LSTP 
      ENT LSTPX,LSTUL,LTABL,LWABP,LWAC,LWAM 
      ENT MAPON,MAPS,.MEM.,.MEM1
      ENT .MEM2,.MEM3,.MEM4,.MEM5,.MEM6 
      ENT MEMRY,MESSI,MLOCC,MOVEX,MTABL 
      ENT NAMR.,NBUF,NBUF6,NBUFA,NBUFT
      ENT NCHAR,NSCAN,NXTC,NXTC2,NXTCM
      ENT OFILE,ONTBL,OPEN1 
      ENT OPFLA,OPFLB,OPFLC,OPFLD 
      ENT OPFLE,OPFLF,OPFLG,OPFLH 
      ENT OPNLU,OPT.3,OTFIL,OTMES 
      ENT OUTON,PACK#,PLK 
      ENT PLK1,PLK4,PLKS,PRCMD
      ENT PRINT,PUNCH,QBUFA,QGETC,QQCNT 
      ENT QQPTR,RBTA,RBTO,RDFL1,READ#,RIC 
      ENT SCAN,SCP,SEGFL,SERFG,SERNM
      ENT SNAPS,SSTBL,STABL 
      ENT STFER,SYMOV,TBUF#,TIMES,TOTBL,TRANS,TRUNC 
      ENT TYOFF,TYPRO,UEXFL,UNDEF,WERR1 
      ENT WRTBT,WRTFL,?XFER,XNAM,XNAMA
      ENT ZPRIV,ZRENT 
* 
*   EXTERNAL REFERENCE NAMES
      EXT PNAMA 
* 
      EXT RTML2,RTML4 
* 
      EXT CLOSE,DTTY,EXEC,FCONT,IMESS 
      EXT LIMEM,LOCF,READF,SG#LD,WRITF
      EXT IDCB1,IDCB2,IDCB3,IDCB4,IDCB5,IDCB6,IDCB7 
* 
      EXT $OPSY,PARSE 
      EXT CNUMD,LURQ
* 
A     EQU 0 
B     EQU 1 
      SUP 
************************************************************************
* 
*  THIS MODULE CONTAINS ALL THE COMMON ROUTINES AND 
*  STORAGE NEEDED BY THE LOADER MAIN AND/OR ANY 2 
*  OF THE LOADER SEGMENTS. IT CONTAINS THE MAIN ENTRY 
*  POINT FOR PROCESSING ALL LOADER COMMANDS (PRCMD).
*  THIS MODULE IS CALLED AS IF IT WERE A SUBROUTINE 
*  WITH NO PARAMETERS AND TWO RETURNS. THE (P+1)
*  RETURN IS USED FOR ABNORMAL TERMINATION CONDITIONS,
*  WHILE THE (P+2) RETURN IS USED FOR NORMAL RETURNS
*  VIA THE END COMMAND. THE CALLING SEQUENCE IS AS FOLLOWS: 
* 
*     JSB PRCMD 
*      RETURN1       RELOCATION ABORTED RETURN
*     RETURN2       NORMAL RETURN 
* 
********************************************************************
      HED  RTM LOADER UTILITY SUBROUTINES 
***** 
***** 
* 
** PRCMD ** MAIN ENTRY POINT FOR THE SUBORDINATE CONTROL MODULE.
*           CONTROL IS PASSED TO TYMOD OR NXTCM TO GET THE NEXT 
*           COMMAND.  THAT COMMAND IS PARSED, AND CONTROL IS PASSED 
*           TO ITS ASSOCIATED PROCESSING ROUTINE.  IF A FATAL ERROR 
*           IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING 
*           PRCMD AT (P+1).  THE ONLY OTHER EXIT IS VIA THE END 
*           COMMAND (P+2).  AFTER PROCESSING ANY OTHER COMMAND, 
*           CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. 
* 
***** 
PRCMD NOP           PROCESS RTM LOADER COMMANDS 
NXTCM JSB CMDIN     GET NEXT COMMAND LINE 
NXTC2 LDA CTACN 
      LDB CTABL 
      JSB SCAN      SCAN 1ST ELEMENT FOR MATCH
      JMP CMER      COMMAND ERROR.
      STA JMPNO     SAVE WHERE TO JMP TO
      ADA M14 
      SSA,RSS 
      JMP LOAD4 
      CLA,INA 
      JSB SGLD1     DETERMINE IF SEG IS RELOADED
      CLA 
      JMP LDSEG     LOAD IN LOADER SEGMENT 2
* 
LOAD4 LDA B2
      JSB SGLD1     DETERMINE IF SEGMENT IS RELOADED
      LDA D15 
      JMP LDSEG 
***** 
*     CONTROL COMES HERE ON DETECTING A COMMAND ERROR. THE MESSAGE
*     'CMND?' IS OUTPUT.
***** 
CMER  LDB CMND?     OUTPUT CMND? MESSAGE
      JSB DIAG2 
      JMP EXEC0 
* 
CMND? DEF *+1 
      OCT 5 
      ASC 3,CMND? 
* 
JMPNO NOP           WHERE GO FLAG 
* 
D15   DEC 15
M14   DEC -14 
* 
SGLD1 NOP 
      LDB SEGFL 
      SZB,RSS 
      JMP SGLD1,I   GO LOAD SEGMENT 
      CPB 0 
      RSS 
      JMP SGLD1,I   NEED OTHER SEGMENT
      CPB B1
      JMP RTML2     NEED SEGMENT 2
      JMP RTML4     NEED SEGMENT 4
* 
SEGFL NOP           LAST SEGMENT FLAG 
      HED RTM LOADER TABLES 
***** 
* 
*     COMMAND MNEMONIC TABLE
* 
*   BITS  15-8   # CHARS IN ASCII KEYWORD TABLE 
*   BITS   7-0   OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) 
* 
*     THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE 
*     OFFSET ASSOCIATED WITH KEYWORDS.  THUS ORDER IN THIS TABLE IS 
*     OF PARAMOUNT IMPORTANCE.  IF ANY KEYWORD IS EXACTLY THE SAME
*     AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST 
*     APPEAR FIRST. (FOR EXAMPLE TRANSFER APPEARS BEFORE TR)
* 
***** 
CTACN ABS CTABS-CTABN  NEG NBR ENTRIES IN TABLE 
CTABL DEF CTABS 
CTABS ABS 3000B+ABOUD-CMTBL   BOUNDS
      ABS 1400B+AMAP-CMTBL    MAP 
      ABS 4000B+ARELC-CMTBL   RELOCATE
      ABS 1400B+AREL-CMTBL    ABBR. OF RELOCATE 
      ABS 3000B+ASEAR-CMTBL   SEARCH
      ABS 3000B+AOTPU-CMTBL   OUTPUT
      ABS 4000B+ATRAN-CMTBL   TRANSFER
      ABS 1000B+ATR..-CMTBL   ABBR. OF TRANSFER 
      ABS 1400B+ASET.-CMTBL   SET 
      ABS 4000B+ALKIN-CMTBL   LINKS IN
      ABS 2400B+ALINK-CMTBL   LINKS 
      ABS 1000B+AEXIT-CMTBL   EXIT
      ABS 2000B+AECHO-CMTBL   ECHO
      ABS 3400B+ADISP-CMTBL   DISPLAY 
      ABS 2000B+ASNAP-CMTBL   SNAP
      ABS 1400B+AEND.-CMTBL   END 
      ABS 1000B+AMONT-CMTBL   MOUNT 
      ABS 1000B+ADMNT-CMTBL   DISMOUNT
CTABN EQU * 
KTABS ABS 2400B+AFWAB-CMTBL  FWABP
      ABS 2400B+ALWAB-CMTBL  LWABP
      ABS 2000B+AFWAM-CMTBL  FWAM 
      ABS 2000B+ALWAM-CMTBL  LWAM 
      ABS 2000B+AFWAC-CMTBL  FWAC 
      ABS 2000B+ALWAC-CMTBL  LWAC 
LTABS ABS 2000B+ALOCC-CMTBL  LOCC 
      ABS 3000B+ABPLC-CMTBL   BPLOCC
      ABS 2400B+AXFER-CMTBL   .XFER 
      ABS 2400B+ATBLE-CMTBL  TABLE
      ABS 3000B+AUNDE-CMTBL   UNDEFS
MTABS ABS 3400B+AMODS-CMTBL  MODULES
      ABS 3400B+AGLOS-CMTBL   GLOBALS 
      ABS 2400B+ALINK-CMTBL   LINKS 
      ABS 1400B+AOFF.-CMTBL   OFF 
      ABS 1000B+AON..-CMTBL   ON
ATABS ABS 1400B+AYES.-CMTBL  YES
      ABS 1000B+ANO..-CMTBL   NO
TSTRT ABS 2400B+ASTRT-CMTBL  START
TAT   ABS 1000B+AAT..-CMTBL  AT 
TTO   ABS 1000B+ATO..-CMTBL  TO 
LIABS ABS 2000B+ABASE-CMTBL BASE
      ABS 3400B+ACURT-CMTBL CURRENT 
ONABS ABS 1000B+AON..-CMTBL ON
      ABS 1400B+AOFF.-CMTBL OFF 
STABL DEF TSTRT 
ATTBL DEF TAT 
TOTBL DEF TTO 
LTABL DEF LTABS 
KTABL DEF KTABS 
MTABL DEF MTABS 
ATABL DEF ATABS 
LITBL DEF LIABS 
ONTBL DEF ONABS 
AMONT ASC 1,MC
ADMNT ASC 1,DC
      SKP 
***** 
*     ASCII KEYWORD TABLE 
*  ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE 
***** 
CMTBL DEF * 
ABOUD ASC 3,BOUNDS
AMAP  ASC 2,MAP 
ARELC ASC 4,RELOCATE
AREL  ASC 2,REL 
ASEAR ASC 3,SEARCH
AOTPU ASC 3,OUTPUT
ADISP ASC 4,DISPLAY 
ATBLE ASC 3,TABLE 
AUNDE ASC 3,UNDEFS
AMODS ASC 4,MODULES 
AGLOS ASC 4,GLOBALS 
ALKIN ASC 4,LINKS IN
ALINK ASC 3,LINKS 
ASNAP ASC 2,SNAP
AEXIT ASC 1,EX
AECHO ASC 2,ECHO
AON.. ASC 1,ON
AOFF. ASC 2,OFF 
ATRAN ASC 4,TRANSFER
ATR.. ASC 1,TR
AEND. ASC 2,END 
AFWAM ASC 2,FWAM
ALWAM ASC 2,LWAM
AFWAB ASC 3,FWABP 
ALWAB ASC 3,LWABP 
AFWAC ASC 2,FWAC
ALWAC ASC 2,LWAC
ALOCC ASC 2,LOCC
ABPLC ASC 3,BPLOCC
AXFER ASC 3,?XFER 
AYES. ASC 2,YES 
ANO.. ASC 1,NO
ASTRT ASC 3,START 
AAT.. ASC 1,AT
ASET. ASC 2,SET 
ATO.. ASC 1,TO
ABASE ASC 2,BASE
ACURT ASC 4,CURRENT 
* 
      SKP 
      HED   INPUT COMMAND LINE
***** 
* 
** CMDIN ** INPUT NEXT COMMAND LINE 
* CALLING SEQUENCE: 
* 
*     JSB CMDIN 
*     RETURN
* 
* NOTE: CMDIN SKIPS COMMENTS AND ADVANCES INPUT BUFFER
*       POINTERS PAST THE '-' IF IT APPEARS IN THE INPUT BUFFER.
* 
*       THE IDENTIFIER CMDLU IS USED TO DETERMINE IF THE INPUT IS 
*       COMING FROM THE SESSION CONSOLE (=4) OR TRANSFER FILE (=1). 
*       THE IDENTIFIER ECHO1 IS USED TO DETERMINE IF THE INPUT
*       SHOULD BE ECHO'ED TO THE LIST DEVICE (0=NO ECHO, 1=ECHO). 
* 
* 
*      RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED
* 
***** 
CMDIN NOP 
      CLA           RESET INCOMING CHARACTER
      STA QQCNT         POINTERS
      LDA QBUFA 
      STA QQPTR 
      LDA CMDLU     INPUT COMMAND DEVICE-FILE?
      CPA B4
      RSS 
      JMP CMD5      NO, MUST BE TRANSFER FILE 
      LDA CONSO     GET INPUT FROM SESSION CONSOLE? 
      SZA 
      JMP CMD3      YES 
CMD1  LDB PRPTA 
      JSB DIAG      SEND PROMPT TO ERROR-PROMPT LOG 
CMD6  LDB QBUFA     INPUT BUFFER
      LDA CMDLU 
      CPA B1        TRANSFER FILE?
      JMP RDRIN     YES, READ IT
      LDA DCB1      DATA CONTROL BLOCK
      JSB RDFL1     READ FROM INPUT DEVICE-FILE 
      CPA M1        END OF FILE?
      JMP CMD4      YES, GET INPUT FROM SESSION CONSOLE 
CMD2  STA QQCHC     SAVE # OF CHARACTERS READ 
      LDB QBUFA          AND BUFFER ADDRESS 
      JSB EKHOS     TRY WRITING ON MAP OR ECHO FILE 
      LDA QBUFA,I     GET 1ST CHARACTER.
      ALF,ALF 
      AND B177
      CPA B52       COMMENT?
      JMP CMDIN+1   YES, GET NEXT COMMAND 
      CPA B55       IS COMMAND ID SUPPLIED? 
      ISZ QQCNT     YES--BUMP CHAR. POINTER 
      JMP CMDIN,I 
RDRIN LDA DCB6      DATA CONTROL BLOCK ADDRESS
      JSB RDFL6     GO READ FILE
      CPA M1        FINISHED? 
      RSS 
      JMP CMD2      NO
      LDA B4        YES, TRANSFER INPUT TO COMMAND
      STA CMDLU     DEVICE-FILE 
      JSB CLFL6     CLOSE TRANSFER FILE 
      JMP CMDIN+1 
* 
CMD4  CLA,INA 
      STA CONSO 
      STA KONSO 
CMD3  LDB PRPTA     PROMPT
      JSB OTMES     GET RESPONSE
      JMP CMDIN,I 
* 
CMD5  LDA DCB6      GET TRANSFER FILE DCB 
      JSB INDCK 
      ADA B2
      LDA 0,I       TYPE 0 FILE?
      SZA 
      JMP CMD6      NO, DON'T ISSUE PROMPT
      LDA DCB6
      JSB INDCK 
      JSB LOCFS     GET LOGICAL UNIT OF FILE
      SSA 
      JMP LGER2     LU ERROR
      LDA JLU       GET LOGICAL UNIT
      JSB DTTY      SEE IF INTERACTIVE
      SZA 
      JMP CMD7      YES 
      LDA CONSO     SWITCH TO SESSION CONSOLE?
      SZA 
      JMP CMD7      YES 
      LDA INACT     INTERACTIVE INPUT?
      SZA,RSS 
      JMP CMD6      NO
CMD7  LDB PRPTA     YES 
      JSB DIAG2 
      JMP CMD6
* 
LGER2 LDA LU
      CLB           NO FMP ERROR
      JSB STFER     OUTPUT ERROR TO SYSTEM CONSOLE
      JMP ABRT1     TERMINATE LOADER EXECUTION
* 
LU    ASC 1,LU
* 
CONSO NOP 
* 
B1    OCT 1 
B4    OCT 4 
B52   OCT 52        COMMENT CHARACTER 
B55   OCT 55
CMDLU OCT 4 
M1    DEC -1
      SKP 
ADTRP NOP           TRAP ADDRESS
AFILE NOP           ADDRESS OF FILE NAME ARRAY
COML  NOP           HOLDS INITIAL COMMON LENGTH 
DBTAD NOP           DEBUG TRANSFER ADDRESS
ERACT NOP           ERROR LOG INTERACTIVE FLAG
FTIME NOP           OUTPUT TYOFF RECORD ONLY AT START 
IDCB  NOP           DATA CONTROL BLOCK
KONSO NOP           END OF INPUT FILE FLAG
LDSG3 NOP           WHICH ENTRY IN SEGMENT 3
LIBFL NOP           SEARCH FLAG 
LINTP NOP           LINKS IN FLAG (SET TO BASE) 
LISTO NOP           INITIALIZE MAP OUTPUT 
LSTUL NOP           UPPER LIMIT OF LST
OPEN1 NOP           COMMAND FILE OPEN BIT 
OPFLA OCT 410       OPTION WORD FOR COMMAND INPUT 
OPFLB OCT 110       OPTION WORD FOR ABSOLUTE OUTPUT 
OPFLC OCT 310       OPTION WORD FOR REL/SEARCH
OPFLD OCT 210       OPTION WORD FOR MAP 
OPFLE OCT 210       OPTION WORD FOR ECHO
OPFLF OCT 410       OPTION WORD FOR TRANSFER
OPFLG OCT 210       OPTION WORD FOR SNAP/DISPLAY
OPFLH OCT 210       OPTION WORD FOR ERROR/PROMPT
OTFIL NOP           ADDRESS OF FILE NAME ARRAY
RIC   NOP           HOLDS RECORD IDENTIFICATION CODE
SCP   NOP           SSGA/SYSTEM COMMON/PARTITION
SERFG NOP           LIBRARY LOAD FLAG 
SERNM NOP           THIS IS THE MOD IN SEARCH (NAME) (FLAG) 
TYPRO NOP           PROGRAM TYPE FLAG 
WRTBT NOP           NO RELOCATION YET 
?XFER NOP           "HAVE MAIN FLAG"
XNAM  BSS 3         MODULE NAME 
ZPRIV NOP           LST ADDRESS OF .ZPRV
ZRENT NOP           LST ADDRESS OF .ZRNT
* 
ATBUF DEF TBUF
TBUF  BSS 5 
NBUF6 DEF NBUF+6
NBUFT DEF NBUF+20 
XNAMA DEF XNAM
* 
TBUF# EQU TBUF
FT#ME EQU FTIME 
      SKP 
* 
*  SUBROUTINE TO PROCESS TIME PARAMETERS FOR ID SEGMENT 
* 
TIMES NOP 
      LDA D12       GET THE SECONDS 
      JSB ADRES 
      MPY P100      CONVERT TO 10'S OF MS 
      STA TEMP1 
      LDA D13 
      JSB ADRES 
      ADA TEMP1     ADD 10'S OF MS
      STA OCTNO     SAVE TEMP 
      LDA D10       GET THE HOURS 
      JSB ADRES 
      MPY P60       CONVERT TO MINUTES
      STA TEMP1 
      LDA D11 
      JSB ADRES 
      ADA TEMP1     ADD MINUTES 
      MPY P6000     CONVERT TO 10'S OF MS 
      CLE           PREPARE FOR ADD 
      ADA OCTNO     ADD 10'S OF MS
      SEZ,CLE       IF OVERFLOW 
      INB           STEP HIGH ORDER PART
      ADA NDAY+1    SUBTRACT ONE DAY OF 10'S OF MS
      SEZ,CLE       IF OVERFLOW 
      INB           STEP HIGH ORDER DIGIT 
      ADB NDAY
      JMP TIMES,I 
* 
D10   DEC 10
D11   DEC 11
D12   DEC 12
D13   DEC 13
P60   DEC 60
P100  DEC 100 
P6000 DEC 6000
NDAY  OCT 177574,025000 
* 
OCTNO NOP 
TEMP1 NOP 
      SKP 
* 
*  SUBROUTINE TO GET VALUES FROM PNAMA TABLE
* 
ADRES NOP 
      ADA PNAMA 
      LDA 0,I 
      JMP ADRES,I 
      SPC 5 
* 
*  SUBROUTINE TO OUTPUT 2-WORD TIE-OFF RECORDS
* 
TYOFF NOP 
      JSB PACK      WORD 1 FROM (A) 
      LDA B         WORD 2 FROM (B) 
      JSB PACK
      JSB PUNCH 
      JMP TYOFF,I 
* 
* 
* 
* 
* 
* 
LDSEG ADA LIST1     GET ADDRESS OF SEGMENT NAME 
      STA NAME
      JSB SG#LD     LOAD IN SEGMENT 
      DEF *+3       RETURN ADDRESS (ONLY FOR ERROR) 
      DEF NAME,I    SEGMENT NAME
      DEF IERR      ERROR CODE
      LDA SG
      LDB IERR      ERROR CODE
      JSB ERROR     SEGMENTATION ERROR
      JMP ABRT1     ABORT 
* 
NAME  NOP 
* 
SG    ASC 1,SG
* 
LIST1 DEF *+2 
LIST  DEC 6 
      ASC 3,RTML2 
      ASC 3,RTML3 
      ASC 3,RTMG1 
      ASC 3,RTMG2 
      ASC 3,RTML1 
      ASC 3,RTML4 
      SKP 
* 
*  SUBROUTINE TO DETERMINE IF INPUT IS LU AND SETUP DCB IF IT IS. 
* 
OPNLU NOP 
      LDB $OPSY     GET TYPE OF OPERATING SYSTEM
      CPB M7        RTE-MI? 
      JMP OPNLU,I   YES 
      CPB M15       RTE-MII 
      JMP OPNLU,I 
      CPB M5        RTE-MIII
      JMP OPNLU,I   YES 
      LDA AFILE     DETERMINE IF OUTPUT IS TO LU
      LDB 0,I 
      CPB LU
      RSS 
      JMP OPNLU,I 
      INA 
      LDB 0,I 
      CPB ..
      RSS 
      JMP OPNLU,I 
      ISZ OPNLU 
      INA           MUST BE LU, GO GET IT 
      LDB 0,I 
      STB BUFA1 
      LDB BLANK 
      STB BUFA1+1 
      STB BUFA1+2 
      JSB PARSE 
      DEF *+4 
      DEF BUFA1 
      DEF B6
      DEF RBUF
      LDA RBUF+1    GET LU
      STA LU# 
      JSB DTTY      LU INTERACTIVE ?
      SZA           NO , LOCK IT
      JMP OPNL5     YES , DON'T LOCK IT 
      JSB LURQ      LOCK LU 
      DEF *+4 
      DEF B1401 
      DEF LU# 
      DEF B1
      JMP LUERR 
OPNL5 LDA IOPTN           OPEN OPTION 
      AND B3700 
      STA 1 
      LDA IDCB      GET ADDRESS OF DCB
      JSB INDCK 
      JSB TYP0      OPEN DCB
      JMP OPNLU,I 
* 
LUERR LDB 0 
      LDA LU
      JSB ERROR 
      JMP CONSL     TRY AGAIN 
* 
LU#   NOP 
..    ASC 1,..
B1401 OCT 140001
B3700 OCT 3700
M5    DEC -5
M7    DEC -7
M15   DEC -15 
* 
BUFA1 BSS 3 
RBUF  BSS 33
* 
* 
*  SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE 
*  CALLING SEQUENCE 
* 
*  LDA DCB ADDRESS
*  LDB SUBFUNCTION
*  JSB TYP0 
*  RETURN 
* 
* 
TYP0  NOP 
      STA T0DCB 
      LDA LU#       GET LU
      SZA,RSS       IF NOT DEFINED
      INA           DEFINE AS LU = 1
      STA LU# 
      CLA 
      JSB SET       SET DIRECTORY 
      JSB SET       ADDRESS TO ZERO 
      JSB SET       ALSO SET TYPE TO 0
      LDA LU#       GET LOGICAL UNIT
      IOR 1         MERGE IN SUBFUNCTION
      JSB SET       AND SET IN DCB
      JSB EXEC      GET DRIVER TYPE 
      DEF *+4 
      DEF D13 
      DEF LU# 
      DEF EQT5
      LDA EQT5      GET TYPE
      ALF,ALF       ROTATE TO LOW A 
      AND B77       AND MASK
      CPA B5        IF MASK TYPE-CODE IS <05>,
      JSB TYPE5     THEN GO EXAMINE THE SUBCHANNEL. 
      STA EQT5      SAVE THE EQUIPMENT TYPE-CODE. 
      LDB B100      GET EOF CONTROL SUBFUNCTION 
      ADA MD17      IF TYPE > 16
      SSA,RSS 
      JMP SEOF      SET EOF CODE
      LDB B1000 
      LDA EQT5
      CPA B2        IS DRIVER A PUNCH?
      JMP SEOF      GO SET LEADER GENERATION
      CLB 
      SZA,RSS       IF TYPE = 0 DON'T DO PAGE EJECT 
      JMP SEOF
      LDB B1100     LINE SPACE OPTION 
SEOF  LDA LU#       GET LU
      IOR 1         MERGE EOF CONTROL SUBFUNCTION 
      JSB SET       SET IN DCB
      CLA 
      JSB SET       SET NO SPACING LEGAL
      LDA B1001     SET READ & WRITE LEGAL
      JSB SET       AND SECURITY CODES AGREE
      JSB SET       AND UPDATE MODES AGREE
      LDA 1717B     GET MY ID ADDRESS 
      ISZ T0DCB     INCREMENT TO WORD 9 
      JSB SET       SET OPEN FLAG 
      LDA T0DCB 
      ADA B3
      STA T0DCB     SET TO WORD 13
      CLA           SET IN MEMORY BUFFER FLAG 
      JSB SET       TO ZERO 
      INA 
      JSB SET       SET RECORD COUNT
      LDA EQT5      GET TYPE CODE 
      LDB T0DCB     GET DCB ADDRESS 
      ADB MD11      GET TO CONTROL FUNCTION LOCATION
      LDB 1,I       GET CONTROL WORD
      STB SET 
      ADA MD17      IF THE EQUIPMENT TYPE-CODE
      SSA,RSS       IS > 16 (MAG. TAPE, ETC.),
      JMP TYP0,I    THEN AVOID WRITING AN END OF FILE 
      JSB EXEC      DO A PAGE EJECT, OR GENERATE LEADER 
      DEF *+4 
      DEF B3
      DEF SET 
      DEF M1        FORCE A PAGE EJECT
      JMP TYP0,I
* 
SET   NOP 
      STA T0DCB,I   SET IN DCB
      ISZ T0DCB     INCREMENT TO NEXT WORD
      JMP SET,I 
* 
* 
T0DCB NOP 
EQT5  NOP 
MD11  DEC -11 
MD17  DEC -17 
B5    OCT 5 
B77   OCT 77
B1000 OCT 1000
B1001 OCT 100001
B1100 OCT 1100
DRT   EQU 1652B     ADDRESS OF DEVICE REFERENCE TABLE 
* 
* 
*  TYPE-CODE CONVERSION FOR DVR05 (26440 44) SUBCHANNEL SPECIFICATIONS. 
* 
* 
TYPE5 NOP 
      LDA LU#       GET THE LOGICAL UNIT
      ADA M1        SUBTRACT 1 FOR THE DRT INDEXING.
      ADA DRT       CALCULATE THE POSITION IN THE DRT.
      LDA 0,I       GET THE DRT ENTRY.
      ALF,RAL       POSITION THEW SUBCHANNEL TO BITS #4-0.
      AND B37       ISOLATE THE SUBCHANNEL. 
      STA 1 
      SZA,RSS       IF THE SUBCHANNEL IS ZERO, THEN RETURN
      JMP TYPE5,I   TO SIMULATE A TYPE <00> DEVICE. 
      LDA B23       PREPARE TO SIMULATE A TYPE <23> DEVICE. 
      CPB B4        IF THE SUBCHANNEL IS FOUR, THEN 
      LDA B12       SIMULATE A TYPE <12> DEVICE.
      JMP TYPE5,I   RETURN--DEVICE TYPE: <12>,LP OR <23>,MT 
* 
B12   OCT 12
B23   OCT 23
B37   OCT 37
* 
*  SUBROUTINE TO CLEAR BASE PAGE LINKS. 
* 
* 
CLBPL NOP 
      LDA M1020     CLEAR 
      STA COUNT      BASE 
      CLA             LINKS 
      LDB BPAG4        AREA 
      STA 1,I           FOR 
      INB                LOADER 
      ISZ COUNT 
      JMP *-3             AND 
      JMP CLBPL,I          GENERATOR
* 
M1020 DEC -1020 
BPAG4 DEF BPAGE     ADD OF 1ST WORD OF BP LINKS TBL 
COUNT NOP 
* 
PRPTA DEF *+1 
      OCT 1 
      ASC 1,- 
      SPC 1 
* 
* 
*  SUBROUTINE TO GET LAST WORD OF AVAILABLE MEMORY
* 
* 
GLWAM NOP 
      STA IWHCH 
      SSA           RELEASE?
      JMP GLWAM,I   YES 
      LDA 1,I 
      STA BUFST 
      ISZ 1 
      LDA 1,I 
      STA BUFST+1 
      ISZ 1 
      LDA 1,I 
      STA BUFST+2 
      ISZ 1 
      LDA 1,I 
      STA BUFST+3 
      ISZ 1 
      LDA 1,I 
      STA BUFST+4 
      NOP 
      NOP 
      JSB LIMEM 
      DEF *+4 
      DEF IWHCH     GET-RELEASE AVAILABLE MEMORY
      DEF LST       FIRST WORD OF AVAILABLE MEMORY
      DEF IWRDS     # WORDS AVAILABLE MEMORY
      LDA IWRDS 
      SZA,RSS 
      JMP LGER3     NO MEMORY AVAILABLE 
      LDA LST 
      STA LSTUL 
      CCA 
      ADA LST 
      ADA IWRDS 
      JMP GLWAM,I 
* 
IWHCH NOP 
IWRDS NOP 
LST   NOP 
* 
BUFER DEF *+1 
BUFST BSS 5 
* 
BU#ER EQU BUFER 
* 
LGER3 LDA NM
      CLB           NO FMP ERROR
      JSB STFER     OUTPUT ERROR TO SYSTEM CONSOLE
      JSB ABRT
      JMP EXEC7 
* 
NM    ASC 1,NM
* 
*  SUBROUTINE TO ECHO ON ECHO FILE
* 
* 
EKHOS NOP 
      STA LENGT     SAVE LENGTH OF MESSAGE
      STB ADDRS     SAVE ADDRESS OF MESSAGE 
      LDA ECHO1     IS ECHO ON? 
      SZA,RSS 
      JMP EKHOS,I   NO, EXIT
      LDA EMSAM     MAP AND ECHO FILE SAME? 
      CPA B1
      JMP EKHOB     YES, OUTPUT TO MAP FILE 
      LDA LENGT     GET MESSAGE LENGTH
      LDB ADDRS     GET MESSAGE ADDRESS 
      JSB WRFL5     OUTPUT TO ECHO FILE 
      JMP EKHOS,I 
EKHOB LDA LENGT     GET MESSAGE LENGTH
      LDB ADDRS     GET MESSAGE ADDRESS 
      JSB WRFL4     OUTPUT TO MAP FILE
      JMP EKHOS,I 
* 
ECHO1 NOP 
EMSAM NOP 
      HED  RTM LOADER UTILITY SUBROUTINES 
***** 
* 
** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF)
* CALLING SEQUENCE: 
* 
*     JSB BLINE 
*     RETURN
* 
***** 
BLINE NOP 
      LDA LBUFA 
      STA BELIN 
      LDA MD60
      LDB BLANK 
      STB BELIN,I 
      ISZ BELIN 
      INA,SZA 
      JMP *-3 
      JMP BLINE,I 
* 
BELIN NOP 
MD60  DEC -60 
* 
LBUFA DEF LBUF
      SPC 5 
      SKP 
* 
***** 
* 
** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER
* CALLING SEQUENCE: 
* 
*     JSB BAKUP 
*     RETURN
* 
***** 
BAKUP NOP 
      LDA QQCNT     DECREMENT CHAR COUNT
      ADA M1
      STA QQCNT 
      LDB QQPTR 
      SLA           AND IF NECESSARY, 
      ADB M1        DECREMENT POINTER 
      STB QQPTR 
      JMP BAKUP,I 
***** 
*     THE ABSOLUTE RECORD BUFFER
* 
.ABR  DEF ABREC 
ABREC OCT 0 
ABRC1 BSS 49        BUFFER FOR ABSOLUTE RECORD
ABL1  DEF ABREC+2   HOLDS CURRENT BUFFER ADDRESS
ABL2  DEF ABREC+2 
      SPC 5 
***** 
* 
** PACK ** INSERT A WORD INTO THE ABSOLUTE RECORD BUFFER
* CALLING SEQUENCE: 
* 
*     LDA WORD TO BE PLACED IN RECORD 
*     JSB PACK
*     RETURN
* 
* NOTE: .B. IS NOT ALTERED BY THIS SUBROUTINE 
***** 
PACK  NOP 
      STA ABL1,I    STORE WORD AT NEXT LOCATION 
      ISZ ABL1      IN BUFFER, INCREASE ADDRESS.
      ADA CKS       ADD WORD TO CHECKSUM
      STA CKS       AND RESTORE WORD
      ISZ ABREC     COUNT WORD
      JMP PACK,I    AND EXIT. 
* 
PACK# EQU PACK
      SKP 
***** 
* 
** PUNCH ** OUTPUT THE RECORD IN THE ABSOLUTE RECORD BUFFER 
* CALLING SEQUENCE: 
* 
*     JSB PUNCH 
*     RETURN
* 
* NOTE: THIS SUBROUTINE INSERTS CHECKSUM AND WORDCOUNT BEFORE OUTPUT
***** 
PUNCH NOP          ENTRY/EXIT 
      LDA OUTON     OUTPUT FILE OPEN? 
      SZA,RSS 
      JMP ERROO     NO, ERROR EXIT
      LDA CKS       ADD LOAD ADDRESS TO CHECK-SUM 
      ADA ABREC+1    AND SET RECORD SUM 
      STA ABL1,I      IN LAST WORD OF RECORD. 
      LDA ABREC     ADD 2 TO RECORD WORDCOUNT 
      ALF,ALF         POSITION AS FIRST CHAR. AND 
      STA ABREC        SET. 
      ALF,ALF      REPOSITION, ADD 3 FOR TOTAL
      ADA B3         LENGTH AND SET FOR 
      CMA,INA 
      LDB .ABR
      JSB WRFL2     WRITE RECORD TO ABS OUTPUT FILE 
      CLA           ZERO OUT
      STA ABREC     WORD COUNT
      STA CKS       AND CHECKSUM
      LDA ABL2      INITIALIZE
      STA ABL1      NEXT WORD POINTER 
      JMP PUNCH,I  EXIT-
* 
ERROO CLB 
      JSB CLFL3     CLOSE REL FILE
      LDA OO
      CLB           ERROR CODE
      JMP WERR1 
* 
OO    ASC 1,OO
* 
CKS   NOP           CHECKSUM
OUTON NOP 
* 
B3    OCT 3 
                                                                                                                                                                                                        