ASMB,R,L,C     RTML1
*     NAME:   RTML1 RTE-M SEGMENTED GEN.-LOADER (SEGMENT 1) 
*     SOURCE: 91740-18046 
*     RELOC:  91740-16046 
*     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 RTML1,5 91740-16046 REV 1926 790426 
* 
* 
* 
*   EXTERNAL REFERENCE NAMES
* 
      EXT ABL1,ABL2,.ABR,ABREC,ABRT1,AFILE,AL 
      EXT ATBUF,BPAG4,BPLOC,BU#ER 
      EXT CFILE,CKS,CLBPL,CMDLU,COML,CONSL,CONSO
      EXT DCB1,DCB2,DCB3,DCB4,DCB5,DCB6,DCB7
      EXT ECFIL,ECHO1,ECHOS,EFILE,EMSAM,ERACT 
      EXT ERDVC,ER#OR,FL1OP,FRTRU,FT#ME,FUTA,FWABP
      EXT FWAC,FWAM,GE#NA,GREAD,ICR,IDCB,IERR#
      EXT INACT,IN#CK,IN#RR,INTER,IOPTN,ISECU,JLU,KONSO 
      EXT LBF10,LBUF5,LBUFA,LDGEN,LFILE,LGER2,LINTP 
      EXT LISTO,LNKDR,LOCFS 
      EXT LST,LSTA,LWABP,LWAC 
      EXT MAPON,MEMRY,MLOCC,NAMR.,NBUF6,NBUFA 
      EXT NBUFT,NXTC2,OFILE,OPEN1,OPFLA 
      EXT OPFLB,OPFLC,OPFLD,OPFLE,OPFLF,OPFLG,OPFLH 
      EXT OPNLU,OTFIL,OUTON,PNAMA,QBUFA 
      EXT QQCNT,QQPTR,RBTA,RBTO,RT.G1,RTLG1,SCP 
      EXT SERFG,SNAPS,SP#CE,STFER,TRUNC,TYPRO 
      EXT UEXFL,UNDEF,WERR1,WRTBT,?XFER,XNAMA 
* 
      EXT $CON,DTTY,$OPSY 
      EXT DU#MY 
* 
      EXT CREAT,OPEN
* 
      EXT PNZQZ 
* 
* 
BUFER EQU BU#ER 
ERROR EQU ER#OR 
FTIME EQU FT#ME 
GETNA EQU GE#NA 
IERR  EQU IERR# 
INDCK EQU IN#CK 
INERR EQU IN#RR 
SPACE EQU SP#CE 
LOCC  EQU MLOCC 
* 
      SUP 
************************************************************************
* 
*  THIS SEGMENT OF THE RTE-M SEGMENTED LOADER AND 
*  GENERATOR INITIALIZES ALL NECESSARY LOCATIONS, 
*  REMOVES INDIRECT ADDRESS FOR DEFS AND PROCESSES
*  THE LOADER AND GENERATOR ON PARAMETERS. CONTROL
*  IS RETURNED TO EITHER THE LOADER OR GENERATOR MAIN.
* 
* 
********************************************************************
      HED  RTM LOADER UTILITY SUBROUTINES 
      SKP 
RTML1 NOP 
      NOP 
      JSB LGUNT     INITIALIZE LOADER OR GEN
      JSB SPACE 
GEN?  JSB INTER 
      LDA P14 
      LDB MES09 
      JSB GREAD 
      LDA N2
      JSB GETNA 
      CCB 
      CPA GE
      CLB 
      CPA LO
      CLB,INB 
      SSB,RSS 
      JMP GEN1
      JSB INERR 
      JMP GEN?
GEN1  STB LDGEN 
      SZB,RSS 
      JMP RTLG1 
      STB LNKDR 
      JMP RT.G1 
* 
GE    ASC 1,GE
LO    ASC 1,LO
* 
MES09 DEF *+1 
      ASC 7,* GEN OR LOAD?
