ASMB,A,B,L     PREPARE BASIC SYSTEM--JANUARY 1, 1970
      HED BASIC SYSTEM CONFIGURATER
      ORG  2
*
*  THIS PROGRAM WILL CONFIGURE AND PUNCH AS AN ABSOLUTE TAPE THE
*  HP BASIC SYSTEM COMPATIBLE WITH 'BOSS'; INCLUSION OF THE 'BOSS'
*  VERSION OF THE BASIC INTERPRETER IS OPTIONAL.  TELETYPE,
*  PHOTOREADER, AND PUNCH DRIVERS ARE SUPPLIED BY THIS PROGRAM.
*  CUSTOM 'CALL' ROUTINES MAY BE INCLUDED IF THE BASIC INTERPRETER
*  IS PRESENT.  OPTIONS INCLUDE CHOICE OF BUFFERED OR SERIAL
*  TELETYPE AND CONFIGURATION FOR 8, 16, 24, OR 32K OF
*  MEMORY.
*
*  THE AREAS PUNCHED ARE 4 THROUGH 'CONTENTS OF FWAM' -1 AND
*  'CONTENTS OF LWAM' +1 THROUGH 'CONTENTS OF LWM'; I.E., SYSTEM
*  CODE AND DRIVER CODE.
*
*  TO OPERATE -
*
*    1) LOAD THE PBS TAPE WITH THE PROTECTED LOADER.
*    2) (OPTIONAL) LOAD BASIC INTERPRETER ('CALL ROUTINES
*        MAY ALSO BE LOADED IF DESIRED).
*    3) 'LOAD ADDRESS' 2 AND 'PRESET'.
*    4) SET SELECT CODE OF TELETYPE (IN OCTAL) INTO THE
*        SWITCH REGISTER.  SET SWITCH 15 TO 1 IF USING A
*        SERIAL TELETYPE BOARD.
*    5) SET TELETYPE TO 'LINE,' TURN ON HIGH SPEED TAPE PUNCH
*        IF PRESENT, AND PRESS 'RUN'.
*    6) ANSWER TELETYPE REQUESTS APPROPRIATELY.
*    7) AFTER THE HLT 77B, PRESS 'RUN' FOR EXTRA COPIES.
*
      SUP      SUPPRESS LISTING OF MULTIPLE OPERANDS
*
      JMP 3,I       BEGIN
      DEF START       EXECUTION
*
      HLT 4,C       IN CASE OF POWER FAIL
      HLT 5         IN CASE OF PARITY FAULT
      OCT 0,0,0,0,0,0,0,0,0   NOP ALL MAIN-FRAME
      OCT 0,0,0,0,0,0,0,0,00    INTERRUPT LOCATIONS
      SKP
      ORG 16333B
*
START CLC 0,C       TURN OFF INTERRUPT, ALL DEVICES
      LIA 1         LOAD FROM SWITCH REGISTER
      ELA,RAR       PUT A(15) INTO (E)
      AND B77       MASK TO 6 BITS
      STA IOADR     SAVE I/O ADDRESS
      ARS,ARS       SHIFT OUT FIRST OCTAL DIGIT
      ARS
      SZA           IS I/O ADDRESS GT 7
      JMP GOMAN     YES THEN OK
*
      HLT 55B       INVALID TTY ADDRESS HALT
      JMP START+1   TRY AGAIN
*
*  SET TELETYPE I/O INSTRUCTION ADDRESSES
*
GOMAN SEZ           BUFFERED TELETYPE?
      JMP SERLA,I   NO
      LDA M24       YES, LOAD # OF INSTRUCTIONS
      LDB LST1A     ADDRESS OF INSTRUCTION LIST
      JSB SETI      SET TTY I/O ADDRESSES
*
*  CALL FOR PHOTOREADER ADDRESS INPUT
*
PHRDR JSB CRLFD     DO A CR/LF
      LDA M27       MESSAGE LENGTH, NEGATIVE NO CRLF
      LDB MA1       MESSAGE ADDRESS
      JSB GETAD     GET ADDRESS
      JMP NORDR     ADDRESS =0, NO READER
      LDA M5        VALID READER ADDRESS
      LDB LST2A     READER INSTRUCTION ADDRESS LIST
      JSB SETI      SET READER I/O INSTRUCTIONS
      LDA RO        SET CLC RDR
