ASMB,L,R,C
      HED SCGN0 91700-16138 REV.A 760314 * (C) HEWLETT-PACKARD CO. 1976 * 
      NAM SCEGN,3,90 91700-16138 REV.A 760314 
      SPC 1 
******************************************************************
*  * (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.       *
******************************************************************
      SPC 2 
      SPC 1 
************************************************* 
* 
*SCGN0              MAIN FOR THE SCE GENERATOR-LOADER 
* 
*SOURCE PART #      91700-18138 REV A 
* 
*REL PART #         91700-16138 REV A 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      11-29-74
* 
*MODIFIED BY:       K.HAHN    [ C.C.H. ]
* 
*DATE MODIFIED:     09-23-75  [ 03-14-76 ]
* 
*MODIFICATION:      ADD CURRENT PAGE LINKING, MAP ALL, AND * COMMENTS.
*                   [ ADD ECHO ON/OFF OPTION TO SUPPRESS COMMAND ECHO,
*                     ADD EXTENDED-NAM PRINTOUT, ADD DVR05 PROCESSING. ]
**************************************************
      SPC 1 
* 
* 
*     THIS PROGRAM CONTROLS THE SEGMENTS
*     OF THE RTS GENERATOR
* 
      SPC 3 
* 
*     DEFINE ENTRY POINTS 
* 
      ENT .MEM.,.MEM1,.MEM2,.MEM3,.MEM4,.MEM5,.MEM6 
      ENT ?XFER,ABDCB,ABL1,ABL2,ABRC1,ABREC 
      ENT BPLOC,CKS,COMOR,FWAM,GTOUT,LISTO,LOCC 
      ENT LOUT,LST,LST1,LST2,LST3,LST4,LST5 
      ENT LSTI,LSTP,LWAM,NAMR.,PACK$,PLK,PLKS 
      ENT PNAMA,PNAME,PRAMS,PRCMD,PRINT,PUNCH,RBTA
      ENT RBTO,RBIN,SSTBL,UEXFL 
      ENT IBUFR,PLK1,CMDLU,LSDCB
      ENT RLDCB,SWAPR,FERR,FILCK,PRMT 
      ENT FOPEN,FCRET 
      ENT FTRKA,NSEC,NTRK,SECTK 
      ENT SECA,TRKA,ENDM,DSKLU,SMTLN
      ENT PARSB,PARSA,FCLOS,ENDLU,COML
      ENT PARS1,PARS2,PARS3,PARS4,PARS5 
      ENT PRS21,PRS31,PRS41,PRS51,INDCB 
      ENT STKAD,P:TR,PUSH,NOPRT,LDRCD 
      ENT SC3CD,S45CD,SWPLC,INDB3 
      ENT CLSFI,#ECHO 
      ENT PRS22,PRS23,SIZE
      ENT EFLAG,CPLMG,CPLML 
      SPC 2 
* 
*     DEFINE EXTERNALS
* 
      EXT LOAD,WRITF,EXEC,CLOSE 
      EXT CREAT,OPEN,READF,CNUMD
      EXT .ENTR,.DFER 
      EXT PARSE,IFBRK 
      EXT LOCF,APOSN,NBUF9
      EXT CPLEN 
      IFN 
      EXT DBUG
      XIF 
      SPC 2 
* 
*     DEFINE A AND B REG
* 
A     EQU 0 
B     EQU 1 
      SUP 
      SKP 
* 
*     HERE IS WHERE WE START
* 
      SPC 1 
START NOP 
      CLA           INITIALIZE FOR
      STA #ECHO      ECHO OF COMMANDS.
      STB CMDLU 
      IFN 
      LDA B,I    SEE IF THEY WANT THE DEBUGER 
      CPA B6
      RSS           YES 
      JMP STRT0     NO
      JSB DBUG
      DEF *+1 
      JSB EXEC      TERMINATE...SAVE RESURCES 
      DEF *+4 
      DEF B6
      DEF ZERO
      DEF B1
      JMP START 
      XIF 
STRT0 JSB SWAP      GO GET THE INITIAL SEGMENT
      DEC 3 
      JSB A,I       GO TO SEGMENT 
      LDA SWPLC     GET INDEX TO SEGMENT TABLE
      STA *+2 
      JSB SWAP
      NOP           SEGMENT # PLACED HERE 
      JMP A,I       UPON RETURN FROM SWAP A REG=START 
      SPC 2 
D13   DEC 13
B77   OCT 77
B400  OCT 400 
NOPRT NOP 
ENDLU NOP 
UP377 OCT 177400
      SKP 
***** 
* 
** 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.
      SPC 1 
* 
*     ABSOLUTE RECORD BUFFER AND POINTERS 
* 
ABREC OCT 0 
ABRC1 BSS 49        BUFFER FOR ABSOLUTE OUTPUT
ABL1  DEF ABREC+2   HOLDS CURRENT BUFFERR ADDRESS 
ABL2  DEF ABREC+2 
.ABR  DEF ABREC 
CKS   NOP           HOLDS COMPUTED CHECKSUM 
      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 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 
      STA PTEMP     SAVE LENGTH 
      JSB WRITF     GO WRITE THE RECORD 
      DEF *+5 
      DEF ABDCB 
      DEF FERR
      DEF ABREC 
      DEF PTEMP 
      JSB IBUFR     SET UP OUTPUT 
      JMP PUNCH,I  EXIT-
      SPC 1 
B3    OCT 3 
PTEMP NOP 
***** 
      SKP 
***** 
* 
** IBUFR ** INITIALIZE THE ABSOLUTE RECORD BUFFER (ABREC) SO IT MAY 
*           BE FILLED UP FOR LATER OUTPUT 
* CALLING SEQUENCE: 
*     JSB IBUFR 
*     RETURN
* 
***** 
IBUFR NOP 
      CLA       ZERO OUT
      STA ABREC  WORD COUNT 
      STA CKS    AND CHECKSUM 
      LDA ABL2  INITIALIZE
      STA ABL1   NEXT WORD POINTER
      JMP IBUFR,I 
* 
      SKP 
****
* 
*  PLK  **
* 
*     PLK PUNCHES CORE FROM A TO B IN ABS FORMAT. 
*     IF ALSO LISTS THE PUNCH BOUNDS. A, B SPECIFY THE
*     FINAL LOAD ADDRESS OF THE DATA. OFFSET IS 
*     ADDED TO GET THE CURRENT CORE LOCATION. 
* 
***** 
PLK   NOP           ENTRY: LDA,LDB,JSB. 
      STA PLK1
      INB 
      STB PLK3
PL2   LDA MD45     INITIALIZE COUNTER 
      STA PLK2      FOR MAX. BLOCK SIZE OF 45 WORDS.
      LDA PLK1     STORE LOAD ADDR. OF BLOCK
      STA ABRC1       IN WORD 2 OF PUNCH BUFFER 
PL3   LDA PLK1
      ADA PLKS       ADD OFFSET TO GET ACTUAL ADDRESS IN CORE 
      LDA A,I       GET WORD TO PUNCH 
      JSB PACK$      PUT INTO BUFFER
      ISZ PLK1     ADD 1 TO CURRENT BLOCK ADDR. 
      LDA PLK1     IF CURRENT BLOCK 
      CPA PLK3      TERMINATED, GO TO 
      JMP PL4        PUNCH LAST BLOCK.
      ISZ PLK2     INDEX COUNTER. 
      JMP PL3       BUFFER NOT FILLED.
      JSB PUNCH    BUFFER FILLED - PUNCH
      JMP PL2       FILL NEXT BUFFER. 
* 
PL4   JSB PUNCH    PUNCH LAST BUFFER -
      JMP PLK,I     EXIT. 
* 
PLK1  NOP      HOLDS FWA PUNCH AREA 
PLK2  NOP      HOLDS BUFFER INDEX 
PLK3  NOP      HOLDS LWA+1 PUNCH AREA 
MD45  DEC -45 
* 
      SPC 2 
      SKP 
* 
*     SEARCH SYSMBOL TABLE FORR MATCH ROUTINE 
* 
***** 
* 
** SSTBL ** SEARCH SYMBOL TABLE 
* CALLING SEQUENCE
* 
*     LDA ADDRESS OF 5 CHAR NAME TO MATCH 
*     JSB SSTBL 
*     RETURN1  SYMBOL NOT FOUND 
*     RETURN2  FOUND, LST1-LST5 POINT TO MATCHED ENTRY
* 
* NOTE: THE NAME INPUT FOR MATCH MUST START ON A WORD BOUNDARY
***** 
      SPC 1 
SSTBL NOP 
      STB STEMP  SAVE TEMPORARILY 
      JSB LSTI      INITIALIZE SYMBOL TABLE 
SSTB1 JSB LSTP      SET LST ENTRY ADDRESSES 
      JMP SSTBL,I   END OF TABLE--ERROR RETURN
      LDB STEMP  RETRIEVE ADDRESS OF TARGET MATCH 
      LDA B,I 
      CPA LST1,I    CHARS. 1&2 MATCH? 
      INB,RSS 
      JMP SSTB1     NO--GET NEXT ENTRY
      LDA B,I 
      CPA LST2,I
      INB,RSS 
      JMP SSTB1 
      LDA B,I 
      XOR LST3,I
      AND UP377      CHECK CHAR. 5
      SZA 
      JMP SSTB1 
*   MATCH FOUND -- MAKE SUCCESS RETURN
      ISZ SSTBL 
      JMP SSTBL,I 
* 
* 
STEMP NOP 
      SKP 
***** 
* 
** LSTI / LSTP ** SYMBOL TABLE ACCESSING SUBROUTINES
* 
* PURPOSE:  TO SET IN WORDS  LST1 - LST5 THE
*            ADDRESSES OF THE FIVE WORDS IN AN
*            ENTRY IN THE LST (LOADER SYMBOL TABLE) 
* 
*           INITIAL SETUP IS MADE BY THE ROUTINE
*            -LSTI-   THIS SECTION INITIALIZES
*             THE NEGATIVE COUNT OF THE NUMBER
*             OF ENTRIES IN THE LST AND SETS LST5 POINTING TO 
*             THE "-1"TH ENTRY. 
      SPC 1 
*           THE SECTION -LSTP- SETS THE FIVE
*             ADDRESSES OF THE NEXT LST ENTRY 
*             IN LST1-LST5.  IT ALSO INDEXES THE
*             ENTRY COUNTER.  WHEN THE COUNTER = ZERO 
*             EXIT FROM LSTP IS TO P+1 OF THE CALL
*             AND LST1-LST5 CONTAIN THE ADDRESSES 
*             FOR A NEW ENTRY.  IF THE COUNT AFTER
*             INDEXING IS NOT ZERO, EXIT IS TO
*             P+2 OF THE CALL.
      SPC 1 
* CALLING SEQUENCE: (P-1)     JSB LSTI
*                   (P)       JSB LSTP
*                   (P+1)  (END OF LST RETURN)
*                   (P+2)  (NEXT ENTRY ADDRESSES
*                             SET RETURN) 
      SPC 2 
*             - INITIALIZER-
      SPC 1 
LSTI  NOP 
      JSB BRKCK     CHECK IF THEY WANT TO BREAK 
      LDA LST      GET NUMBER OF LST ENTRIES - SET
      CMA           NEGATIVE THE VALUE + 1. 
      STA LSTPX    STORE
      CCA           SET A =-1 
      ADA FWAM     SET ADDRESS+1 OF WORD 1 OF FIRST 
      STA LST5
      LDA FTRKA     RESET TRACK ADDRESS 
      STA CTRKA 
      CLA 
      STA CSECA 
      JSB RDSMB     GO READ/WRITE SYMBOL TABLE TO DISK
      JMP LSTI,I   EXIT 
      SPC 2 
*             - PROCESSOR - 
      SPC 1 
LSTP  NOP 
      LDA LST5      GET ADDRESS FOR NEXT ENTRY
      ADA ENDM      OVERFLOW? 
      SSA 
      JMP LSTP1     NO
      LDA CSECA     YES...GET NEXT BLOCK
      ADA NSEC
      CLB           SEE IF TRACK SPILL OVER 
      DIV SECTK 
      STB CSECA     REMAINDER=SECTOR ADDRESS
      ADA NTRK      GET TO NEXT TRACK 
      ADA CTRKA 
      STA CTRKA     SET IN NEW TRACK ADDRESS
* 
      ADB NSEC      GET LAST+1 SECTOR OF BLOCK
      CMB,INB 
      ADB SECTK     IF END NOT ON 
      SSB,RSS        SAME TRACK,
      JMP *+4        START BLOCK ON 
      CLB            NEXT TRACK 
      STB CSECA 
      ISZ CTRKA 
* 
      JSB RDSMB     GO GET SYMBOL TABLE BLOCK 
      CCA           RESET TO BEGINING OF BUFFER 
      ADA FWAM
      STA LST5
LSTP1 LDA LST5
      INA 
      STA LST1
      INA 
      STA LST2
      INA 
      STA LST3
      INA 
      STA LST4
      INA 
      STA LST5
      ISZ LSTPX     INDEX ENTRY COUNTER.
      ISZ LSTP     NOT END OF LST - SET P+2 EXIT
      JMP LSTP,I   -EXIT-  TO P+1 IF END OF LST.
      SPC 1 
CSECA NOP 
CTRKA NOP 
FTRKA NOP 
NSEC  NOP 
NTRK  NOP 
SECTK NOP 
ENDM  NOP 
DSKLU NOP 
      SKP 
* 
*     SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC 
*     CALLING SEQUENCE
*     JSB RDSMB 
* 
RDSMB NOP 
      LDA SECA      GET LAST SECTOR ADDRESS 
      LDB TRKA      GET LAST TRACK ADDRESS
      CPA CSECA     IS IT EQUAL TO CURRENT? 
      RSS           YES 
      JMP WTSMT     NO...WRITE AND READ 
      CPB CTRKA     HOW ABOUT THE TRACK ADDRESS?
      JMP RDSMB,I   SAME THING...DON'T DO ANYTHING
WTSMT JSB EXEC      GO WRITE OUT CURRENT
      DEF *+7 
      DEF B2
      DEF DSKLU 
      DEF FWAM,I
      DEF SMTLN 
      DEF TRKA
      DEF SECA
      JSB EXEC      READ IN NEW BLOCK 
      DEF *+7 
      DEF B1
      DEF DSKLU 
      DEF FWAM,I
      DEF SMTLN 
      DEF CTRKA 
      DEF CSECA 
      LDA CTRKA 
      STA TRKA
      LDA CSECA 
      STA SECA      RESET TRACK SECTOR ADDRESS
      JMP RDSMB,I   AND RETURN
      SPC 1 
TRKA  NOP 
SECA  NOP 
SMTLN NOP 
      SKP 
* 
*     ROUTINE TO HANDLE THE "PRCMD" JSB FROM THE GENERATOR
* 
PRCMD NOP 
      JSB SWAP
      DEC 1         LOAD IN LOADER
      JSB LOAD GO TO IT ("PRCMD" IN SEGMENT)
      RSS           ERROR RETURN
      ISZ PRCMD     NORMAL RETURN 
      JSB SWAP      ROLL BACK THE GENERATOR 
SWPLC NOP 
      JMP PRCMD,I   AND GIVE CONTROL BACK 
      SPC 4 
* 
*     ROUTINE TO SWAP SEGMENTS
*     CALLING SEQUENCE
*     JSB SWAP
*     DEC SEG #     0=GENERATOR  1=LOADR
*     A AND B REG SAVED 
* 
SWAP  NOP 
      LDA SWAP,I    GET SEG NAME
      MPY B3
      ADA SGNMA 
      STA SWAPA 
      JSB EXEC      ROLL IN SEGMENT 
      DEF *+3 
      DEF D8
SWAPA NOP 
SWAPR ISZ SWAP      GET RETURN ADDRESS
      JMP SWAP,I    AND RETURN
      SPC 1 
ABREG BSS 2 
* 
*     THE FOLLOWING ORDER MUST NOT BE CHANGED 
* 
SGNMA DEF *+1 
      ASC 3,SCGN1   RTC-B GENERATOR SEGMENT 
      ASC 3,SCGN2   LOADER SEGMENT
      ASC 3,SCGN3   OPERATOR INTERFACE LOADER SEGMENT 
      ASC 3,SCGN4   START UP SEGEMENT 
      ASC 3,SCGN5   SCE3 GENERATOR SEGMENT
D8    DEC 8 
S45CD OCT 0 
LDRCD OCT 2 
SC3CD OCT 4 
      SKP 
* 
*     SUBROUTINE TO CLOSE AND PURGE ALL FILES 
*     CURRENTLY OPEN TO PROGRAM INCASE OF ERROR 
*     JSB JSB GTOUT 
* 
*     NOTE: 
*     I AM CHEATING...GEORGE HAS INDICATED THAT IT
*     IS POSSIBLE TO PURGE A FILE IF ALL I HAVE IS
*     A DCB. THE WAY THIS IS DONE IS AS FOLLOWS 
*     SET EXTENT POINTER TO 0...MAIN...GET RID OF SEMENTS 
*     GET THE # OF SECTORS IN FILE AND DIVIDE BY 2
*     TO GIVE YOU THE # OF BLOCKS.
*     DO A CLOSE AND TRUNCATE ALL BLOCKS, WHICH MAKES 
*     THE FILE MANAGER ROUTINES DO EFFECTLY A PURGE.
*     THUS WE HAVE DONE A PURGE WITHOUT THE NAME
*     THIS IS DEPENDENT ON DCB MEANING...IF IT CHANGES
*     BYE.... 
* 
* 
GTOUT NOP 
      LDA 1717B     GET TO ID NAME
      ADA D12       ADD TO NAME 
      STA .DFR1     SAVE FOR MOVE 
      JSB .DFER     MOVE NAME 
      DEF ABMSG 
.DFR1 NOP 
      LDA ABM1      GET TO LAST TO CHAR 
      AND UP377     MASK OFF 6TH CHAR 
      IOR B40 
      STA ABM1      SAVE ONLY 5 CHAR NAME 
      LDA D14       GO PRINT ABORT
      LDB DFABM      MESSAGE TO THE 
      JSB LOUT        OUTPUT LIST FILE
      LDA ABDCB+9   SEE IF FILE OPEN
      CPA 1717B     THATS OUR ID SEGMENT ADDRESS
      RSS           YES 
      JMP GTOT1     NO
      CLA           CLEAR OUT EXTENTS 
      LDB ABDCB+2   SEE IF TYPE 0 
      SZB,RSS 
      JMP CLSAB     IT IS, DON'T PURGE FILE 
      STA ABDCB+15
      LDA ABDCB+5   GET # OF SECTORS
      CLE,ERA       CONVERT TO BLOCKS 
CLSAB STA BLKS      AND SAVE IT 
      JSB FCLOS     PURGE THE FILE!!! 
      DEF *+3 
      DEF ABDCB 
      DEF BLKS
GTOT1 JSB FCLOS     CLOSE LIST FILE 
      DEF *+2 
      DEF LSDCB 
      JSB FCLOS     FCLOS RELOCATABLE INPUT FILE IF OPEN
      DEF *+2 
      DEF RLDCB 
      JSB FCLOS     CLOSE INPUT FILE
      DEF *+2 
      DEF INDCB 
* 
*     AT THIS POINT ALL FILES ARE CLOSED OR PURGED
*     TELL WORLD WE ARE DONE
* 
      JSB EXEC      PRINT OUT ABORT MESSAGE 
      DEF *+5 
      DEF B2
      DEF ENDLU 
DFABM DEF ABMSG     "RTSGN ABORTED" 
      DEF B7
      JSB EXEC      RELEASE TRACKS
      DEF *+3 
      DEF B5
      DEF M1
      JSB EXEC      AND TURN OFF
      DEF *+2 
      DEF B6
      SPC 1 
ABMSG ASC 2,
ABM1  ASC 1,
      ASC 4,ABORTED 
B1    OCT 1 
B2    OCT 2 
B5    OCT 5 
B6    OCT 6 
B7    OCT 7 
M1    DEC -1
BLKS  NOP 
D12   DEC 12
      SKP 
*     SUBROUTINE TO WRITE ON INTERACTIVE DEVICE 
*     AND LIST FILE 
*     CALLING SEQUENCE
*     JSB PRINT 
*     A REG= SIO LENGTH WORD
*     B REG= ADDRESS OF MESSAGE 
* 
PRINT NOP 
      DST ABREG     SAVE A AND B REG FOR LOUT 
      JSB BYTCN     CONVERT SIO TO USUAL
      INB           SKIP OVER LEADING SPACE 
      ADA M1        CUT COUNT NOT INCLUDE SPACE 
      STA PRNTA     SAVE LENGTH 
      STB PRNTB     SAVE ADDRESS
      LDA NOPRT     DO WE PRINT THIS MESSAGE? 
      SZA 
      JMP PRNT1     NO
      JSB WRITF     OUTPUT MESSAGE
      DEF *+5 
      DEF INDCB      TO THE INPUT DEVICE
      DEF FERR
PRNTB NOP 
      DEF PRNTA     LENGTH
PRNT1 LDA #ECHO     IF BOTH THE ECHO-OFF FLAG,
      ADA PRMFL      AND THE PROMPT FLAG
      CPA B2          ARE SET,
      JMP PRINT,I      BYPASS WRITING TO LIST FILE. 
      DLD ABREG     GET LENGTH AGAIN
      JSB LOUT      WRITE TO FILE 
      JMP PRINT,I   AND RETURN
      SPC 1 
PRNTA NOP 
      SPC 1 
*     SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS
*     CALLING SEQUENCE
*     JSB BYTCN 
*     B REG UNCHANGED 
* 
BYTCN NOP 
      STA BYTCA     SAVE LENGTH FOR CHECKING LATTER 
      SSA           WORDS OR CHARACTERS?
      JMP *+3       WORDS 
      CMA,INA       CONVERT CHAR TO WORDS 
      ARS           DIVIDE BY 2+1 
      STA BYTCC     SAVE IN DOWN COUNTER
      LDA LSBFA     GET ADDRESS WHERE TO PUT OUTPUT 
      STA BYTCD     SAVE FOR MOVE 
BYTC1 LDA B,I       MOVE MESSAGE
      STA BYTCD,I 
      ISZ BYTCD 
      INB 
      ISZ BYTCC     DONE? 
      JMP BYTC1     NO
      LDB BYTCA     WORDS OR CHARACTERS?
      SSB 
      JMP BYTC2     WORDS 
      CLE,ERB       CONVERT CHARACTERS TO WORDS 
      SEZ,RSS       ODD # OF CHAR?
      JMP BYTC3     NO
      STB BYTCC     YES...SAVE COUNT FOR LATTER 
      ISZ BYTCC     INCLUDE ODD CHAR
      ADB LSBFA     GET TO END
      LDA B,I 
      AND UP377     MASK OFF LOWER HALF 
      IOR B40       OR IN A SPACE 
      STA B,I       SAVE IT 
      LDB BYTCC     GET LENGTH AGAIN
BYTC3 RSS           SKIP OVER COMPLEMENTING 
BYTC2 CMB,INB       CHANGE NEG WORDS TO + WORDS 
      LDA B         GET LENGTH IN A REG 
      LDB OTBFA     GET ADDRESS OF BUFFER...INCLUDING SPACE 
      INA           INCLUDE SPACE IN COUNT
      JMP BYTCN,I   AND RETURN
      SPC 1 
BYTCA NOP 
BYTCC NOP 
BYTCD NOP 
OTBFA DEF OTBUF 
LSBFA DEF OTBUF+1 
B40   OCT 40
      SPC 1 
*     SUBROUTINE TO WRITE ONTO A LIST FILE
*     CALLING SEQUENCE
*     JSB LOUT
*     AREG = SIO LENGTH 
*     B REG= BUFFER ADDRESS 
* 
LOUT  NOP 
      JSB BYTCN     CONVERT LENGTH
      STA LOUTA 
      STB LSBF      SAVE BUFFER ADDRESS FOR OUTPUTING 
      LDA LSBFA,I   GET FIRST TWO USER-CHARACTERS.
      CPA PRMCR     IF THEY ARE THE PROMPT CHARACTERS,
      RSS            SKIP TO REPLACE THE BACK ARROW.
      JMP LWRT      NOT THE PROMPT--NO NEED TO CHANGE.
      AND UP377     SAVE THE UPPER BYTE,
      IOR B40        AND REPLACE THE LOWER WITH A SPACE.
      STA LSBFA,I   RESTORE THE MODIFIED PROMPT CHARACTERS. 
LWRT  JSB WRITF     WRITE THE RECORD
      DEF *+5 
LDCBA DEF LSDCB 
      DEF FERR
LSBF  NOP           LIST BUFFER ADDRESS HERE
      DEF LOUTA 
      JMP LOUT,I    AND RETURN
      SPC 1 
LOUTA NOP 
EFLAG NOP 
#ECHO NOP           COMMAND-ECHO FLAG: 0=ON, 1=OFF. 
PRMCR ASC 1,-_      PROMPT CHARACTERS.
      SKP 
* 
*     SUBROUTINE TO GET NAME
*     OPEN,READ AND CLOSE A RELOCATABLE 
*     FILE. 
*     CALLING SEQUENCE
*     JSB RBIN
*     ERROR RETURN
*     NORMAL RETURN 
* 
*     A REG= BUFFER ADDRESS 
*     UPON RETURN 
*     A REG=-1 EOF OR A REG<> DATA IS THERE 
*     LENGTH IN POSITIVE WORDS FIRST WORD 
*     DATA RECORD 
* 
RBIN  NOP 
      STA RBINA     SAVE BUFFER ADDRESS 
      LDA RLDCB+9   SEE IF DCB OPEN 
      CPA 1717B     IS IT OPEN
      JMP RBOPN      YES...DON'T RE OPEN
      JSB BRKCK     SEE IF WE WANT OUT
      LDA PARS2     GET FILE NAME TYPE
      SZA           IF NOT NULL 
      JMP RBIN1      GO OPEN THE FILE 
      LDA B5        DEFAULT IS LU 5 
      STA PARS2+1   SET 
      LDA B1        SET FILE NAME TYPE
      STA PARS2      TO NUMERIC 
RBIN1 JSB FOPEN     TRY TO OPEN FILE
      DEF *+3 
      DEF RLDCB 
      DEF B300
      JSB FILCK 
      JMP RBIN,I
RBOPN JSB READF     READ THE FILE 
      DEF *+6 
      DEF RLDCB 
      DEF FERR
      DEF RBINA,I 
      DEF D60       MAX OF 60 WORDS 
      DEF RLEN       LENGTH OF RECORD 
      JSB FILCK     SEE IF ANY ERROR
      JMP RBIN,I    ERROR...DO ERROR RETURN 
      ISZ RBIN      GET NORMAL RETURN 
      LDA RLEN       GET LENGTH 
      STA RBINA,I   AND SAVE IN FIRST WORD
      CPA M1        EOF?
      RSS 
      JMP RBIN,I    NO
      JSB FCLOS     YES...CLOSE FILE
      DEF *+3 
      DEF RLDCB 
      DEF ZERO
      CCA           TELL THEM END OF FILE 
      JMP RBIN,I    AND RETURN
      SPC 2 
RBINA NOP 
RLEN  NOP 
* 
*     SUBROUTINE TO OPEN A FILE 
*     CALLING SEQUENCE
*     JSB FOPEN     FILE OPEN 
*     DEF *+3 
*     DEF DCB ADDRESS 
*     DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE 
* 
*     ASSUMES THAT PARS2+1=FILE NAME
*                  PARS3+1=SECURITY CODE
*                  PARS4+1=LU 
* 
ODCBA NOP 
SUBF  NOP 
FOPEN NOP 
      JSB .ENTR 
      DEF ODCBA 
      LDB C4040 
      LDA PRS22 
      SZA,RSS 
      STB PRS22 
      LDA PRS23 
      SZA,RSS 
      STB PRS23 
FOPN1 LDA ODCBA    GGET DCB ADDRESSPE 
      LDB SUBF,I    GET SUBFUNCTION 
      JSB TYP0      CHECK IF TYPE IS 0
      JMP FOPEN,I   YES EXIT
      JSB OPEN      TRY TO OPEN FILE
      DEF *+7 
      DEF ODCBA,I 
      DEF FERR
      DEF PARS2+1   NAME
      DEF ZERO      OPEN OPTION 
      DEF PARS3+1   SECURTIY CODE 
      DEF PARS4+1   LOGICAL UNIT
      LDB ODCBA     GET DCB ADDRESS 
      CPB INDEF     IS IT INPUT FILE
      ISZ NOPRT      SET NON-ZERO(NO PRINT) 
      JMP FOPEN,I   RETURN
      SKP 
*     SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE
*     CALLING SEQUENCE
*     LDA DCB ADDRESS 
*     LDB SUBFUNCTION 
*     JSB TYP0
*     RETURN HERE(P+1) IF IT IS TYPE 0
*     RETURN HERE(P+2) IF IT IS NOT TYPE 0
* 
TYP0  NOP 
      STA T0DCB 
      LDA PARS2 
      CMA,INA,SZA   IF NULL OR NUMERIC
      INA,SZA,RSS    THEN OPEN A DUMMY TYPE 0 
      JMP TYP1
      ISZ TYP0      OTHERWISE TAKE NOT
      JMP TYP0,I     TYPE 0 EXIT
TYP1  LDA PARS2+1  GET LU 
      SZA,RSS      IF NOT DEFINED 
      INA           DEFINE AS LU = 1
      STA PARS2+1 
      CLA 
      JSB SET      SET DIRECTORY
      JSB SET       ADDRESS TO ZERO 
      JSB SET      ALSO SET TYPE TO 0 
      LDA PARS2+1  GET LOGICAL UNIT 
      IOR B        MERGE IN SUBFUNCTION 
      JSB SET       AND SET IN DCB
      JSB EXEC     GET DRIVER TYPE
      DEF *+4 
      DEF D13 
      DEF PARS2+1 
      DEF EQT5
      LDA EQT5     GET TYPE 
      ALF,ALF       ROTATE TO LOW A 
      AND B77        AND MASK 
      CPA B5       IF THE TYPE-CODE IS <05>,
      JSB TYPE5      THEN GO TO 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 PARS2+1  GET LU 
      IOR B        MERGE EOF CONTROL SUBFUNCTION
      JSB SET      SET IN DCB 
      CLA 
      JSB SET      SET NO SPACEING LEGAL
      LDA B1001    SET READ&WRITE LEGAL 
      JSB SET       AND SECURITY CODES AGREE
      JSB SET        AND UPDATE MODEES 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 CORE BUFFER FLAG 
      JSB SET       TO ZERO 
      INA 
      JSB SET      SET RECORD COUNT 
      LDA EQT5     GET TYPE CODE
      LDB T0DCB    GET DCB ADDRESS
      ADB MD15     RESET TO WORD 1
      CPB INDEF    IS IT THE INPUT DEVICE 
      STA NOPRT    SAVE TO INDICATE PRINT / NO PRINT
      ADB B4        GET TO CONTROL FUNCTION LOCATION
      LDB B,I       GET CONTROL WORD
      STB SET       SAVE IN TEMP LOCATION 
      ADA MD17      IF THE EQUIPMENT TYPE-CODE
      SSA,RSS         IS > 16 (MAG.TAPE,ETC.),
      JMP T0END         THEN AVOID WRITING AN END-OF-FILE.
      JSB EXEC      DO A PAGE EJECT, OR GENERATE LEADER.
      DEF *+4 
      DEF B3
      DEF SET       TEMP WHERE FUNCTION CODE LOCATED
      DEF M1        FORCE A PAGE EJECT
T0END CLA          SPECIFY TYPE 0 OPEN
      STA FERR      CLEAR ERROR CODE
      JMP TYP0,I
* 
SET   NOP 
      STA T0DCB,I  SET IN DCB 
      ISZ T0DCB    INCREMENT TO NEXT WORD 
      JMP SET,I 
* 
INDEF DEF INDCB 
T0DCB NOP 
EQT5  NOP 
MD17  DEC -17 
MD15  DEC -15 
B4    OCT 4 
B12   OCT 12
B23   OCT 23
B37   OCT 37
B100  OCT 100 
B300  OCT 300 
B1000 OCT 1000
B1001 OCT 100001
B1100 OCT 1100
D60   DEC 60
* 
FILNM ASC 5,FILE NAME?
* 
      SKP 
* 
*     SUBROUTINE TO CREATE A FILE 
*     CALLING SEQUENCE
*     JSB FCRET 
*     DEF *+5 
*     DEF DCB ADDRESS 
*     DEF SIZE
*     DEF TYPE
*     DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE
* 
*     ASSUMES THAT  PARS2+1=FILE NAME 
*                   PARS3+1=SECURITY CODE 
*                   PARS4+1=LU
* 
      SPC 1 
CDCBA NOP 
CSIZ  NOP 
CTYP  NOP 
CSBUF NOP 
FCRET NOP 
      JSB .ENTR 
      DEF CDCBA 
      JSB FOPEN     GO TRY TO OPEN THE FILE 
      DEF *+3 
      DEF CDCBA,I 
      DEF CSBUF,I 
      SZA,RSS       TYPE 0? 
      JMP FCRET,I   YES...RETURN
      JSB CLOSE     IF NOT CLOSE FILE IF OPEN 
      DEF *+3 
      DEF CDCBA,I 
      DEF FERR
      JSB CREAT     TRY CREATING THE FILE 
      DEF *+8 
      DEF CDCBA,I 
      DEF FERR
      DEF PARS2+1 
      DEF CSIZ,I
      DEF CTYP,I
      DEF PARS3+1 
      DEF PARS4+1 
      JMP FCRET,I 
                                                                                                                                                                                                                                                      