* 
N2    DEC -2
P14   DEC 14
* 
* 
*  SUBROUTINE TO INITIALIZE LOADER SUBCONTROL 
* 
* 
INIT  NOP 
      LDA ABL2      REMOVE
      JSB INDCK 
      STA ABL2
      LDA .ABR
      JSB INDCK 
      STA .ABR
      LDA ATBUF 
      JSB INDCK 
      STA ATBUF 
      LDA BPAG4 
      JSB INDCK         INDIRECT
      STA BPAG4 
      LDA BUFER 
      JSB INDCK 
      STA BUFER 
      LDA DCB1
      JSB INDCK 
      STA DCB1
      LDA DCB2
      JSB INDCK 
      STA DCB2              ADDRESSES 
      LDA DCB3
      JSB INDCK 
      STA DCB3
      LDA DCB4
      JSB INDCK 
      STA DCB4
      LDA DCB5
      JSB INDCK 
      STA DCB5
      LDA DCB6                  FOR 
      JSB INDCK 
      STA DCB6
      LDA DCB7
      JSB INDCK 
      STA DCB7
      LDA FUTA
      JSB INDCK 
      STA FUTA
      LDA LBF10 
      JSB INDCK                     DEFS
      STA LBF10 
      LDA LBUF5 
      JSB INDCK 
      STA LBUF5 
      LDA LBUFA 
      JSB INDCK 
      STA LBUFA 
      LDA LSTA
      JSB INDCK 
      STA LSTA
      LDA MEMRY 
      JSB INDCK 
      STA MEMRY 
      LDA NBUF6 
      JSB INDCK 
      STA NBUF6 
      LDA NBUFA 
      JSB INDCK 
      STA NBUFA 
      LDA NBUFT 
      JSB INDCK 
      STA NBUFT 
      LDA PNAMA 
      JSB INDCK 
      STA PNAMA 
      LDA QBUFA 
      JSB INDCK 
      STA QBUFA 
      LDA RBTA
      JSB INDCK 
      STA RBTA
      LDA RBTO
      JSB INDCK 
      STA RBTO
      LDA XNAMA 
      JSB INDCK 
      STA XNAMA 
      LDB BUFER 
      STB PRMAD 
      LDA B4        INITIALIZE TO INPUT/DEVICE FILE MODE
      STA CMDLU 
      LDA B100
      STA FWABP     FIRST WORD OF AVAILABLE BASE PAGE 
      LDA B1646 
      STA LWABP     LAST WORD OF AVAILABLE BASE PAGE
      LDA B2000 
      STA FWAM      FIRST WORD OF AVAILABLE MEMORY
      JSB CLBPL     CLEAR BASE PAGE LINKS 
      LDA OPFLA     SET FOR NO PAUSE
      AND UDFE
      JSB PAUSE 
      LDA ABL2
      STA ABL1
      CLA 
      STA LISTO     INITIALIZE MAP OUTPUT 
      STA UNDEF     START SEARCH AT BEGINING OF LST 
      STA LINTP     LINKS IN FLAG (SET TO BASE) 
      STA FWAC      FIRST WORD OF COMMON
      STA LWAC      LAST WORD OF COMMON 
      STA FRTRU     FIRST TIME THRU FLAG
      STA ?XFER     "HAVE MAIN FLAG"
      STA LOCC      PROGRAM RELOCATION BASE 
      STA BPLOC     BASE PAGE RELOCATION BASE 
      STA COML      "COMMON USED" FLAG
      STA LST,I     LOADER SYMBOL TABLE LENGTH
      STA ECHO1     ECHO OFF
      STA NAMR.     ALLOW A NAM RECORD
      STA MAPON     MAP OFF 
      STA AL        CLEAR MAP FILE NAME 
      STA ECFIL     CLEAR ECHO FILE NAME
      STA EMSAM     MAP/ECHO FILE OFF 
      STA OUTON     ABSOLUTE OUTPUT FILE CLOSED 
      STA INACT     SET INPUT TO NON-INTERACTIVE
      STA FL1OP     CLEAR COMMAND FILE OPEN BIT 
      STA ERDVC     CLEAR ERROR LOG DEVICE
      STA OPEN1     CLEAR COMMAND FILE OPEN BIT 
      STA FTIME     OUTPUT TYOFF REC ONLY AT START
      STA ISECU     SECURITY CODE 
      STA ICR       LABEL 
      STA WRTBT     NO RELOCATION YET 
      STA TRUNC     DON'T TRUNCATE ON ABORT 
      STA ABREC     CLEAR RECORD LENGTH 
      STA CKS       CLEAR CHECK SUM 
      STA TYPRO     SET TO ANY TYPE MODULE ALLOWED
      STA CONSO     GET INPUT FROM SESSION CONSOLE
      STA SERFG     LIBRARY LOAD FLAG 
      STA UEXFL     UNDEFINED EXTERNALS 
      STA PNZQZ     PROGRAM NAME
      STA KONSO     END OF INPUT FILE FLAG
      JMP INIT,I
* 
B4    OCT 4 
B100  OCT 100 
B1646 OCT 1646
B2000 OCT 2000
UDFE  OCT 77777 
* 
PRMAD NOP 
      SKP 