PHRD1 STA R.OFF       INSTRUCTION
      LDA LWAMR
      STA LWAM      SET LAST WORD AVAILABLE MEMORY
      INA
      STA 101B      SET READER LINK
*
*   CALL FOR PUNCH ADDRESS INPUT
*
NORDR JSB CRLFD
      LDA M20
      LDB MA2
      JSB GETAD     CALL FOR PUNCH ADDRESS INPUT
      JMP SYSDP     NO PUNCH
      LDA M5        VALID PUNCH ADDRESS
      LDB LST3A     PUNCH INSTRUCTION ADDRESS LIST
      JSB SETI      SET PUNCH I/O INSTRUCTIONS
      LDA PO        SET CLC PNCH
NORD1 STA P.OFF       INSTRUCTION
      LDA LWAMP
      STA LWAM      SET LWAM
      INA
      STA 103B      SET PUNCH LINK
*
*  CALL FOR DUMP DEVICE ADDRESS
*
SYSDP JSB CRLFD     CR/LF
      LDA M25
      LDB MA5
      JSB GETAD     GET DUMP I/O ADDRESS
      JMP CORAD     NO SYSTEM DUMP DEVICE AVAILABLE
      LDA CM.4      SYSTEM DUMP DEVICE AVAILABLE
      LDB LST4A     SET DEVICE'S I/O INSTRUCTIONS
      JSB SETI
      LDA PNCHI     SET PUNCH OUTPUT TO REFERENCE
      STA PNCHO       HIGH SPEED PUNCH ROUTINE
*
*  CALL FOR CORE SIZE
*
CORAD JSB CRLFD
      LDA M12       REQUEST
      LDB MA6
CORA1 JSB TTY.P       CORE
      LDA .20
      LDB BUF           SIZE
CORA2 NOP
      JSB TTY.I
      NOP
      SZA,RSS       NULL ANSWER?
      JMP DUMP      YES, ASSUME 8K
      LDA BUF,I     NO
      CPA C8K       '8 NULL'?
      JMP DUMP      YES
      CLB           NO
      CPA C16K      '16'?
      JMP RELOC     YES
      INB           NO
      CPA C24K      '24'?
      JMP RELOC     YES
      INB           NO
      CPA C32K      '32'?
      JMP RELOC     YES
      JSB CRLFD     NO
      LDA M15
      LDB MA7       PRINT
CORA3 JSB TTY.P       ERROR
      JMP CORAD     TRY AGAIN
      SKP
*
*  RELOCATE DRIVERS
*
RELOC ADB INCIN     LOAD
      LDB 1,I         DISPLACEMENT
      LDA LWM       ADJUST
      ADA 1
      STA LWM         ABSOLUTE
      LDA CRLFA
      ADA 1             POINTERS
      STA CRLFA
      LDA 101B
      ADA 1
      SSA,RSS
      STA 101B
      LDA 102B
      ADA 1
      STA 102B
      LDA 103B
      ADA 1
      SSA,RSS
      STA 103B
      LDA 104B
      ADA 1
      STA 104B
      LDA LWAM
      STA SOURC     SAVE ADDRESS OF DRIVER MODULE
      ADA 1
      STA LWAM
      STA DEST      SET DESTINATION ADDRESS
      LDA IMOFF
      ADA 1
      STA IMOFF
      LDA IMON
      ADA 1
      STA IMON
      LDA TLINK
      ADA 1
      STA TLINK
      LDB LWM       COMPUTE
      CMB,INB         # OF WORDS
      ADB LWAM          TO BE MOVED
MOREM ISZ SOURC     ADVANCE
      ISZ DEST        POINTERS
      LDA SOURC,I   MOVE A
      STA DEST,I      WORD
      INB,SZB       DONE?
      JMP MOREM     NO
      SKP
*
*      THIS SECTION DUMPS THE ELEMENTS OF THE SYSTEM LOADED
*
DUMP  JSB CRLFD
      LDA LWAM      SET STARTING
      ADA M36         ADDRESS FOR
      STA IOBFA         I/O BUFFER
      STA SYMTA     SET SYMBOL TABLE POINTER
      ADA M97       SET STARTING ADDRESS
      STA SBUFA       FOR SYNTAX BUFFER
      ADA M1
      STA LWAM      SAVE VALUE CORRECTED FOR BUFFERS
      STA LWBM      FOR STAND-ALONE OPERATION
      LDA PNCHO
      CPA PNCHI     SYSTEM DUMP DEVICE AVAILABLE?
      JMP COPY      PUNCH IS AVAILABLE