* 
* 
* 
STORE NOP 
      LDB LU        ASCII LU
      STB OTFIL,I 
      ISZ OTFIL 
      LDB ..        ASCII ..
      STB OTFIL,I 
      ISZ OTFIL 
      STA OTFIL,I   LU
      JMP STORE,I 
* 
LU    ASC 1,LU
..    ASC 1,..
      SKP 
* 
* 
*  SUBROUTINES TO OPEN FILES
* 
* 
OPFL1 NOP 
      CLA,INA 
      STA OPEN1     COMMAND INPUT CALLING 
      LDA OPFLA 
      STA OPFLM 
      LDA CFILE     OPEN COMMAND FILE 
      LDB DCB1
      JSB OPNFL 
OPFLM OCT 410       KEYBOARD ECHO 
      CLA,INA       SET COMMAND FILE TO OPEN
      STA FL1OP 
      CLA 
      STA OPEN1     CLEAR COMMAND INPUT CALLING 
      JMP OPFL1,I 
* 
* 
* 
* 
OPFL8 NOP 
      LDA OPFLH 
      STA OPFLT 
      LDA EFILE     OPEN ERROR/PROMPT FILE
      LDB DCB7
      JSB OPNFL 
OPFLT OCT 610       PRINT 1ST COLUMN  KEYBOARD ECHO 
      JMP OPFL8,I 
      SKP 
      SKP 
* 
* 
*  OPEN FILES 
* 
*    A REG = ADDRESS OF FILE NAME ARRAY 
*    B REG = ADDRESS OF DATA CONTROL BLOCK
* 
* 
OPNFL NOP 
      STA AFILE     SAVE ADDRESS OF FILE
      STB IDCB      SAVE ADDRESS OF DCB 
      LDA OPNFL,I 
      STA IOPTN     OPEN OPTION 
      ISZ OPNFL 
      JSB OPEN      OPEN FILE 
      DEF *+7       RETURN ADDRESS
      DEF IDCB,I    DCB 
      DEF IERR      ERROR CODE
      DEF AFILE,I   ADDRESS OF FILE 
      DEF IOPTN     OPEN OPTION 
      DEF ISECU     SECURITY CODE 
      DEF ICR       LABEL 
      SSA 
      JMP OPN1      OPEN ERROR
      LDA OPFLA 
      AND UDFE      CLEAR PAUSE BIT 
      JSB PAUSE 
      JMP OPNFL,I 
* 
OPN1  CPA M100
      JMP OPN7
      JSB OPNLU     CHECK IF LU 
      JMP OPN8      NOT LUUU
      JMP OPNFL,I   LU, EXIT
OPN8  LDB OPEN1     COMMAND INPUT CALLING?
      CPB B1
      JMP ABRT0     YES, ABORT
      LDB OPFLA 
      SSB           BEEN HERE ALREADY?
      JMP OPN2      YES, FILE NOT FOUND 
      CPA MD6       OPEN ERROR (6)? 
      RSS 
      JMP ERROE     NO, OPEN ERROR
      LDA OPFLA           SET PAUSE BIT 
      IOR C1000 
      JSB PAUSE 
OPN4  CLA 
      STA QQCNT     RESET INPUT BUFFER
      LDA QBUFA 
      STA QQPTR 
      LDA QBUFA,I   GET FIRST CHARACTER 
      ALF,ALF 
      AND B177
      CPA B55       IS COMMAND ID SUPPLIED? 
      ISZ QQCNT     YES--BUMP CHAR. POINTER 
      JMP NXTC2 
* 
OPN2  LDA OPFLA     CLEAR PAUSE BIT 
      AND UDFE
      JSB PAUSE 
      LDA AFILE 
      CPA OFILE     OPENING OUTPUT FILE?
      JMP OPN3      YES 
      LDB B4
      CPA SNAPS     OPENING SNAP FILE?
      JMP OPN6      YES 
      CPA LFILE     OPENING MAP FILE? 
      JMP OPN6
      CPA ECHOS     OPENING ECHO FILE?
      JMP OPN6      YES 
OPN5  LDA FN        FILE NOT FOUND
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL     TRY AGAIN 
* 
OPN3  LDA D300
      LDB LDGEN     LOADER CALLING? 
      SZB 
      LDA D30       YES 
      LDB B7
      RSS 
OPN6  LDA D15 
      JSB CRETE     GO TRY TO CREATE FILE 
      JMP OPN4
* 
OPN7  LDA DI
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL     DISK INITIALIZATION ERROR 
* 
ERROE LDA OE
      LDB IERR      ERROR CODE
      JMP WERR1 