*
      LDA .30
      LDB MA3
DUMP1 JSB TTY.P     REQUEST TTY PUNCH ON
*
DUMP2 LDA PLSTR     PREPARE TO
      STA LISTR       PUNCH
      HLT 11B
*
COPY  JSB LTG       GENERATE LEADER
      LDA .4        DUMP
      CCB             LOCATIONS 4
      ADB FWAM          THROUGH
      JSB PNCHA           (FWAM)-1
      LDA LWAM      DUMP
      ADA .135        DRIVER
      LDB LWM           AREA
      JSB PNCHA
      JSB LTG       GENERATE TRAILER
      HLT 77B       END OF DUMP ROUTINE
      JMP COPY      GO MAKE ANOTHER COPY
      SKP
*
*  SUBROUTINE GETA1
*
*    THIS SUBROUTINE CALLS FOR I/O ADDRESS INPUT, PROCESSES THE
*     INPUT AND IF INPUT VALID RETURNS TO P+2. IF NOTHING IS
*     INPUTTED IT RETURNS TO P+1 WITH LINK TO STOP IN A
*
*    CALL:    JSB  GETAD
*              (A) =  LENGTH OF MESSAGE ASKING FOR I/O ADDRESS
*              (B) =  ADDRESS OF MESSAGE
*
*    RETURN:     ZERO   INPUT  -  P+1     (A) = LINK TO STOP
*                VALID ADDRESS -  P+2     (A) = I/O ADDRESS
*
*                I/O ADDRESS IS SAVED IN LOCATION IOADR
*
*    IF INPUT IS INVALID (IE NOT TWO NUMBERS 10-77)
*         "INVALID I/O ADDRESS" IS TYPED AND IT WAITS
*         FOR FURTHER INPUT.
*
GETAD NOP
      JSB TTY.P     PRINT INPUT REQUEST MESSAGE
INPUT LDA .20
      LDB BUF
GETA1 NOP           WAIT
      JSB TTY.I       FOR
      NOP               INPUT
      SZA,RSS       ANY ADDRESS?
      JMP GETAD,I   NO ADDRESS
      CPA .2        TWO CHARACTERS INPUT?
      JMP TWOCH     TWO CHARACTERS INPUTTED
*
ERRO. JSB CRLFD     INVALID INPUT ERROR
      LDA .20
      LDB MA4
GETA2 JSB TTY.P     PRINT 'INVALID INPUT'
      JSB CRLFD     DO A RETURN AND LINE FEED
      JMP INPUT     RETURN FOR MORE INPUT
*
TWOCH LDA BUF,I     GET FIRST TWO CHARACTERS
      ALF,ALF       LOOK AT FIRST CHARACTER
      JSB NBER      CHECK FOR VALID OCTAL;YES,CONVRT
      JMP ERRO.     NOT OCTAL
      SZA,RSS       ADDRESS > 7 ?
      JMP ERRO.     NO
      ALF,RAR       MOVE FIRST DIGIT 3 BITS LEFT
      STA IOADR       AND SAVE
      LDA BUF,I
      JSB NBER      CHECK SECOND CHARACTER
      JMP ERRO.     NOT OCTAL
      IOR IOADR     FORM TWO DIGIT OCTAL NUMBER
      STA IOADR     SAVE I/O ADDRESS
      ISZ GETAD     NON-ZERO I/O ADDRESS
      JMP GETAD,I   RETURN
      SKP
*
*  SUBROUTINE NBER
*
*   THIS SUBROUTINE CHECKS WHETHER THE CHARACTER IN A REPRESENTS
*    A VALID OCTAL DIGIT. IF THE CHARACTER IS VALID IT IS
*      CONVERTED TO AN OCTAL DIGIT.
*
*   RETURN:    P+1  INVALID OCTAL CHARACTER
*              P+2  VALID OCTAL CHARACTER
*                     (A) = OCTAL DIGIT
*
*
NBER  NOP
      AND B177      MASK TO ONE CHARACTER
      ADA N60       SUBTRACT OCTAL 60
      STA 1         TRANSFER TO B
      BRS,BRS
      BRS           SHIFT OUT FIRST 3 BITS
      SZB,RSS       IS B ZERO
      ISZ NBER      B=0, VALID DIGIT, RETURN TO P+2
      JMP NBER,I    RETURN
      SPC 5
*
*   SUBROUTINE CRLFD OUTPUTS A CARRIAGE RETURN AND LINE FEED.
*
CRLFD NOP           EXIT/ENTRY
      CLA
CRLF1 JSB TTY.P     DO CR/LF
      JMP CRLFD,I   EXIT
      SKP
*
*  SUBROUTINE SETI
*
*   THIS SUBROUTINE MODIFIES THE ADDRESSES SPECIFIED IN A LIST
*
*   CALL:    JSB SETI
*                (A) = NUMBER OF LOCATIONS TO BE MODIFIED (2'S COMP)
*                (B) = STARTING ADDRESS OF LIST OF ADDRESSES
*
*
SETI  NOP           EXIT/ENTRY
      STA COUNT     SAVE LENGTH OF LIST
      STB BADDR     SET LIST STARTING ADDRESS
LOOP  LDB BADDR,I   LOAD ADDRESS OF INSTRUCTION
      LDA 1,I       LOAD INSTRUCTION TO BE MODIFIED
      AND MASK      ZERO I/O PART, MASK=177700
      IOR IOADR     INSERT I/O ADDRESS
      STA 1,I       SET MODIFIED INSTRUCTION
      ISZ BADDR     INDEX LIST POINTER
      ISZ COUNT
      JMP LOOP      GO DO NEXT LOCATION
      JMP SETI,I    RETURN
      SPC 5
*
* SUBROUTINE (TOUT) TO OUTPUT ONE CHARACTER
* TO TELETYPE.  CHARACTER IS IN (A).  (B) IS NOT ALTERED.
*
TOUT  NOP
TP.11 OTA TTY       LOAD BOARD BUFFER
      STC TTY,C     GIVE PUNCH COMMAND
      SFS TTY       WAIT FOR
      JMP *-1         COMPLETION
      JMP TOUT,I
      SPC 5
*
*  SUBROUTINE  (POUT) TO OUTPUT ONE CHARACTER TO
*  PUNCH DEVICE.  CHARACTER IS IN (A).  (B) IS NOT ALTERED.
*
POUT  NOP
      OTA PNCH      FILL BOARD BUFFER
      STC PNCH,C    REQUEST PUNCH
      SFS PNCH      WAIT UNTIL
      JMP *-1         DONE
      JMP POUT,I
      SKP
*
*   SUBROUTUNE PUNCH
*
*   THIS SUBROUTINE PROVIDES THE MEANS OF PUNCHING BINARY
*      RECORDS ON THE TELETYPE OR HIGH SPEED PUNCH.
*
*    CALLING SEQUENCE   JSB PUNCH
*
*      (A) = LENGTH (AND MODE) OF RECORD TO BE OUTPUT
*      (B) = STARTING ADDRESS OF DATA BUFFER
*
*  BINARY OUTPUT IS INDICATED BY A NEGATIVE (2S COMPLE-
*   MEMT) VALUE IN A.  THIS NEGATIVE VALUE IS THE
*   NUMBER OF WORDS TO BE OUTPUT.
*
*   IF A = 0 ON ENTRY 10 INCHES OF FEED FRAMES ARE PUNCHED
*
PUNCH NOP           EXIT/ENTRY
      STB BUFF      SAVE STARTING ADDRESS OF BUFFER
      LDB PMODE
TP.9  OTB TTY       SET TTY TO PUNCH MODE
      SZA           CHECK FOR FEED FRAMES ONLY
      JMP *+3       NOT FEED FRAME MODE
      LDA .200
      JMP PP03+1    DO FEED FRAMES ONLY
*
      ALS           CONVERT COUNT TO CHARACTERS (X2)
      STA CHC1      AS COUNTER FOR OUTPUT SECTION.
      LDB UL52      SET UPPER/LOWER INDICATOR
*
* CHARACTER OUTPUT SECTION
*
PP02 LDA BUFF,I    GET WORD CONTAINING CHARACTER
     SSB,RSS       IF UPPER/LOWER FLAG SAYS UPPER
     ALF,ALF        (SIGN = 0) ROTATE TO LOWER
     AND M377      REMOVE UPPER CHARACTER
     JSB PNCHO,I   OUTPUT CHARACTER
     SSB           IF CHAR. OUTPUT WAS LOWER CHAR.,
     ISZ BUFF       ADD 1 TO BUFFER ADDRESS.
     RBL           SET UPPER/LOWER FLAG FOR NEXT CHA
     ISZ CHC1      INDEX CHARACTER COUNTER.
     JMP PP02       NOT ZERO, MORE TO OUTPUT.
*
*  COMPLETION SECTION
*
PP03 LDA CM.4      BINARY SECTION.  SET BUFF = -4
     STA BUFF       FOR COUNTER FOR FEED-FRAMES
     CLA           SET A = ZERO( FEED-FRAME).
     JSB PNCHO,I   OUTPUT FEED FRAME
     ISZ BUFF      INDEX COUNTER
     JMP *-3        CONTINUE OUTPUT
TP.10 CLC TTY       TURN OFF TTY
PN8   CLC PNCH      TURN OFF PUNCH
      JMP PUNCH,I   EXIT
      SKP
*
* SUBROUTINE- PNCHA  (PUNCH ABSOLUTE BLOCK)
*
*  UPON ENTRY --
*    (A) = ADDRESS OF FIRST WORD OF BLOCK
*    (B) = ADDRESS OF LAST WORD OF BLOCK
*
PNCHA NOP
      INB           SET = TO LAST +1M FOR EOB CHECK
      STA T1       SAVE FIRST AND LAST WORD
      STB T2        ADDRESSES OF BLOCK.
P1    LDA M27      SET T3 = -27 AS INDEX F6R
      STA T3        FILLING BUFFER.
      LDA T1      SET BUF+1 FOR LOAD ADDRESS
      STA BUF1,I    OF CURRENT BLOCK.
      STA CKSUM    INITIALIZE CHECKSUM WORD.
      CLA          INITIALIZE
      STA BUF,I     WORD COUNT
      LDA BUF      SET T4 = ADDRESS
      ADA .2        OF WORD 3 OF BUFFER
      STA T4         FOR STORING WORDS.
*
P2    LDA T1,I     STORE CURRENT WORD FORM MEMORY
      STA T4,I      BLOCK IN BUFFER.
      ISZ T1        BUMP BLOCK ADDRESS
      ISZ T4       ADD 1 TO BUFFER ADD950J3
      ADA CKSUM    ADD WORD TO CUMULATED
      STA CKSUM     CHECKSUM
      ISZ BUF,I    COUNT WORD STORED IN BUFFER.
      LDA T1       CHECK FOR END OF BLOCK.
      CPA T2
      JMP P3       YES, FWA = LWA.
      ISZ T3       INDEX BUFFER COUNTER.
      JMP P2       BUFFER NOT YET FILLED.
*
P3    LDA CKSUM    BUFFER FILLED. SET CHECKSUM IN
      STA T4,I     LAST WORD IN BUFFER.
      LDA BUF,I    POSITION RECORD
      ALF,ALF       WORD COUNT TO
      STA BUF,I      UPPER CHARACTER IN WORD 1.
      ALF,ALF      REPOSITION, ADD 3 FOR
      ADA C.03      TOTAL RECORD LENGTH, SET
      CMA,INA        NEGATIVE FOR OUTPUT.
      LDB BUF       (B) = ADDR. OF BUFFER.
      JSB PUNCH     PUNCH RECORD
*
      LDA T1       CHECK AGAIN FOR COMPLETION OF
      CPA T2        PUNCHING BLOCK.
      JMP PNCHA,I   YES, EXIT.
      JMP P1        NO, SET NEXT RECORD.
      SKP
*
* SUBROUTINE: LTG  (LEADER/TRAILER GENERATOR)
*
*
*  LTG PRODUCES APPROXIMATELY 10-INCHES
*    OF BLANK TAPE (FEED-FRAMES)
*
LTG   NOP
      CLA           SET FEED FRAME MODE A=0
      JSB PUNCH     PUNCH FEED FRAMES
      JMP LTG,I     EXIT.
      SPC 5
*
* PUNCH BUFFER
*
BUF   DEF BUFFR
BUF1  DEF BUFFR+1
*
BUFFR BSS 30
BUFF  NOP
T1    NOP
T2    NOP
T3    NOP
T4    NOP
CKSUM NOP
      SPC 5
*
*    MESSAGE STORAGE SECTION
*
MA1   DEF MSG1
MSG1  ASC 14, PHOTO READER I/O ADDRESS?
MA2   DEF MSG2
MSG2  ASC 10, PUNCH I/O ADDRESS?
MA3   DEF MSG3
MSG3  ASC 15, TURN ON TTY PUNCH, PRESS RUN
MA4   DEF MSG4
MSG4  ASC 10, INVALID I/O ADDRESS
MA5   DEF MSG5
MSG5  ASC 13, SYSTEM DUMP I/O ADDRESS?
MA6   DEF MSG6
MSG6  ASC 6, CORE SIZE?
MA7   DEF MSG7
MSG7  ASC 8, IMPROPER INPUT
      SKP
*
*  CONSTANT AND DATA SECTION
*
MASK  OCT 177700
.200  DEC -200
M97   DEC -97
M36   DEC -36
N60   OCT -60
M27   DEC -27
M25   DEC -25
M24   DEC -24
M20   DEC -20
M15   DEC -15
M12   DEC -12
M5    DEC -5
CM.4  DEC -4
M1    DEC -1
C.03  DEC 3
.4    DEC 4
.20   DEC 20
.30   DEC 30
B77   OCT 77
.135  DEC 135
M377  OCT 377
UL52  OCT 52525
*
C8K   OCT 34000     ACCEPTABLE
C16K  OCT 30466       CORE
C24K  OCT 31064         SIZE
C32K  OCT 31462           ANSWERS
*
INCIN DEF *+1
      OCT 20000     RELOCATION
      OCT 40000
      OCT 60000       INCREMENTS
*
LWM   DEF EOTC      LAST WORD AVAILABLE
SERLA DEF SRIAL
*
SOURC NOP
DEST  NOP
CHC1  NOP
IOADR NOP
*
PNCHO DEF TOUT      PUNCH LINK LOCATION
PNCHI DEF POUT      PUNCH REFERENCE INSTRUCTION
*
LWAMR DEF .HSPR-1   LWAM IF PHOTO READER
LWAMP DEF .PNCH-1   LWAM IF PUNCH
      SKP
*
*  LIST OF INSTRUCTIONS (ADDRESSES) TO BE SET
*
*
*   TELETYPE INSTRUCTIONS ADDRESS LIST
*
LIST1 DEF TI.1
      DEF TI.2
      DEF TI.2+1
      DEF TI.3
      DEF TI.4
      DEF TI.5
      DEF TI.5+1
      DEF TI.6
      DEF TI.7
      DEF TI.7+1
      DEF TP.1
      DEF TP.2-1
      DEF TP.2
      DEF TP.4
      DEF TP.4+1
      DEF TP.5
      DEF TP.6
      DEF TP.7
      DEF TP.8
      DEF TP.9
      DEF TP.10
      DEF TP.11
      DEF TP.11+1
      DEF TP.11+2
*
LST1A DEF LIST1
*
*  PHOTO READER INSTRUCTIONS ADDRESS LIST
*
LIST2 DEF PR3
      DEF PR5
      DEF PR6
      DEF PR7
      DEF RO
*
RO    CLC RDR
LST2A DEF LIST2
*
*  HIGH SPEED PUNCH INSTRUCTIONS ADDRESS LIST
*
LIST3 DEF PN3
      DEF PN4
      DEF PN5
      DEF PN7
      DEF PO
*
PO    CLC PNCH
LST3A DEF LIST3
      SKP
*
*  SYSTEM DUMP INSTRUCTIONS ADDRESS LIST
*
LIST4 DEF PN8
      DEF POUT+1
      DEF POUT+2
      DEF POUT+3
*
LST4A DEF LIST4
      SPC 5
*
*  SKIP DIFFERENCE IN WORDS BETWEEN PARALLEL AND
*  SERIAL TELETYPE PACKAGES.
*
      BSS 22B       (STOPI-SPNCH)-(TT.II-.PNCH)