* 
ABRT0 LDA OE        OPEN FILE ERROR 
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP ABRT1 
* 
MD6   DEC -6
B1    OCT 1 
B7    OCT 7 
B55   OCT 55
B177  OCT 177 
* 
D15   DEC 15
D30   DEC 30
C1000 OCT 100000
* 
*  CREATE OUTPUT FILE IF IN FLOPPY ENVIRONMENT
* 
CRETE NOP 
      STA DSIZE     FILE SIZE 
      STB ITYPE     TYPE OF FILE 4=ASCII 7=ABS
      JSB CREAT     CREATE FILE 
      DEF *+8 
      DEF IDCB,I    DCB 
      DEF IERR
      DEF AFILE,I   ADDRESS OF FILE 
      DEF DSIZE     FILE SIZE 
      DEF ITYPE     TPE OF FILE 
      DEF ISECU     SECURITY CODE 
      DEF ICR       LABEL 
      CPA MD200 
      JMP OPN5      CAN'T CREATE FILE ON NON-FLOPPY 
      SSA,RSS 
      JMP CRETE,I 
* 
      LDA CR        CREATE ERROR
      LDB IERR      ERROR CODE
      JSB ERROR 
      JMP CONSL 
* 
CR    ASC 1,CR
DI    ASC 1,DI
* 
MD200 DEC -200
M100  DEC -100
D300  DEC 300 
* 
DSIZE NOP 
ITYPE NOP 
      SKP 
* 
OE    ASC 1,OE      OPEN FILE ERROR 
FN    ASC 1,FN      FILE NOT FOUND ERROR
* 
* 
*  SUBROUTINE TO ADD/DELETE PAUSE BIT FROM CONTROL WORDS
* 
PAUSE NOP 
      STA OPFLA 
      STA OPFLF 
      XOR B500
      STA OPFLB 
      IOR B200
      STA OPFLC 
      XOR B100
      STA OPFLD 
      STA OPFLE 
      STA OPFLG 
      IOR B400
      STA OPFLH 
      JMP PAUSE,I 
* 
B200  OCT 200 
B400  OCT 400 
B500  OCT 500 
      HED *** FILE PROCESSORS *** 
* 
*  SUBROUTINE TO GET INPUT COMMAND DEVICE AND ERROR-PROMPT
*  DEVICE.LAST PARAMETER DETERMINES IF PROGRAM IS IN A
*  PARTITION AND IF SSGA AND SYSTEM COMMON NEEDED.
* 
* 
LGUNT NOP 
      JSB INIT      INITIALIZE LOADER SUBCONTROL
      LDA PRMAD,I 
      SZA,RSS       IF NO INPUT DEVICE/FILE USE 
      JMP LGUNA     SESSION CONSOLE FOR INPUT 
LGUNB STA INDVC 
      SZA 
      SSA 
      JMP LGER1     NOT VALID LU OR FILE NAME 
      CMA,INA 
      ADA BLANK 
      SSA           LU OR FILE NAME?
      JMP LGUN1     MUST BE FILE NAME 
      LDA INDVC 
      JSB INTR1     DETERMINE IF INTERACTIVE INPUT
      LDA INDVC     INPUT COMMAND LU
      LDB $OPSY     GET TYPE OF OPERATING SYSTEM
      CPB M7        RTE-MI? 
      JMP LGUN9     YES 
      CPB M15       RTE-MII?
      JMP LGUN9     YES 
      CPB M5        RTE-MIII? 
      JMP LGUN9     YES 
      LDB INACT     INTERACTIVE INPUT?
      SZB 
      STA $CON,I    YES, SAVE LU FOR MESSAGES 
LGUN9 LDB CFILE     ADDRESS OF INPUT COMMAND FILE NAME
      JSB FILNM     GET DEFAULT FILE NAME 
      ISZ PRMAD 
      ISZ PRMAD 
      ISZ PRMAD     INCREMENT PARAMETER ADDRESS TO 4TH PARAM. 
LGUN2 JSB OPFL1     OPEN COMMAND INPUT FILE 
      JSB GETVL     GET ERROR LOG DEVICE LU 
      STA ERDVC 
      SZA,RSS       ANY ERROR/PROMPT LOG DEVICE?
      JMP LGUN4     NO, USE INPUT COM. DEV. IF POSSIBLE 
      LDA ERDVC     ERROR-PROMPT LOG DEVICE LU
      LDB EFILE     ADDRESS OF ERROR LOG FILE NAME
      JSB FILNM     GET DEFAULT FILE NAME 
      JSB OPFL8     OPEN ERROR/PROMPT FILE
      LDA ERDVC     GET ERROR LOG LU
      JSB DTTY      CHECK IF INTERACTIVE
      CLB,INB       INTERACTIVE 
      SZA,RSS 
      CLB           NON-INTERACTIVE 
      STB ERACT 
LGUN7 JSB GETVL 
      LDB 0 
      CLA           0 = MEMORY RESIDENT 
      SLB 
      INA           1 = PROGRAM IN PARTITION
      RBR,SLB 
      IOR B2        2 = USES SYSTEM COMMON
      RBR,SLB 
      IOR B4        4 = USES SSGA 
      RBR,SLB 
      IOR B10       8 = LOAD WITH DEBUG 
      STA SCP 
      AND B10 
      JMP LGUNT,I 
LGUNA LDA $CON,I    SESSION CONSOLE 
      AND B77 
      JMP LGUNB 
* 
LGUN1 LDA CFILE 
      STA FILEI 
      LDA M3
      STA COUNT 
LGUN3 LDB PRMAD     GET PARAMETER ADDRESS 
      LDA 1,I       GET NEXT TWO CHARACTERS OF INPUT
      SZA,RSS       COMMAND FILE
      LDA BLANK     NO MORE CHARACTERS IN FILE NAME 
      STA FILEI,I   SAVE FILE NAME FOR OPEN CALL
      ISZ FILEI 
      ISZ PRMAD 
      ISZ COUNT 
      JMP LGUN3     PROCESS NEXT TWO CHARACTERS 
      CLA 
      STA INDVC     SET TO FILE FOR INPUT 
      JMP LGUN2 
* 
* 
LGUN4 STA ERACT     NON-INTERACTIVE ERROR LOG 
      LDA INDVC     GET INPUT LU
      SZA,RSS 
      JMP LGUN5     NO LU, INPUT MUST BE FILE 
LGUN8 JSB INTR1     IS DEVICE INTERACTIVE?
      JMP LGUN7 
LGUN5 LDA DCB1
      INA 
      LDA 0,I       GET FILE TYPE 
      SZA 
      JMP LGUN7     NOT TYPE 0, NOT INTERACTIVE 
      LDA DCB1
      JSB LOCFS 
      SSA 
      JMP LGER2 
      LDA JLU       GET LU OF FILE NAME 
      JMP LGUN8 
* 
* 
M5    DEC -5
M7    DEC -7
M15   DEC -15 
      SPC 5 
      SKP 
* 
* 
LGER1 LDA ON
      CLB   NO FMP ERROR
      JSB STFER     OUTPUT ERROR TO SYSTEM CONSOLE
      JMP ABRT1     TERMINATE LOADER EXECUTION
* 
ON    ASC 1,ON
* 
BLANK ASC 1,
* 
B2    OCT 2 
B10   OCT 10
B77   OCT 77
M3    DEC -3
* 
COUNT NOP 
INDVC NOP 
FILEI NOP 
* 
*  SUBROUTINE TO GET VALUES FROM ON COMMMAND
* 
*  B REGISTER CONTAINS ADDRESS OF NEXT PARAMETER
* 
GETVL NOP 
      LDB PRMAD     ADDRESS OF NEXT PARAMETER 
      LDA 1,I       PARAMETER VALUE 
      ISZ PRMAD 
      JMP GETVL,I 
* 
* 
*  SUBROUTINE TO DETERMINE IF INPUT DEVICE IS INTERACTIVE 
* 
* 
INTR1 NOP 
      JSB DTTY
      CLB,INB       INTERACTIVE 
      SZA,RSS 
      CLB           NON-INTERACTIVE 
      STB INACT 
      JMP INTR1,I 
      SKP 
* 
* 
*  SUBROUTINE TO GET FILE NAMES 
* 
* 
FILNM NOP 
      STB OTFIL     SET DESTINATION ADDRESS 
      CLB 
      STB HDGIT 
FIL01 ADA M10       CONVERT LU TO ASCII TWO DIGITS
      SSA 
      JMP FIL02 
      ISZ HDGIT 
      JMP FIL01 
FIL02 ADA D10 
      IOR B60       MAKE ASCII
      STA LDGIT 
      LDA HDGIT 
      IOR B60 
      ALF,ALF 
      IOR LDGIT 
      JSB STORE     SAVE LU IN ARRAY
      JMP FILNM,I 
* 
HDGIT NOP           HIGH ASCII CHARACTER
LDGIT NOP           LOW ASCII CHARACTER 
* 
M10   DEC -10 
B60   OCT 60
D10   DEC 10
* 
      END RTML1