ASMB,A,B,L

      HED *** PREPARE TIME-SHARE BASIC SYSTEM***
      ORG 22000B
      SUP
*
      SPC 10
*
*              TIME-SHARE BASIC DRIVERS AND MONITOR
*
*                         KILE B. BAKER
*                         JOHN S. SHEMA
*
*                      DATA RECORDING CENTER
*
*                    MONTANA STATE UNIVERSITY
*
*                           16K SYSTEM
*
*
      SKP
*
*     REVISION - A     JSS  CSL/MSU DEC. 21, 1971
*     ALL CORRECTIONS HAVE BEEN NOTED BY THE MARKING - [A]
*     THE FOLLOWING CORRECTIONS HAVE BEEN MADE:
* (1) CARD READER DRIVER  CANNOT INTERRUPT ITSELF DURING HEAVY
*     USAGE OF I/O BY OTHER CHANNELS.
*
* (2) SYSTEM IGNORES CALL FOR CARD READER OR PHOTOREADER
*     TO BE USED WITH INACTIVE OR NONEXISTANT CHANNEL.
*
*
***   LISTS OF INSTRUCTIONS TO BE MODIFIED
*
ZDLS1 DEF ZX1
      DEF ZX2
      DEF ZX2+1
      DEF ZX2+2
      DEF ZX2+7
      DEF ZX2+8
      DEF ZX2+9
      DEF ZX2+11
      DEF SRITB-1
*
***   LOG-TTY I/O INSTRUCTIONS
*
ZDLS2 DEF LTTY1    (OTA)
      DEF LTTY2    (OTA)
      DEF LTTY4
      DEF LTTY5
      DEF CHINL+1  (LIA)
      DEF CHINL+5  (OTB)
      DEF CHINL+6  (STC,C)
      DEF LTTY3    (OTA)
      DEF CHOTL+1  (OTB)
      DEF CHOTL+2  (OTA)
      DEF CHOTL+3  (STC,C)
      DEF CLCL+1   (CLC)
*
***   CLOCK I/O INSTRUCTIONS
*
ZDLS3 DEF CL1
      DEF CL2
      DEF CL3
      DEF CL4
      DEF STM
*
***   HIGH SPEED TAPE READER I/O INSTRUCTIONS
*
ZDLS4 DEF .RDR1
      DEF RDINT+3  (LIA)
      DEF ?OMIT    (STC,C)
      DEF ?LDR+3   (CLC)
      DEF .HSPR+5  (STC,C)
      DEF CRIN     (CLC)
*
***   CHANNEL 1 TTY I/O INSTRUCTIONS
*
ZDLS5 DEF CHIN1+1  (LIA)
      DEF CHIN1+5  (OTB)
      DEF CHIN1+6  (STC,C)
      DEF CHOT1+1  (OTB)
      DEF CHOT1+2  (OTA)
      DEF CHOT1+3  (STC,C)
      DEF CLC1+1   (CLC)
*
***   CHANNEL 2 TTY I/O INSTRUCTIONS
*
ZDLS6 DEF CHIN2+1  (LIA)
      DEF CHIN2+5  (OTB)
      DEF CHIN2+6  (STC,C)
      DEF CHOT2+1  (OTB)
      DEF CHOT2+2  (OTA)
      DEF CHOT2+3  (STC,C)
      DEF CLC2+1   (CLC)
*
***    CHANNEL 3 TTY I/O INSTRUCTIONS
*
ZDLS7 DEF CHIN3+1  (LIA)
      DEF CHIN3+5  (OTB)
      DEF CHIN3+6  (STC,C)
      DEF CHOT3+1  (OTB)
      DEF CHOT3+2  (OTA)
      DEF CHOT3+3  (STC,C)
      DEF CLC3+1   (CLC)
*
***   CHANNEL 4 TTY I/O INSTRUCTIONS
*
ZDLS8 DEF CHIN4+1  (LIA)
      DEF CHIN4+5  (OTB)
      DEF CHIN4+6  (STC,C)
      DEF CHOT4+1  (OTB)
      DEF CHOT4+2  (OTA)
      DEF CHOT4+3  (STC,C)
      DEF CLC4+1   (CLC)
ZDLS9 DEF TOUT3
      DEF PNCH&+1
      DEF PNCH&+2
      DEF PNCH&+3
      DEF &T1
*
*
***   CARD READER I/O INSTRUCTIONS
*
ZDL10 DEF SETM2+2  (CLC)
      DEF RCOL+2   (STC,C)
      DEF RCOL+4   (OTA)
      DEF CRDR1    (LIA,C)
*
***   MESSAGE PRINT TABLE
*
ZZG1  ASC 11,LOG TTY I/O ADDRESS?
ZZG2  ASC 10,INVALID I/O ADDRESS
ZZG3  ASC 10,NUMBER OF CHANNELS?
ZZG4  ASC 7,INVALID INPUT
ZZG5  ASC 14,CHANNEL   TTY I/O ADDRESS?
ZZG7  ASC 10,CLOCK I/O ADDRESS?
ZZG8  ASC 12,PHOTO READER IN SYSTEM?
ZZG9  ASC 6,YES OR NO:
ZAG10 DEF *+1
      ASC 8,ACCOUNT NUMBER?
ZAG11 DEF *+1
      ASC 11,INVALID ACCOUNT NUMBER
ZAG12 DEF *+1
      ASC 6,CODE WORD?
ZZ12  ASC 13,PHOTOREADER I/O ADDRESS?
ZAG14 DEF *+1
      ASC 11,ENTER CODE-WORD TABLE
ZZG15 ASC 17,DECIMAL FREE CORE AVAILABLE:
ZZG16 ASC 17,STANDARD FREE CORE IS DECIMAL
ZZG17 ASC 11,ACCEPT STANDARD CORE?
ZAG18 DEF *+1
      ASC 10,USER:   FREE CORE?
ZAG19 DEF ZAG18+4
ZZG20 ASC 12,ENTER INFORMATION TABLE
ZZG21 ASC 9,# LINES EXCEED 10
ZAG22 DEF *+1
      ASC 20,MEMORY REQUEST EXCEEDS AVAILABLE MEMORY
ZAG23 DEF *+1
      ASC 8,DUPLICATE ENTRY
ZAG25 DEF *+1
      ASC 18,CODE-WORD GIVEN SPECIFIES ACCOUNT:
      BSS 1
ZAG24 DEF *-1
ZAG26 DEF *+1
      ASC 7,ILLEGAL FORMAT
ZZG27 ASC 17,SYSTEM PUNCH DEVICE I/O ADDRESS?
ZZG28 ASC 2,*END
ZZG29 ASC 17,TURN ON TTY TAPE PUNCH, PRESS RUN
ZZG30 ASC 10,PUNCH ABSOLUTE TAPE?
ZZG31 ASC 11,CARD READER IN SYSTEM?
ZZG32 ASC 13,CARD READER I/O ADDRESS?
*
***     SUBROUTINE TO DIVIDE FREE CORE
*
ZFRC  NOP          FREE CORE SUBR.
      LDA ZRPLY
      STA ZANS     SET ZANS ADR
      JSB CRLF,I
      LDA FWFC,I   LOAD 1ST WD FR CORE
      CMA,INA
      INA
      ADA LWFC,I   FIND AMT FR CORE
      STA ZX       TEMP STORAGE
      LDA Z30      OUTPUT
      STA CCNT
      LDB ZG.15    TOTAL
      STB BADDR
      LDA ZX           AMT
      JSB OUTIN,I
      LDA CCNT           MESSAGE
      LDB ZAG15
      JSB ZCLOT,I
      LDA ZX       SUB ZLOT DESTR A
      CLB,INB
      STB ZONE     SETUP CNTR OF # OF USERS
      LDB &#USR,I  LOAD - NUMBER OF USERS
      CMB,INB      +NUM OF USERS
      CPB ZONE     ONE USER?
*
***   1 USER - STANDARD CORE = TOTAL CORE
*
      JMP ZWRT     YES
      ISZ ZONE     NO:TRY 2
      CPB ZONE     TWO USERS?
      RSS
      JMP *+3
*
***   2 USERS - DIVIDE BY 2
*
      ARS          YES:DIV BY 2
      JMP ZWRT
      ISZ ZONE     NO: TRY 3
      CPB ZONE     THREE USERS?
      RSS
      JMP ZWRT-1
*
***   3 USERS - DIVIDE BY 3
*
      LDB ZX       GET TOTAL CORE
      CLA          SET /3 COUNT = 0
      INA
      ADB M3       SUBTRACT 3 FROM TOTAL CORE
      SSB,RSS      FINISHED DIVISION?
      JMP *-3      NO - CONTINUE
      ADA M1       YES - TOO MANY SUBTRACT 1
      RSS          SET STND CORE
*
***   4 USERS - DIVIDE BY 4
*
      ARS,ARS      4 USERS-DIV BY 4
*
ZWRT  STA ZX       STND CORE
      LDA Z30      OUTPUT
      STA CCNT
      LDB ZG.16    STND
      STB BADDR
      LDA ZX           AMT
      JSB OUTIN,I
      LDA CCNT           MESG
      LDB ZAG16
      JSB ZCLOT,I
      JSB CRLF,I
      LDA X22      OUTPUT
      LDB ZAG17      OK
      JSB ZCLOT,I
      LDA M11
      LDB ZX9
      JSB ZCLOT,I
      LDA .2
      LDB ZRPLY
      JSB ZCLIN,I
      LDA ZRPLY,I
      CPA XYES       ANSWER
      JMP XSTND
*
ZRERE LDA FWFC,I   SET FIRST WORD
      STA XFWC     AVAILABLE CORE
      LDB LWFC,I   SET LAST WORD
      STB XLWC     AVAILABLE CORE
      CMA,INA      COMPUTE AMT
      INA
      ADA B        OF FREE CORE
      STA XFCR     REMAINING
*
      LDA &#USR,I  LOAD -# USERS
      STA ZCCT     AND SAVE AS COUNTER
      CLA,INA      SET TO CHANNEL
      STA ZCHNX    NUMBER ONE
*
ZRERD JSB CRLF,I   OUTPUT CR-LF
      LDA ZCHNX    LOAD CHANNEL NUMBER
      IOR .48      ADD ON ASCII BITS
      ALF,ALF      POSITION TO UPPER WORD
      IOR .32      ADD ON BLANK
      STA ZAG19,I  STORE IN MESSAGE
*
      LDA M19
      LDB ZAG18    "USER (N) FREE CORE"
      JSB ZCLOT,I
      LDA .6       ASK FOR
      LDB ZRPLY    TTY
      JSB ZCLIN,I  INPUT
      LDB ZRPLY    CONVERT TO
      JSB DVRT,I   BINARY
      JMP ZRERD    NOT-VALID INPUT
      SZA,RSS      REQUEST FOR ZERO CORE?
      JMP ZRERD    YES - REJECT
      STA XFCR     SAVE FREE CORE REQUESTED
      ADA MSK1     TOO SMALL REQUEST?
      SSA
      JMP ZRERD    NO-TRY AGAIN
*
***   SET USER FIRST WORD AVAILABLE MEMORY
*
      LDA XFWC     LOAD FIRST WORD FREE CORE
      LDB ZFWTB    LOAD FWFC TABLE BASE ADR
      ADB ZCHNX    INDEX BY CHANNEL #
      LDB B,I      LOAD STORE ADDRESS
      STA B,I      SET FIRST WORD AVAIL MEM.
*
***   SET USER LAST WORD AVAILABLE MEMORY
*
      ADA XFCR     INDEX F.W. BY AMT REQUESTED.
      ADA M1
      LDB ZLWTB    LOAD LWFC TABLE BASE ADR
      ADB ZCHNX    INDEX BY CHANNEL #
      LDB B,I      LOAD STORE ADDRESS
      STA B,I      SET LAST WORD AVAIL MEM.
      INA          INDEX TO NEXT WORD
      STA XFWC     SET NEW FIRST WORD CORE
*
      CMA,INA      SET A=NEG(A-1)
      INA
      ADA XLWC     ADD LW FREE CORE
      SSA
      JMP *+5      YES-ERROR MESSAGE
      ISZ ZCHNX    INDEX TO NEXT USER
      ISZ ZCCT     FINISHED?
      JMP ZRERD    NO-GET NEXT USER
      JMP ZFRC,I   YES-RETURN
*
*** ERROR ** FREE CORE SPACE EXCEEDED **
*
      JSB CRLF,I   OUTPUT CR-LF
      LDA Z39       OUTPUT MESSAGE:
      LDB ZAG22    "MEMORY REQUESTED EXCEEDS
      JSB ZCLOT,I  MEMORY AVAILABLE"
      JMP ZRERE    TRY AGAIN
*
*** SET   STANDARD CORE
*
XSTND LDA &#USR,I  GET -# USERS
      STA ZCCT     SET AS COUNTER
      LDA FWFC,I   LOAD FIRST WORD FREE CORE
      STA XFWC     SAVE AS POINTER
*
      CLA,INA      SET TO USER # 1
      STA ZCHNX
*
      LDA XFWC     LOAD FIRST WORD F CORE
      LDB ZFWTB    LOAD FWAM TABLE BASE ADR
      ADB ZCHNX    INDEX BY CHANNEL #
      LDB B,I      LOAD STORE ADR IN (B)
      STA B,I      SET USER FIRST WORD MEM
      ADA ZX       COMPUTE LAST WORD MEM
      ADA M1
      LDB ZLWTB    LOAD LWAM TABLE BASE ADR
      ADB ZCHNX    INDEX BY USER #
      LDB B,I      LOAD STORE ADDRESS
      STA B,I      SET USER LWAM
      INA          INDEX BY 1
      STA XFWC     SET NEW FWAM
*
      ISZ ZCHNX    INDEX TO NEXT USER
      ISZ ZCCT     FINISHED?
      JMP *-15     NO
      JMP ZFRC,I   YES-RETURN
*
***    LOAD AND CONSTRUCT CODE-WORD TABLE
*
CDTBL NOP
      LDB FWFC,I   GET FIRST WORD AVAIL FREE CODE
      STB ?ACCT,I  SET START OF ACCOUNT TABLE
      STB XCODE    STORE FOR CODE WORD STORAGE
      CLB          SET CODE TABLE
      STB XLNTH    LENGTH = 0
      STB XNTRY    # ENTRIES = 0
      JSB CRLF,I
      JSB CRLF,I
      LDA X21
      LDB ZAG14    OUTPUT MESSAGE" ENTER CODE
      JSB ZCLOT,I  -WORD TABLE"
ZLOP3 JSB CRLF,I   OUTPUT CR-LF
      JSB CRLF,I
      LDA M16      OUTPUT MESSAGE:
      LDB ZAG10    "ACCOUNT NUMBER?"
      JSB ZCLOT,I
*
      LDA X20      INPUT
      LDB XBUF     RESPONSE
      JSB ZCLIN,I  FROM TTY
      SZA,RSS      NULL INPUT?
      JMP ZLOP3    YES-TRY AGAIN
      LDB XBUF,I   LOAD FIRST CHARS
      CPB X/E      IS IT "/E"?
      JMP ZEND     YES-EXIT FROM ACCOUNT LOOP
*
      JMP ZOK1     NO - VALID INPUT
ZER3  JSB CRLF,I   OUTPUT CR-LF
      LDA X22      OUTPUT MESSAGE:
      LDB ZAG11    "INVALID ACCOUNT NUMBER"
      JSB ZCLOT,I
      JMP ZLOP3    TRY AGAIN
ZOK1  LDB XBUF     CONVERT TO BINARY
      JSB XVERT,I
      JMP ZER3     NOT VALID INPUT
      STA B        SAVE ACCOUNT # IN (B)
      ALF,RAR      POSITION
      ALF,RAR      ACCOUNT
      ALF,RAR      NUMBER
      STA ZACNT    AND STORE
      ADB ZM64     DOES ACCOUNT
      SSB,RSS      NUMBER EXCEED MAXIMUM
      JMP ZER3     OF 63?
*
ZLOP4 JSB CRLF,I   OUTPUT CR-LF
      LDA M11      OUTPUT MESSAGE:
      LDB ZAG12    "CODE WORD?"
      JSB ZCLOT,I
*
      LDA .72      INPUT RESPONSE
      LDB XBUF     RESPONSE
      JSB ZCLIN,I
*
      SZA,RSS      NULL INPUT?
      JMP ZLOP4    YES - TRY AGAIN
      STA ZSVA     SAVE CHARS INPUT LENGTH
*
***   CHECK FOR ILLEGAL FORMAT
*
      CPA .1
      JMP ZERR
      ADA M7       INPUT TOO LONG?
      SSA,RSS
      JMP ZERR     YES-ILLEGAL FORMAT
      LDA ZSVA     RELOAD INPUT COUNT
      INA          INDEX BY 1
      ARS          SHIFT RIGHT FOR WORDS
      CMA,INA      MAKE COUNT NEG
      STA XA1      SAVE AS WORD COUNTER
      LDB XBUF     SET BUFFER ADDRESS
      STB ZBF      POINTER
*
ZLOP6 LDA ZBF,I    LOAD WORD
      ALF,ALF      POSITION TO UPPER CHAR
      AND M177     MASK OFF UPPER CHAR
      CPA BLANK    SPACE?
      JMP ZERR     YES-ERROR
      LDA ZBF,I    RELOAD INPUT
      AND M177     MASK TO LOW CHAR
      CPA BLANK    SPACE?
      JMP *+5      YES-PROCESS MORE
      ISZ ZBF      NO-INDEX BUFFER POINTER
      ISZ XA1      FINISHED?
      JMP ZLOP6    NO-CONTINUE
      JMP ZCFDE    YES - INPUT O.K.
      LDB XA1      LAST WORD?
      CPB M1
      JMP ZCFDE    YES - INPUT O.K.
ZERR  JSB CRLF,I   OUTPUT CR-LF
      LDA Z14      OUTPUT MESSAGE:
      LDB ZAG26    "ILLEGAL FORMAT"
      JSB ZCLOT,I
      JMP ZLOP4    GET NEXT INPUT
*
***   CHECK FOR DUPLICATE ENTRY
*
ZCFDE LDA ZSVA     RELOAD # CHARS INPUT
      CMA,SSA,RSS  MAKE -1-# CHARS
      JMP ZLOP4    NOT VALID INPUT
      STA CCNT     SAVE LENGTH
      LDB XBUF     RELOAD BUFFER START ADR
      BLS          GET ADR*2
      STB BADDR    SAVE AS BUFFER POINTER
      JSB GETCR,I  GET A CHAR
      JMP ZLOP4    NOT VALID INPUT
      LDB LWFC,I   SET SYMBOL BUFFER
      ADB D100     START ADDRESS
      STB SBPTR    * INITIALIZE FOR
      STA SBPTR,I  * TABLE SEARCH
      LDA ?ACCT,I  TABLE ADR IN (A)
      LDB XNTRY    GET # ENTRIES
      CMB,INB,SZB,RSS  CONVERT TO NEG
      JMP ZPEIT
      JSB TSRCH,I  CHECK FOR DUPLICATE ENTRY
      JMP ZPEIT    PUT ENTRY IN TABLE
*
***   DUPLICATE ENTRY IN TABLE
*
      ALF,ALF      ROTATE ACCOUNT #
      RAR          TO CORRECT POSITION
      STA XCHN%    SAVE ACCOUNT NUMBER
      JSB CRLF,I   OUTPUT CR-LF
      LDA .15      OUTPUT MESSZGE:
      LDB ZAG23    "DUPLICATE ENTRY"
      JSB ZCLOT,I
      LDA .36      PUT
      STA CCNT     ACCOUNT
      LDB ZAG24    NUMBER
      STB BADDR    INTO
      LDA XCHN%    MESSAGE
      JSB OUTIN,I
      LDA CCNT     OUTPUT MESSAGE:
      LDB ZAG25    "CODE-WORD PREVIOUSLY
      JSB ZCLOT,I  SPECIFIED FOR ACCOUNT:(N)"
      JMP ZLOP4    TRY AGAIN
*
ZPEIT LDA ZSVA
      ADA ZACNT    INDEX BY ACCOUNT #

*
***    PUT ENTRY IN TABLE
*
      STA XCODE,I  STORE ACCOUNT #/LENGTH WORD
      ISZ XCODE    SET TO NEXT WORD
      ISZ XLNTH    INDEX LENGTH
      ISZ XNTRY    INDEX # OF ENTRIES
      LDA ZSVA     RELOAD CHARS INPUT COUNT
      CLE,SLA,INA  SET E=0 FOR FLAG
      CCE          SET E=1 FOR ODD # CHARS
      ARS          SHIFT AS WORD COUNTER
      STA ZSVA     SAVE AS COUNTER
      CLA,INA
      STA ZWCNT    WORD COUNTER = + 1
      LDA XBUF
      STA ZBF
ZLOP5 LDB ZWCNT
      CPB ZSVA     LAST CHAR?
      JMP ZLAST    YES-PROCESS IT
      ISZ ZWCNT    INDEX COUNTER
      LDA ZBF,I    LOAD WORD FROM INPUT BUFFER
      STA XCODE,I  PUT IN CODE WORD TABLE
      ISZ XCODE    INDEX TO NEXT ADR
      ISZ XLNTH    INDEX CODE TABLE LENGTH
      ISZ ZBF
      JMP ZLOP5
ZLAST LDA ZBF,I    LOAD LAST WORD
      ISZ XLNTH    INDEX CODE TABLE LENGTH
      SEZ          ODD/EVEN?
      IOR .32      ADD IN SPACE IF ODD
      STA XCODE,I  PUT IN CODE WORD TABLE
      ISZ XCODE    INDEX STORE ADR
      JMP ZLOP3    GET NEXT ACCOUNT
*
ZEND  LDB XNTRY    LOAD CODE WORD TABLE LENGTH
      CMB,INB,SZB,RSS   NULL CODE TABLE?
      JMP ZLOP3-5  YES-ASK FOR CODE TABLE INPUT
      STB ?TBL,I   SET # ENTRIES IN CODE TABLE
      LDB XCODE    SET NEW FIRST WORD
      STB FWFC,I   AVAILABLE MEMORY
      JMP CDTBL,I
*
*
***   PREPARE ABSOLUTE TAPE OF SYSTEM
*
ZABST JSB CRLF,I
      LDA X20      OUTPUT MESSAGE:
      LDB ZAG30    PUNCH ABSOLUTE TAPE?
      JSB ZCLOT,I
      LDA M11      OUTPUT MESSAGE:
      LDB ZX9      YES OR NO:
      JSB ZCLOT,I
      LDA .2       RESPONSE
      LDB ZRPLY
      JSB ZCLIN,I
      SZA,RSS      NULL INPUT?
      JMP ZABST    YES-TRY AGAIN
      LDA ZRPLY,I  GET FIRST TWO CHARS INPUT
      CPA XNO      = NO ?
      JMP 3B,I     YES - SKIP TAPE OUTPUT
      CPA XYES     = YES ?
      RSS          REQUEST PUNCH DEVICE
      JMP ZABST    NO VALID INPUT
ZABSD JSB CRLF,I
      LDA M33      OUTPUT MESSAGE:
      LDB ZAG27    SYSTEM PUNCH
      JSB ZCLOT,I
      LDA .4       GET
      LDB ZRPLY    TTY
      JSB ZCLIN,I  RESPONSE
      SZA,RSS      NULL INPUT?
      JMP STTYI    SET TTY AS PUNCH DEVICE
      CPA .2       TWO CHARS INPUT?
      JMP *+6      YES-CHECK FOR VALID I/O
*
ZER6  JSB CRLF,I   OUTPUT CR-LF
      LDA X20      OUTPUT MESSAGE:
      LDB XZG2     INVALID I/O ADDRESS
      JSB ZCLOT,I
      JMP ZABSD    TRY INPUT AGAIN
*
      LDA ZRPLY,I  LOAD 1ST CHARS INPUT
      ALF,ALF      POSITION
      JSB XNBER,I  CHECK FOR OCTAL
      JMP ZER6     NOT OCTAL-ERROR
      SZA,RSS      ZERO AS 1ST CHAR?
      JMP ZER6     YES-ERROR
      ALF,RAR      POSITION
      STA XI/O,I   SAVE 1ST CHAR
      LDA ZRPLY,I  RELOAD CHARS INPUT
      JSB XNBER,I  CHECK FOR OCTAL
      JMP ZER6     NOT OCTAL
      IOR XI/O,I
      STA XI/O,I   SAVE I/O CHANNEL
      LDA M4       4-ADR TO SET
      LDB ZLST9    SET I/O
      JSB XSETI,I  INSTRUCTIONS
*
***   PUNCH ELEMENTS OF SYSTEM PREPARED
*
COPY  JSB LTG      GENERATE LEADER
      LDA .2
      CCB          PUNCH FROM 2
      ADB FWFC,I   TO FWAM-1
      JSB PNCHA
*
      LDA $SEX$    PUNCH
      INA          BASIC INITIALIZATION
      LDB OINK     SECTION
      JSB PNCHA
      LDA LWFC,I
      INA          LWAM+1 TO
      LDB LWM      LAST WORD OF
      JSB PNCHA    MEMORY (37677B)
      JSB LTG      PUNCH TRAILER
      HLT 77B      END OF DUMP ROUTINE
      LIA 1        LOAD (A)=SWITCH REG
      CPA M15      SIGN BIT SET?
      JMP COPY     GO MAKE ANOTHER COPY
      JSB CRLF,I
      LDA .4       OUTPUT MESSAGE
      LDB ZAG28    *END
      JSB ZCLOT,I
      HLT 76B      FINISHED HALT
      JMP 3B,I
STTYI LDB XLCHN,I  LOAD SYSTEM I/O ADDRESS
      STB XI/O,I   SET FOR XSETI
      LDA M5       5-ADR TO BE SET
      LDB ZLST9    SET I/O
      JSB XSETI,I  INSTRUCTIONS
      JSB CRLF,I
      LDA .34      OUTPUT MESSAGE:
      LDB ZAG29    TURN ON TTY TAPE
      JSB ZCLOT,I
      HLT 11B      "READY" TO PUNCH HALT
      LDB HEWPY    SET TO OUTPUT
&T1   OTB 0        MODE
      JMP COPY     PUNCH SYSTEM
*
*     SUBROUTINE TO PUNCH ABSOLUTE BLOCK
*
*     CALLING SEQUENCE:
*     (A)=FWA OF BLOCK
*     (B)=LWA OF BLOCK
*     (P)= JSB PNCH.,I   (PNCH. DEF PNCHA)
*     (P+1)        (RETURN)
*
PNCHA NOP
      INB
      STA T1       SAVE FIRST AND LAST
      STB T2       WORD ADDRESSES
P1    LDA M27      SET T3= -27 AS INDEX
      STA T3       FOR FILLING BUFFER
      LDA T1       SET BUF+1 FOR LOAD ADR
      STA BUF1,I   OF CURRENT BLOCK
      STA CKSUM    INITIALIZE CHECKSUM WORD.
      CLA          SET WORD COUNTER
      STA BUF,I    TO ZERO.
      LDA BUF      SET T4 TO ADDRESS
      ADA .2       OF WORD 3 OF BUFFER
      STA T4       FOR STORING WORDS
P2    LDA T1,I     STORE CURRENT WORD FROM
      STA T4,I     MEMORY IN PUNCH BLOCK
      ISZ T1       INDEX TO NEXT LOAD AND
      ISZ T4       STORE ADDRESSES
      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
      STA T4,I     IN LAST WORD IN BUFFER
      LDA BUF,I    POSITION
      ALF,ALF      WORD COUNT TO UPPER
      STA BUF,I    CHARACTER WORD
      ALF,ALF      REPOSITION, ADD 3 FOR
      ADA .3       TOTAL RECORD LENGTH, SET
      CMA,INA      NEGATIVE FOR OUTPUT.
      LDB BUF      (B)=ADDR OF BUFFER
      JSB PUNCH    PUNCH RECORD
*
      LDA T1       FINISHED
      CPA T2       * PUNCHING
      JMP PNCHA,I  YES-EXIT
      JMP P1       NO-SET NEXT RECORD
*
*     SUBROUTINE:  LTG (LEADER/TRAILER GENERATOR)
*
*     CALL:
*     (P) JSB LTG
*     (P+1)        -RETURN-
*
*     LTG PRODUCES APPROXIMATELY 10-INCHES
*     OF BLANK TAPE (FEED/FRAMES)
*
LTG   NOP
      CLA
      JSB PUNCH
      JMP LTG,I
*
***   PUNCH BUFFER
*
***   SUBROUTINE TO PUNCH BINARY TAPE
*
*
*     CALLING SEQUENCE:
*     (A)=LENGTH (AND MODE) OF RECORD TO BE OUTPUT
*     (B)=STARTING ADDRESS OF DATA BUFFER
*
*
PUNCH NOP
      STB BUFF     SAVE BUFFER START ADDRESS
      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 CHAR 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 CHAR
      JSB PNCH&    OUTPUT CHAR
      SSB          INDEX BUFFER WORD?
      ISZ BUFF     YES
      RBL          INDEX U/L FLAG
      ISZ CHC1     INDEX COUNTER
      JMP PP02     CONTINUE PUNCHING
*
*     COMPLETION SECION
*
PP03  LDA M4       OUTPUT
      STA BUFF     FOUR
      CLA          FEED
      JSB PNCH&    OUTPUT CHAR
      ISZ BUFF     AT END
      JMP *-3      OF RECORD
*
TOUT3 CLC 0
      JMP PUNCH,I
*
***   PUNCH SINGLE CHAR
*
PNCH& NOP
      OTA 0        OUTPUT A
      STC 0,C      SINGLE CHAR
      SFS 0        ON PUNCH OUTPUT
      JMP *-1      DEVICE
      JMP PNCH&,I
*
HEWPY OCT 110000
.34   DEC 34
M33   DEC -33
OINK  DEF LEPIG
LWM   DEF LWAMS
$SEX$ DEF [SEX[
XLCHN DEF ZLCHN
XSETI DEF ZSETI
XNBER DEF ZNBER
XI/O  DEF ZI/O
ZLST9 DEF ZDLS9
ZAG27 DEF ZZG27
ZAG28 DEF ZZG28
ZAG29 DEF ZZG29
ZAG30 DEF ZZG30
DVRT  DEF DVERT
ZFWTB DEF *
      DEF FWAM1
      DEF FWAM2
      DEF FWAM3
      DEF FWAM4
ZLWTB DEF *
      DEF LWAM1
      DEF LWAM2
      DEF LWAM3
      DEF LWAM4
LWFC  DEF LWAFC
FWFC  DEF FWAFC
CRLF  DEF CRLND
ZCLOT DEF ZLOT
&#USR DEF &USR
X20   DEC 20
X22   DEC 22
Z39   DEC 39
ZX9   DEF ZZG9
XLNTH NOP
XCODE NOP
ZCLIN DEF ZLIN
XYES  ASC 1,YE
XNO   ASC 1,NO
XZG2  DEF ZZG2
ZAG15 DEF ZZG15
ZAG16 DEF ZZG16
ZG.15 DEF ZZG15+14
ZG.16 DEF ZZG16+14
XFWC  NOP
XLWC  NOP
ZCCT  NOP
XFCR  NOP
ZCHNX NOP
X21   DEC 21
Z30   DEC 30
ZAG17 DEF ZZG17
ZONE  BSS 1        TEMP STORAGE
ZX    BSS 1        AMT STND FR CORE
ZANS  NOP
ZRPLY DEF *+1      STORAGE FOR
      BSS 3          OCTAL NUM
*
BUF   DEF BUFFR
BUF1  DEF BUFFR+1
*
BUFFR BSS 30
BUFF  NOP
T1    NOP
T2    NOP
T3    NOP
T4    NOP
CKSUM NOP
CHC1  NOP
M27   DEC -27
.200  DEC -200
UL52  OCT 52525
ZSVA  NOP
Z14   DEC 14
ZM64  DEC -64
ZBF   NOP
ZACNT NOP
ZWCNT NOP
?TBL  DEF TBL
?ACCT DEF ACCT#
XNTRY NOP
XA1   NOP
XCHN% NOP
X/E   ASC 1,/E
XBUF  DEF ZBUF+1
XVERT DEF DVERT
      ORG 30000B
      SKP
*
PTSBS CLC 0        TURN OFF ALL DEVICES
      LIA 1        LOAD I/O ADDRESS OF TTY
      AND .63      MASK TO LOWER 6-BITS
      STA B        PUT ADDRESS IN B-REGISTER
      ARS,ARS      SHIFT TO BITS (5-3)
      ARS
      SZA          I/O ADDRESS >7?
      JMP ZGO      YES-INITIALIZE PREPARE BASIC TTY
*
      HLT 55B      INVALID I/O ADDRESS HALT
      JMP PTSBS    TRY AGAIN
*
ZGO   STB ZI/O     SAVE PREPARE TSB
      STB ZLCHN    TTY CHANNEL
      LDA M9       9 INSTRUCTIONS TO BE MODIFIED
      LDB ZLST1    START ADR OF INST LIST
      JSB ZSETI    SET I/O CHANNEL INST.
*
***   CALL FOR CLOCK I/O ADDRESS
*
      JSB CRLND    OUTPUT CR-LF
      LDA M19      OUTPUT MESSAGE:
      LDB ZA7      "CLOCK I/O ADDRESS?"
      JSB ZLOT
      JSB ZGADR    GET ADDRESS FROM TTY
      STB ZI/O     SAVE I/O ADDRESS
      LDA ZINS1    SET INTERRUPT CELL
      STA B,I      INSTRUCTION IN CLOCK CELL.
      LDA M5       5-ADDRESSES TO BE MODIFIED
      LDB ZLST3    SET I/O INSTRUCTIONS
      JSB ZSETI    FOR CLOCK.
*
***   CALL FOR LOG TTY I/O ADDRESS
*
      JSB CRLND
      JSB CRLND    OUTPUT RETURN
      LDA ZM22     OUTPUT MESSAGE:
      LDB ZAG1     "LOG TTY I/O
      JSB ZLOT     ADDRESS?"
      JSB ZGADR    INPUT LOG-TTY ADDRESS
      STB ZI/O     SAVE I/O ADDRESS
      LDA ZI/O6    SET INTERRUPT CELL
      STA B,I      LINKAGE INSTRUCTION
      LDA ZM12     12-ADDRESSES TO BE MODIFIED
      LDB ZLST2    INSTRUCTIONS ADDRESS LIST
      JSB ZSETI    SET I/O CHANNEL-LOG TTY
*
      LDA ZLST2    LOAD TABLE BASE ADR
      ADA Z5       INDEX BY 11
      LDA A,I      GET (OTB) INST ADR
      LDA A,I      GET INSTRUCTION
      STA ZTTYB,I  SET IN INITIALIZATION SECTION
      STA ZTTY[,I
*
      LDA ZLST2    LOAD TABLE BASE ADR
      ADA .11      INDEX BY 11
      LDA A,I      LOAD INST ADR
      LDA A,I      LOAD (CLC) INST
      STA ZTTYC,I  STORE IN INIT SECTION
*
***   GET NUMBER OF USERS (1-4)
*
      JSB CRLND
ZGNU  JSB CRLND    OUTPUT CR-LF
      LDA ZM20     OUTPUT MESSAGE:
      LDB ZAG3     "NUMBER OF CHANNELS?"
      JSB ZLOT
      LDA Z20      GET
      LDB ZBUF     RESPONSE
      JSB ZLIN     FROM TTY
      CPA .1       1 CHAR INPUT?
      JMP ZPRCS    OK- PROCESS IT
ZER2  JSB CRLND    OUTPUT CR-LF
      LDA Z13      OUTPUT MESSAGE:
      LDB ZAG4     "INVALID INPUT"
      JSB ZLOT
      JMP ZGNU     TRY AGAIN
*
ZPRCS LDB ZBUF     CONVERT TO BINARY
      JSB DVERT
      JMP ZER2     NOT VALID INPUT
      STA ZPNU     SAVE + # USERS
      CMA,INA,SZA,RSS   MAKE COUNT NEGATIVE
      JMP ZER2     AND PRINT ERROR IF 0
      STA ZNUSR    SAVE -# USERS
      ADA .4       INDEX BY 4
      SSA          USER #>4?
      JMP ZER2     YES-ERROR
      LDB ZNUSR    LOAD (B)= - # USERS
      STB Z#USR,I  SET -USERS COUNT FOR CLOCK
      STB Z&USR,I  SET -USERS COUNT FOR MONITOR
*
***   SET CHANNEL I/O ADDRESSES
*
      JSB CRLND
      CLA,INA      SET = USER # 1
      STA ZCHN#
*
ZLOP2 JSB CRLND    OUTPUT CR-LF
      LDA ZCHN#    LOAD CHANNEL #
      IOR .48      ADD ON ASCII # BITS
      ALF,ALF      POSITION TO UPPER WORD
      IOR .32      ADD ON BLANK
      STA ZA6,I    PUT IN PRINT BUFFER
      LDA ZM27     OUTPUT MESSAGE:
      LDB ZA5      "CHANNEL N TTY I/O
      JSB ZLOT     ADDRESS?"
      JSB ZGADR    GET ADDRESS
      STB ZI/O     AND SAVE
*
***   SET CHANNEL NUMBER INTO INTERRUPT TABLE
*
      LDA CTBL$
      ADA ZCHN#
      STB A,I
*
      LDA ZBTB1    LOAD INTERRUPT TABLE BASE
      ADA ZCHN#    ADDRESS & INDEX BY CHAN #.
      LDA A,I      LOAD INTERRUPT INSTRUCTION
      STA B,I      AND STORE IN INTERRUPT CELL
*
***   SET NEW FIRST WORD AVAILABLE FREE CORE
*
      LDA ZZFWA    LOAD TABLE BASE ADDRESS
      ADA ZCHN#    INDEX BY USER #
      LDA A,I      LOAD FWAM FROM TABLE
      STA FWAFC    STORE AS FWAM
*
***   CONFIGURE I/O INSTRUCTIONS
*
      LDB ZBTB2    LOAD INST. TABLE BASE ADR
      ADB ZCHN#    INDEX BY CHANNEL #
      LDB B,I      LOAD LIST ADDRESS
      STB ZCODE    SAVE LIST ADDRESS
      LDA M7       7 INSTRUCTIONS TO BE MODIFIED
      JSB ZSETI    MODIFY I/O INSTRUCTIONS
*
***   SET POWER FAIL INSTRUCTIONS
*
      LDA ZCODE    LOAD TABLE BASE ADR
      ADA .2       INDEX BY USER #
      LDA A,I      LOAD INST ADR
      LDA A,I      LOAD INST.
      LDB ZBTB4    LOAD TABLE BASE ADR
      ADB ZCHN#    INDEX BY USER #
      LDB B,I      LOAD DESTINATION ADR
      STA B,I      STORE INSTRUCTION
*

***   SET LOG-ON INITIALIZATION INSTRUCTIONS
*
      LDA ZCODE    LOAD LIST BASE ADDRESS
      ADA .1       INDEX BY 1
      LDA A,I      LOAD INST ADDRESS
      LDA A,I      LOAD INSTRUCTION (OTB)
      LDB ZTTYB    LOAD STORE ADDRESS BASE
      ADB ZCHN#    INDEX BY CHANNEL #
      STA B,I      SET INSTRUCTION (OTB)
*
      LDB ZBTB3    LOAD TABLE BASE ADR
      ADB ZCHN#    INDEX BY USER #
      LDB B,I      LOAD DESTINATION ADR
      STA B,I      STORE INSTRUCTION
      LDB ZBTB5
      ADB ZCHN#
      LDB B,I
      STA B,I
*
      LDA ZCODE    LOAD LIST BASE ADDRESS
      ADA .6       INDEX BY 6
      LDA A,I      LOAD INST ADR
      LDA A,I      LOAD INSTRUCTION (CLC)
      LDB ZTTYC    LOAD STORE BASE ADR
      ADB ZCHN#    INDEX BY USER #
      STA B,I      SET (CLC) INSTRUCTION
*
      ISZ ZCHN#    INDEX TO NEXT CHANNEL
      ISZ ZNUSR    DONE?
      JMP ZLOP2    NO-CONTINUE
*
***   CALL FOR CARD READER I/O ADDRESS
*
      CLA          CLEAR CARD READER IN SYSTEM FLAG
      STA CFLG$
      JSB CRLND
GCRIO JSB CRLND    OUTPUT CR-LF
      LDA Z22      OUTPUT MESSAGE:
      LDB ZAG31    "CARD READER IN SYSTEM?"
      JSB ZLOT
      LDA M11      OUTPUT MESSAGE:
      LDB ZA9      "YES OR NO?"
      JSB ZLOT
      LDA Z20      * INPUT
      LDB ZBUF     * RESPONSE
      JSB ZLIN
*
      SZA,RSS      NULL INPUT?
      JMP GCRIO    YES - TRY AGAIN
      LDA ZBUF,I   GET FIRST TWO CHARS INPUT
      CPA ZNO      =NO?
      JMP NOCRD    NO CARD READER SET NEW LWAM
      CPA ZYES     =YES?
      RSS          YES - GET CARD READER I/O ADR
      JMP GCRIO    INVALID RESPONSE - TRY AGAIN
*
      JSB CRLND    OUTPUT CR-LF
      LDA ZM25     OUTPUT MESSAGE:
      LDB ZAG32    "CARD READER I/O
      JSB ZLOT     ADDRESS?"
      JSB ZGADR    GET CHANNEL NUMBER
      STB ZI/O     SAVE FOR I/O MODIFICATION
      LDA ZI/O8    SET CARD READER
      STA B,I      INTERRUPT INSTRUCTION
      LDA ZM4      SET CARD READER
      LDB ZLS10    I/O INSTRUCTIONS
      JSB ZSETI
*
      LDA ZLS10    SET CLC
      LDA A,I      IN POWER FAIL
      LDA A,I
      STA CFRDR,I
*
      LDA JMP$1    PUT <JMP X3,I> INSTR
      STA ERRO.,I  IN 545B
*
      LDA JMP$2    PUT <JMP X1,I> INSTR
      STA RUN1,I   IN 2141B
*
      LDA JMP$3    PUT <JMP X2,I> INSTR
      STA RUN2,I   IN 2142B
      LDA JMP$4    LOAD <JMP X6,I> INSTR
      LDB $RUN$    LOAD ADDRESS TO MFASE IN BASIC
      ADB .2       INDEX BY 2
      STA B,I      MODIFY INSTRUCTION
      LDB $LST$    LOAD LINK TO LIST IN BASIC
      ADB .10      INDEX BY 10
      STA B,I      MODIFY INSTRUCTION
      ADB Z129     INDEX ADDRESS
      STA B,I      MODIFY INSTRUCTION
      ADB .3       INDEX ADDRESS
      STA B,I      MODIFY INSTRUCTION
      LDA X6       LOAD LINK WORD
      LDB $FS3$
      ADB M10      SUBTRACT 10
      STA B,I      MODIFY INSTRUCTION
      INB          INDEX STORE ADDRESS
      STA B,I      MODIFY INSTRUCTION
      STA CFLG$    SET CARD RDR IN SYSTEM FLAG
      JMP GPI/O-1  GET PHOTORDR CHANNEL NUMBER
*
NOCRD CLA          DELETE CHECK CARD READER
      STA ?CARD,I  INSTRUCTION IN MONITOR
      CCA          DELETE "CARD" COMMAND
      STA ?CRD?,I
      LDA LWACR    GET NEW LAST WORD MEM
      STA LWAFC    SET NEW LWAM
*
***   GET PHOTOREADER I/O ADDRESS
*
      JSB CRLND
GPI/O JSB CRLND    OUTPUT CR-LF
      LDA Z23
      LDB ZA8
      JSB ZLOT
      LDA M11
      LDB ZA9
      JSB ZLOT
      LDA Z20      INPUT
      LDB ZBUF     RESPONSE
      JSB ZLIN
      SZA,RSS      NULL INPUT?
      JMP GPI/O    YES-TRY AGAIN
      LDA ZBUF,I   GET INPUT CHARS
      CPA ZYES     =YES?
      JMP ZPRIO    GET PHOTOREADER I/O ADDRESS
      CPA ZNO      =NO?
      RSS          YES-DELETE PHOTOREADER DRIVER
      JMP GPI/O
*
      LDA ZCIT1+6  DELETE CHECK PHOTOREADER
      STA ?PHTO,I  INSTRUCTION IN MONITOR
      CCA          DELETE "PTAPE" COMMAND
      STA ?PHO?,I
      LDA CFLG$    CARD READER IN SYSTEM?
      SZA
      JMP LCCWT    YES - DO NOT RESET LWAM
      LDA PTINS,I  DELETE CHECK LOCALL TTY INPUT
      STA ZPTZ,I
      LDA LWPRD    GET NEW LAST WORD MEM
      STA LWAFC    UPDATE LAST WORD
      JMP LCCWT    ASK FOR CODE TABLE
*
ZPRIO JSB CRLND    OUTPUT CR-LF
      LDA M25      OUTPUT MESSAGE:
      LDB ZA12     "PHOTO READER I/O
      JSB ZLOT     ADDRESS?"
      JSB ZGADR    GET CHANNEL NUMBER
      STB ZI/O     SAVE FOR I/O MODIFICATION
      LDA ZI/O7    SET PHOTOREADER
      STA B,I      INTERRUPT INSTRUCTION
      LDA ZG.6     SET PHOTOREADER
      LDB ZLST4    I/O INSTRUCTIONS
      JSB ZSETI
      LDA ZLST4    SET CLC RDR
      LDA A,I      IN POWER FAIL
      LDA A,I
      STA PFRDR,I  RESTART
*
***   LOAD AND CONSTRUCT CODE WORD TABLE
*
LCCWT JSB CCWT,I
*
***   ENTER AND CONSTRUCT INFORMATION TABLE
*
ZCIT1 LDA ZLNTT    LOAD TABLE LENGTH ADR
      STA ZLNTH    SAVE FOR STORE POINTER
      LDB ZADRT    LOAD TABLE ADDRESS ADR
      STB ZSTOR    SAVE FOR STORE POINTER
      LDB FWAFC    GET FIRST WORD AVAIL MEM.
      STB ZCODE    SAVE AS STORE POINTER
*
      CLA          SET LINES "IN"
      STA ZCNT     COUNT TO ZERO
      LDB M11      SET MAX LINE COUNTER
      STB ZCHN#    TO MINUS 11.
*
      JSB CRLND
      JSB CRLND    OUTPUT CR-LF
      LDA .24      OUTPUT MESSAGE:
      LDB ZAG20    "ENTER INFORMATION TABLE"
      JSB ZLOT
*
ZCIT2 JSB CRLND    OUTPUT CR-LF
      LDA .72      INPUT 72 CHARS
      LDB ZBUF     INTO ZBUF
      JSB ZLIN
      LDB ZBUF,I   GET FIRST TWO CHARS INPUT
      CPB /E       END-OF-INPUT?
      JMP ZCIT3    YES - COMPRESS TABLE
      SZA,RSS      NULL INPUT?
      JMP ZCIT2+1  YES - GET NEXT LINE
      ISZ ZCHN#    TOO MANY LINES?
      JMP *+6      NO - ACCEPT NEW LINE
      JSB CRLND    OUTPUT ERROR MESSAGE:
      LDA Z18
      LDB ZAG21    "# LINES EXCEEDS 10"
      JSB ZLOT
      JMP ZCIT1    RE-ENTER TABLE
*
***   PROCESS NEW LINE
*
      ISZ ZCNT     INDEX LINE COUNTER
      STA ZLNTH,I  SAVE LINE LENGTH
      STA *+8      SAVE IN CALL TO MOVE STACK
      LDB ZCODE    LOAD STORE ADDRESS
      STB ZSTOR,I  SAVE IN ADR TABLE
      ADA B        INDEX (A) BY (B)
      STA ZCODE    SET NEW F.W.A.M.
      LDA ZBUF     SOURCE ADR IN (A)
      LDB ZSTOR,I  DEST ADR IN (B)
      JSB ?MOVE,I  MOVE STACK OF
      NOP          (NOP) ELEMENTS
*
      ISZ ZLNTH    INDEX
      ISZ ZSTOR    TABLE POINTERS
      JMP ZCIT2    GET NEXT ENTRY
*
ZCIT3 LDB ZCNT     LOAD LINES-IN COUNT
      CMB,INB,SZB,RSS  IF ZERO THEN-
      JMP ZCIT1    ASK AGAIN FOR INPUT
      STB Z?LNT,I  STORE-# LINES IN LOG-IN
      LDB ZCNT     RELOAD # LINES
      STB *+5      SAVE FOR MOVE STACK
      LDA ZLNTT    LOAD (A)=SOURCE ADR
      LDB ZCODE    (B)=DEST ADR
      STB Z?TBL,I  SAVE START ADR IN LOG-IN
      JSB ?MOVE,I  MOVE STACK OF LENGTH
      NOP          VALUES
      LDB ZCODE    LOAD FWAM
      ADB ZCNT     UPDATE BY VALUE IN (ZCNT)
      STB ZCODE    SAVE RESULT
      STB Z?ADR,I  SAVE ADR TABLE ADR IN LOG-IN
      LDA ZCNT     LOAD # LINES INPUT AND
      STA *+3      STORE FOR MOVE-STACK
      LDA ZADRT    LOAD (A)=SOURCE ADR
      JSB ?MOVE,I  MOVE STACK OF ADDRESS
      NOP          VALUES
      LDB ZCODE    RESET FIRST
      ADB ZCNT     WORD AVAILABLE
      STB FWAFC    FREE CORE.
*
      JSB ZFCOR,I
      LDB ZSEXZ    SET START ADR
      STB 3B       IN 3B
      JSB CRLND
      JMP #PT#,I   PUNCH SYSTEM TAPE
*
*
***   SUBROUTINE TO CONVERT CHARACTER TO OCTAL
*
ZNBER NOP
      AND M177     MASK TO LOWER 6-BITS
      ADA ZN60     INDEX BY -OCT60
      STA B        SAVE IN (B)
      BRS,BRS      SHIFT OUT BITS
      BRS          (0-2)
      SZB,RSS      TEST FOR ZERO REMAINDER
      ISZ ZNBER    SET "SUCCESS" EXIT
      JMP ZNBER,I  RETURN
*
***   SUBROUTINE TO MODIFY THE INSTRUCTIONS IN A LIST
*
ZSETI NOP
      STA ZCNT     SAVE # WORDS TO MODIFY
      STB ZBUFF    SAVE BASE ADDRESS
ZLP1  LDB ZBUFF,I  LOAD ADDRESS
      LDA B,I      ACCESS INSTRUCTION
      AND D100     MASK OFF BITS (0-5)
      IOR ZI/O     ADD ON CHANNEL NUMBER
      STA B,I      RESTORE INSTRUCTION
      ISZ ZBUFF    INDEX TO NEXT WORD IN LIST
      ISZ ZCNT     DONE?
      JMP ZLP1     NO
      JMP ZSETI,I  YES-RETURN
*
*
***   SUBROUTINE TO INPUT CHANNEL # FROM TTY
*
ZGADR NOP
      LDA Z20      SET TO INPUT 20 CHARS
      LDB ZBUF     GIVE I/O BUFFER ADDRESS
      JSB ZLIN     GET INPUT FROM TTY
*
      CPA .2       2 CHARS INPUT?
      JMP ZTWO     YES-PROCESS
*
ZERRR JSB CRLND
      LDA Z20      OUTPUT MESSAGE:
      LDB ZAG2     "INVALID I/O
      JSB ZLOT     ADDRESS"
      JSB CRLND    GET NEW INPUT
      JMP ZGADR+1
*
ZTWO  LDA ZBUF,I   LOAD FIRST CHARS
      ALF,ALF      FROM TTY INPUT
      JSB ZNBER    BUFFER.
      JMP ZERRR    NOT A NUMBER
      SZA,RSS      TEST IF ZERO
      JMP ZERRR    NOT A NUMBER
      ALF,RAR      POSITION NUMBER
      STA ZI/O     SAVE IT
      LDA ZBUF,I   GET NEXT CHAR
      JSB ZNBER    IS IT A NUMBER?
*
      JMP ZERRR    NOT A NUMBER
      IOR ZI/O     ADD ON PREVIOUS NUMBER
      STA B        PUT IN B-REG
      JMP ZGADR,I  RETURN
*
***   FIRST WORD AVAILABLE MEMORY TABLE
*
ZZFWA DEF *
      DEF SK2
      DEF SK3
      DEF SK4
      DEF FINIS
*
***   LINKS TO LISTS OF INSTRUCTIONS TO BE MODIFIED
*
ZLST1 DEF ZDLS1
ZLST2 DEF ZDLS2
ZLST3 DEF ZDLS3
ZLST4 DEF ZDLS4
ZLS10 DEF ZDL10
*
***   LINKS TO MESSAGE PRINT TABLE
*
ZAG1  DEF ZZG1
ZAG2  DEF ZZG2
ZAG3  DEF ZZG3
ZAG4  DEF ZZG4
ZA5   DEF ZZG5
ZA6   DEF ZZG5+4
ZA7   DEF ZZG7
ZA8   DEF ZZG8
ZA9   DEF ZZG9
ZA12  DEF ZZ12
ZAG20 DEF ZZG20
ZAG21 DEF ZZG21
ZAG31 DEF ZZG31
ZAG32 DEF ZZG32
*
***   CONSTANTS AND DATA DECLARATIONS
*
A     EQU 0
B     EQU 1
ZBTB1 DEF *
      JSB I/O2,I
      JSB I/O3,I
      JSB I/O4,I
      JSB I/O5,I
*
ZBTB2 DEF *
      DEF ZDLS5
      DEF ZDLS6
      DEF ZDLS7
      DEF ZDLS8
ZBTB3 DEF *
      DEF LTTY4+1
      DEF LTTY4+2
      DEF LTTY4+3
      DEF LTTY4+4
*
ZBTB4 DEF *
      DEF LTTY5+1
      DEF LTTY5+2
      DEF LTTY5+3
      DEF LTTY5+4
*
ZBTB5 DEF *
      DEF LTTY4+6
      DEF LTTY4+8
      DEF LTTY4+10
      DEF LTTY4+12
*
ZG.6  DEC -6
Z5    DEC 5
.11   DEC 11
Z13   DEC 13
Z20   DEC 20
.24   DEC 24
Z18   DEC 18
Z21   DEC 21
Z22   DEC 22
Z23   DEC 23
Z129  DEC 129
ZM12  DEC -12
ZM20  DEC -20
ZM22  DEC -22
ZM24  DEC -24      CHARS IN MESG.
ZM27  DEC -27
ZN60  OCT -60
CFLG$ NOP
ZCHN# NOP
ZNUSR NOP          - # USERS
ZPNU  NOP          + # USERS
ZI/O  NOP
ZCNT  NOP
ZSTOR NOP
PTINS DEF CKL+8
CTBL$ DEF CHTBA
ZPTZ  DEF .LD.-1
Z&USR DEF &USR
Z#USR DEF #USRS
ZLCHN NOP
ZCODE NOP
ZBUFF NOP
ZLNTH NOP
ZNTRY NOP
ZBUF  DEF *+1
      BSS 72
/E    ASC 1,/E
ZNO   ASC 1,NO
ZYES  ASC 1,YE
ZTTY[ DEF ZT[
ZTTYB DEF SRITB+1
ZTTYC DEF ZCLCZ
ZINS1 JSB I/O1,I
ZI/O6 JSB I/O6,I   LOG TTY INT CELL INST
ZI/O7 JSB I/O7,I   PHOTRDR INT CELL INST
ZI/O8 JSB I/O8,I   CARD READER INT CELL INST
?CARD DEF CKPTR
?PHTO DEF CKPTR+1
?CRD? DEF CA
?PHO? DEF PT
PFRDR DEF ?PFLI
CFRDR DEF ?PFLI+1
FWAFC DEF STCKS
LWAFC DEF LWTSB-1
LWACR DEF .HSPR-1
LWPRD DEF MSSG-1
*
ZADRT DEF *+1      DEFINES INFO TABLE TEMP ADRS
      BSS 10
ZLNTT DEF *+1      DEFINES INFO TABLE TEMP LNGTS
      BSS 10
Z?LNT DEF SYIN#
Z?TBL DEF SLENA
Z?ADR DEF SINA
ZFCOR DEF ZFRC
ZSEXZ DEF .SEX.
#PT#  DEF ZABST
*
ERRO. DEF ..ERR
RUN1  DEF RN.$.
RUN2  DEF RN.$.+1
JMP$1 JMP X4,I
JMP$2 JMP X1,I
JMP$3 JMP X2,I
JMP$4 JMP X6,I
CCWT  DEF CDTBL
ZM25  DEC -25
ZM4   DEC -4
      HED ***** TIME-SHARE BASIC DRIVERS AND MONITOR *****
.SEX. CLC 0
      JSB CRLND
*
***   INITIALIZE CLOCK
*
?I1   JSB CRLND    OUTPUT CR-LF
      LDA ZTI1     OUTPUT MESSAGE:
      LDB ZTA1     "YEAR?"
      JSB ZLOT
      LDA .4       INPUT RESPONSE OF YEAR
      LDB PTBA?
      JSB ZLIN
      CPA .2       TWO CHARS INPUT?
      RSS          YES - INPUT O.K.
      JMP ?I1      NO - TRY AGAIN
*
      LDB PTBA?    CONVERT TO
      JSB DVERT    BINARY
      JMP ?I1      INVALID INPUT
      LDA PTBA?,I
      STA YBUF,I
*
?I2   JSB CRLND    OUTPUT CR-LF
      LDA ZTI2     OUTPUT MESSAGE:
      LDB ZTA2     "MONTH?"
      JSB ZLOT
      LDA .4       INPUT RESPONSE OF MONTH
      LDB PTBA?
      JSB ZLIN
      CPA .2       TWO CHARS INPUT?
      RSS          YES - INPUT O.K.
      JMP ?I2      NO - TRY AGAIN
*
      LDB PTBA?    CONVERT TO
      JSB DVERT    BINARY
      JMP ?I2      INVALID INPUT
      SZA,RSS      MONTH=0?
      JMP ?I2      YES-REJECT
      ADA ZM13     SUBTRACT 13
      SSA,RSS      MONTH<13?
      JMP ?I2      NO-REJECT
      LDA PTBA?,I
      STA MBUF,I
*
?I3   JSB CRLND    OUTPUT CR-LF
      LDA ZTI3     OUTPUT MESSAGE:
      LDB ZTA3     "DAY"?
      JSB ZLOT
      LDA .4       INPUT RESPONSE OF DAY
      LDB PTBA?
      JSB ZLIN     DAY BUFFER
      CPA .2       TWO CHARS INPUT?
      RSS          YES - INPUT O.K.
      JMP ?I3      NO - TRY AGAIN
      LDB PTBA?    CONVERT TO
      JSB DVERT    BINARY
      JMP ?I3      INVALID INPUT
*
      STA DATE?,I  NO-SAVE DATE
      LDA PTBA?,I

      STA ?DBUF,I
*
***   GET TIME
*
?I5   JSB CRLND
      LDA ZTI4     OUTPUT MESSAGE:
      LDB ZTA4     "TIME?"
      JSB ZLOT
      LDA .6       INPUT RESPONSE
      LDB PTBA?    AND STORE IN
      JSB ZLIN     TIME BUFFER
      CPA .4       4 CHARS INPUT?
      RSS          YES - INPUT O.K.
      JMP ?I5      NO - TRY AGAIN
      LDA .2       CONVERT
      LDB PTBA?    TO
      JSB DVERT    BINARY
      JMP ?I5      INVALID INPUT
      STA HR?,I    SAVE HOURS COUNT
      ADA M25
      SSA,RSS      HOURS>24?
      JMP ?I5      YES-REJECT
      LDA .2       CONVERT
      LDB PTBA?    INPUT
      INB          TO
      JSB DVERT    BINARY
      JMP ?I5      INVALID INPUT
      STA MNTS?,I  STORE MINUTES
      ADA ZM61     MINUTES >60?
      SSA,RSS
      JMP ?I5      YES-REJECT
      JSB CRLND
*
***   TIME SHARE BASIC INITIALIZATION SECTION
*
      LDB &&USR,I  GET -# USERS
      STB ?CT,I    SAVE AS COUNTER
      CLB,INB      SET TEMPS
      STB USN      TO FIRST
      STB ?USNT,I  USER
*
?LP1  LDA ?ON      LOAD LINK TO -ON- ROUTINE
      LDB BSTK5    LOAD LINKAGE TABLE BASE ADDRESS
      ADB USN      INDEX BY USER #
      LDB B,I      LOAD DESTINATION ADDRESS
      STA B,I      STORE LINK IN WRITE RETURN
*
      LDA M15      SET DATA FLAG
      LDB BSTK4    LOAD DATA FLAG TABLE BASE ADR
      ADB USN      INDEX BY USER #
      LDB B,I      LOAD DATA FLAG ADR IN (B)
      STA B,I      SET DATA FLAG
*
***   INITIALIZE USER STACKS
*
      LDA BSTK6    LOAD STACK NAME BASE ADDRESS
      ADA USN      INDEX BY USER #
      LDA A,I      LOAD USER STACK NAME
      LDA A,I
      LDB ASTK     LOAD ADDR OF ACTIVE STACK
      JSB ?MOVE,I  MOVE 5 ELEMENTS STACK
      OCT 5
*
      LDA LWAM
      ADA M72
      STA .BUFA
      STA SYMTA
      ADA D97
      STA SBUFA
      ADA M1
      STA LWAM
      LDA FWAM     LOAD FIRST WORD
      STA PBUFF    INITIALIZE PROGRAM BUFFR
      STA PBPTR    INITIALIZE PROG POINTR
      LDA .32      LOAD OCT 40
      STA BLANK    INITIALIZE BLANK CHARACTER
      CLA
      STA .LNUM    SET LINE NUMBER =0
      LDB BSTK6    LOAD STACK NAME BASE ADDRESS
      ADB USN      INDEX BY USER NAME
      LDB B,I      LOAD USER STACK NAME
      LDB B,I
      JSB ?MOUT,I  MOVE ACTIVATED STACK OUT
*
*
*
      ISZ USN      INDEX TO NEXT
      ISZ ?USNT,I  USER.
      ISZ ?CT,I    LAST USER?
      JMP ?LP1     NO-PROCESS NEXT USER
*
*
***   SET RUBOUTS INTO TTYS AND CLC
*
      CLC 0        CLEAR PREPARE SYSTEM TTY
SRITB LDB RBOUT    LOAD RUBOUT CHAR
      NOP          (OTB LOG TTY)
      NOP          (OTB USER # 1)
      NOP          (OTB USER # 2)
      NOP          (OTB USER # 3)
      NOP          (OTB USER # 4)
      CLA          SET SECONDS ELAPSED
      STA SEKS?,I  TIME TO ZERO
      CCA          SET FLAG1 TO -1
      STA ?FL1,I
      LDA &&USR,I  SET LAST ACTIVATED USER # IN USN
      CMA,INA
      STA USN
ZCLCZ NOP          (CLC LOG TTY)
      NOP          (CLC USER # 1)
      NOP          (CLC USER # 2)
      NOP          (CLC USER # 3)
      NOP          (CLC USER # 4)
      LDA .4
CL1   OTA 0        INITIATE TIME-BASE
      STC PFL      INITIATE POWER FAIL
CL2   STC 0,C      GENERATOR
      STF 0        TURN ON INTERRUPT
      JMP ?ON,I    GO TO LOG-ON SECTION
*
***   SUBROUTINE TO CONVERT ASCII NUMBERS TO DECIMAL
*
*
***   NON-INTERRUPT TTY DRIVER FOR PREPARE TIME-SHARE
*
ZLOT  NOP          SUBROUTINE TO OUTPUT A RECORD
      STA ZL1      SAVE LENGTH
      STB ZA1      SAVE ADDRESS
      LDB OT.FL    LOAD OUTPUT COMMAND
ZX1   OTB 0        SET TTY TO OUTPUT MODE
      SZA,RSS      ZERO CHAR?
      JMP CR.LF    YES-GIVE CARRIAGE RETURN-LF
      SSA,RSS      CHECK IF COUNT NEGATIVE
      CMA,INA      NO-MAKE IT NEGATIVE
      STA ZCT1     STORE NEGATIVE COUNT
      LDB ZULFL    LOAD UPPER / LOWER FLAG
*
C..C  LDA ZA1,I    GET WORD FROM BUFFER
      RBL          ROTATE AND
      SLB          TEST FLAG
      ISZ ZA1      INDEX TO NEXT WORD
      SLB,RSS      LOAD CORRECT CHARACTER
      ALF,ALF      UPPER / ROTATE TO LOWER
      AND M177     GET SINGLE CHAR
      IOR M200     ADD PARITY BIT
      JSB ZXLOT
      ISZ ZCT1     LAST CHARACTER?
      JMP C..C     NO-GET NEXT TO OUTPUT
*
***   CHECK IF CR-LF
*
      LDA ZL1      CHECK ORIGINAL COUNTER
      SSA
      JMP ZLOT,I   NEGATIVE - RETURN
CR.LF LDA ZCRET    POSITIVE - CR-LF
      JSB ZXLOT
      LDA ZLNFD    LOAD LF
      JSB ZXLOT
      JMP ZLOT,I   RETURN
*
***   SUBROUTINE TO INPUT A RECORD
*
ZLIN  NOP
      CMA,INA      MAKE COUNT NEGATIVE
      STA ZCT1     SAVE COUNTER
      STA ZCT2     SAVE FOR RESET
      STB ZA1      SAVE ADDRESS
      STB ZA2      SAVE FOR RESET
*
      CLB          CLEAR TRUE COUNTER
      STB ZL2
*
ZNXTC JSB ZXLIN
      SZA,RSS      SKIP IF NOT NULL CHAR
      JMP ZNXTC
      CPA ZLNFD
      JMP ZNXTC
      CPA ZCRET    CR?
      JMP ZZDNE    YES - GO TO END SECTION
      CPA ZESCP    ESC CHAR?
      JMP ZDEL     YES-DELETE LINE
      CPA ZMODE    ALT MODE ?
      JMP ZDEL     YES - DELETE LINE
      LDB ZCT1     LOAD NEGATIVE COUNT
      INB,SZB      SKIP IF B IS POSITIVE
      SSB          CHAR IS NEG OR ZERO -OK
      RSS          IGNORE AND GO FOR NEXT CHAR
      JMP ZNXTC
      STB ZCT1     RESTORE COUNT
      LDB ZL2      LOAD POSITIVE COUNT
      SLB,INB,RSS  TEST AND INCREMENT
      ALF,SLA,ALF  UPPER CHAR-POSITION IT
      IOR ZA1,I    LOWER CHAR-MERGE CHAR
      STA ZA1,I    STORE WORD.
      SLB,RSS      NEW WORD?
      ISZ ZA1      YES
      STB ZL2      STORE POSITIVE COUNTER
      JMP ZNXTC    GET NEXT CHARACTER
*
ZZDNE LDA ZL2      LOAD LENGTH
      JMP ZLIN,I   RETURN
ZDEL  CLA          OUTPUT A
      JSB ZLOT     CR-LF
      LDA ZCT2     LOAD LENGTH
      STA ZCT1     RESET IN CALL PARAMETER
      LDA ZA2      LOAD ADDRESS
      STA ZA1      RESET IN CALL PARAMETER
      JMP ZNXTC-2  SET UP NEW INPUT
*
***   SINGLE CHARACTER DRIVERS
*
ZXLOT NOP
ZX2   OTA 0
      STC 0,C
      SFS 0
      JMP *-1
      JMP ZXLOT,I
*
ZXLIN NOP
      LDB IN.FL
      OTB 0
      STC 0,C
      SFS 0
      JMP *-1
      LIA 0
      AND M177     MASK TO LOWER 7-BITS
      JMP ZXLIN,I
*
***   SUBROUTINE TO OUTPUT A CR-LF.
*
CRLND NOP
      CLA          SET UP AND EXECUTE A
      JSB ZLOT     CALL TO OUTPUT DRIVER
      JMP CRLND,I   TO OUTPUT A CR-LF
*
DVERT NOP          ENTRY/EXIT POINT
      CMA,INA,SZA,RSS  TEST FOR ZERO RCRD LNTH
      JMP XRETX
      STB ZL1      SAVE BUFFER START ADR
      STA ZA1      SAVE CHAR COUNTER
      CLA          SET A=0
      STA ZA2      SET NUMBER COUNT TO ZERO
      STA ZL2      SET ODD/EVEN FLAG TO ZERO
      LDB ZL2      LOAD ODD/EVEN FLAG
P1..  LDA ZL1,I    FETCH CONTENTS OF BUFFER
      SLB,RSS      SKIP IF EVEN
      ALF,ALF      POSITION BYTES CORRECTLY
      AND M177     MASK TO LOWEST BYTE
      CPA .32      TEST FOR SPACE
      JMP .NEXT    IS A SPACE, THROW IT OUT
      SZA,RSS      TEST FOR A NULL CHARACTER
      JMP .NEXT    IS A NULL, THROW IT OUT
      STA XTMP     SAVE CHARACTER
      ADA OCT60    SUBTRACT OCTAL 60
      SSA          TEST IF BELOW NUMBER RANGE
      JMP .NEXT    NOT A NUMBER, IGNORE
      ADA M10      SUBTRACT DEC 10
      SSA,RSS      TEST IF GREATER THAN OCT 71
      JMP .NEXT    NOT A NUMBER, IGNORE
      LDA XTMP     RESTORE CHARACTER
      AND .15      MASK TO NUMBER PART
      LDB ZA2      LOAD PARTIAL NUMBER INTO B
      CLO          CLEAR OVERFLOW FLAG
      BLS,BLS      MULTIPLY BY TEN
      ADB ZA2      ADD ON ONES
      BLS
      ADB A        THEN-
      STB ZA2      STORE RESULT
      SOC          TEST FOR OVERFLOW
      JMP OVFLW    GO TO OVERFLOW RETURN
.NEXT ISZ ZL2      INDEX ODD/EVEN FLAG
      LDB ZL2      LOAD ODD/EVEN FLAG
      SLB,RSS      TEST STATUS
      ISZ ZL1      SET TO NEXT WORD IN BUFFER
      ISZ ZA1      TEST IF ALL NUMBERS PROCESSED
      JMP P1..     NOT FINISHED, COMTINUE
      LDA ZA2      FETCH COMPLETE CONVERTED #
XRETX ISZ DVERT
OVFLW JMP DVERT,I  RETURN WITH RESULT IN A
*
***   LINKS TO OTHER PLACES AND THINGS
*
D97   DEC -97
M72   DEC -72
?FL1  DEF FLAG1
?USNT DEF USNT
CLTMA DEF CLTM
?ON   DEF LOGON
?CT   DEF CT
?MOUT DEF MVUOT
?MOVE DEF MVSTK
?MON  DEF MONIT
MNTS? DEF MINTS
HR?   DEF HOUR
PTBA? DEF PTBUF
DATE? DEF DATE
SEKS? DEF SEKS
MBUF  DEF LGOM4+9
?DBUF DEF LGOM4+11
YBUF  DEF LGOM4+13
ZL1   NOP
ZA1   NOP
OT.FL OCT 120000
IN.FL OCT 160000
ZCT1  NOP
ZULFL OCT 52525
ZCRET OCT 15
ZLNFD OCT 12
ZCT2  NOP
ZA2   NOP
ZL2   NOP
ZMODE OCT 33
ZESCP OCT 176
ZCTE  NOP
BSTK4 DEF *
      DEF DATA1
      DEF DATA2
      DEF DATA3
      DEF DATA4
BSTK5 DEF *
      DEF WRIT1
      DEF WRIT2
      DEF WRIT3
      DEF WRIT4
BSTK6 DEF *
      DEF BSK1
      DEF BSK2
      DEF BSK3
      DEF BSK4
&&USR DEF &USR
XTMP  NOP
OCT60 OCT -60
ZM13  DEC -13
ZM61  DEC -61
ZTI1  DEC -6
ZTA1  DEF *+1
      ASC 3,YEAR?
ZTI2  DEC -7
ZTA2  DEF *+1
      ASC 4,MONTH?
ZTI3  DEC -5
ZTA3  DEF *+1
      ASC 3,DAY?
ZTI4  DEC -6
ZTA4  DEF *+1
      ASC 3,TIME?
LEPIG EQU *
      SKP
      ORG 33710B                                 [A]
LWTSB EQU *
ETBL  ASC 10, 1234567890*;#$@ UX.
      ASC 10,)-^>:%'TWZ(+/<"?&SVY
OTBL  ASC 10, 1234567890CFILORUX.
      ASC 10,,BEHKNQTWZ=ADGJMPSVY
      OCT 6414     =DEC 13,12, OCT 15,14
      OCT 10421    =DEC 17,17, OCT 21,21
      OCT 13027    =DEC 22,23, OCT 26,27
      OCT 15432    =DEC 27,26, OCT 33,32
      OCT 17437    =DEC 31,31, OCT 37,37
      OCT 21443    =DEC 35,35, OCT 43,43
      OCT 23451    =DEC 39,41, OCT 47,51
      OCT 27056    =DEC 46,46, OCT 56,56
      OCT 31066    =DEC 50,54, OCT 62,66
OTBLZ OCT 4406     =DEC 09,09, OCT 11,06         [A]
      OCT 401      =DEC 01,01, OCT 01,01
      ORG 34000B
*
*
*     ******************************************************************
*
*     CARD READER MODIFICATIONS TO THE BASIC INTERPRETER    *
*
*     ******************************************************************
*
*     RUN WHEN IN CARD MODE
*
Y1    LDA TFLAG    LOAD PTAPE & CARD FLAG
      SZA,RSS      0?
      JMP RUNA,I   GO TO RUN
      LDA CCONT    OUTPUT RUNCARD CONTENTS
      LDB .BUFA
      JSB WRITE,I
      CLA
      STA CCONT    RESET CCNT=0 FOR ERROR
      JMP RUNA,I   GO TO RUN
*
*     SCRATCH
*
Y2    LDA TFLAG    ARE WE IN CARD OR PTAPE MODE?
      SZA,RSS
      JMP X3,I     NOT CARD, GO TO FLUSH
      LDA M6       LOAD -6
      LDB PAGE     LOAD PAGE BUF
      JSB WRITE,I
      LDA CCONT    LOAD COUNT
      LDB .BUFA    LOAD BUFFER ADDRESS
      JSB WRITE,I  OUTPUT SCR COMMAND
      LDA FWAM
      STA PBUFF
      STA PBPTR
      LDA .32
      STA BLNK
      CLA
      STA LNUM
Y5    STA DRQST,I  CLEAR DATA REQUEST FLAG
      JMP PEXMA,I
*
*     ERROR
*
Y3    LDA ERROR    SAVE RETURN ADDRESS
      STA STK19
      LDA TFLAG    CARD OR PTAPE?
      SZA,RSS
      JMP *+8
      LDA CCONT    LOAD CARD COUNT
      SZA,RSS      ZERO?
      JMP *+5      YES:  RUN TIME ERROR
      CPA M1       -1?
      LDA .72      YES, TOO MANY CHAR
      LDB .BUFA    LOAD BUFFER ADDRESS
      JSB WRITE,I  OUTPUT INCORRECT LINE
      JMP ERROR+3
PAGE DEF *+1
      OCT 5012,5012,5012
Y6    LDA TFLAG    CHECK IF IN CARD OR PTAPE MODE
      SZA,RSS      ZERO?
      JMP RDYDA,I  YES - TTY MODE
      CLA          NO - CARD OR PTAPE
      JSB SEXUA,I  SET EXECUTION FLAG
      JMP Y5
*******************************************
***                                     ***
*** TIME-SHARE BASIC CARD READER DRIVER ***
***                                     ***
*******************************************
*
*     CALL FROM BASIC:
*     LDB <BUFFER START ADDRESS>
*     LDA <BUFFER LENGTH IN CHARACTERS>
*     JSB .CARD,I
*
*     <P+1>        RETURN
*
CARDS NOP          INITIATOR FOR CARD READER
      STB CBUFD    SAVE BUFFER ADDRESS
      STA COUNX    SAVE INPUT COUNT              [A]
      CLA
      STA CCONT    SET CHARZCTER COUNT CLEAR
      STA COLC     CLEAR COLUMN COUNTER
      STA CONDT    SET CONDITION INDICATOR
      LDA &MON&    LOAD ADDRESS OF MONITOR
      STA CRINT    STORE IT IN INT. NOP FOR RETURN
      LDA CRUSN    SET TEMP CARD
      STA CRUST       INDICATOR IN CASE OF STOP
      JSB XINTA,I  SET TTY INT. TO EXECUTION
      JMP RCOL     START CARD FEED
*
*
***   CARD READER INTERRUPT PROCESSOR
*
CRINT NOP          CARD READER INTERRUPT PROCESSOR
      STA CSAVA    SAVE A REGISTER
      STB CSAVB    SAVE B REGISTER
      CLA          SAVE E & O REGISTER
      SOC          IS OVERFLOW CLEAR
      INA          YES INCREMENT A
      ERA          SAVE E
      STA CSAVE
      CLF 0        TURN OFF INTERRUPT SYSTEM     [A]
*
CRDR1 LIA 0,C      LOAD IN CHARACTER
      LDB CONDT    LOAD CONDITIONS
      SZB,RSS      IS IT TRYING TO FEED A CARD?
      JMP RCOLI    YES, SEE IF SUCCESS
      SSB          NO, SEE IF WAITING FOR END OF CARD
      JMP CKCN1    YES, CHECK FOR END
      ISZ COLC     GET NEXT COLUMN
      LDB COLC     CHECK IF 37 (CONTINUE COLUMN)
      CPB .37
      JMP CKCON    YES - CONTINUE?
      AND B7777    GET RID OF STATUS
      SZA,RSS      NO - NULL?
      JMP RRET     YES - WAIT FOR NEXT COLUMN
      CCB          SET B=-1
      STB TOPFL    INITIALIZE TOP
      STB BTMFL    AND BOTTOM FLAGS
      LDB M9       INITIALIZE ROW COUNTER
      STB RCTRX
      CLB          CLEAR B FOR CODE ACCUMULATION
      SLA          CHECK ROW 12
      JMP SET12
R1    RAR,SLA      CHECK ROW 11
      JMP SET11
      RAR,SLA      CHECK ROW 10
      JMP SET10
      ALF,RAL      POSITION BITS
R2    RAL
      SSA          CHECK 1-9
      JMP SET19
      ISZ RCTRX    CHECK IF MORE ROWS
      JMP R2       YES

*
*
*     B CONTINS THE CHAR CODE (1-39)
      LDA B        CHAR CODE INTO A
      LDB COLC     GET COLUMN CTR IN B
      ADB M5       B=B-5
      SSB          B<=0?
      JMP STNO     COL. 1,2,3,4   STMT NO.
      ADB M2
      SSB          IS COLC <=6?
      JMP COL56    COL. 5,6   COMMAND
R3    CLE,ERA
      SLB
      JMP EVENC    EVEN COLUMN
*
*     ODD COLUMN
*
      LDB OTBLA    LOAD ODD TABLE ADR
R4    ADA 1        ADDR OF CHARS NOW IN A
      LDA 0,I      GET CHARS
      SEZ,RSS      LEFT OR RIGHT?
      ALF,ALF      WAS LEFT, MOVE RIGHT
      LDB CCONT    LOAD CHAR COUNT
      JSB STCHR    STORE THE CHARACTER
      STB CCONT
      JMP RRET     GO WAIT FOR NEXT COLUMN
EVENC LDB ETBLA    LOAD EVEN TABLE ADDRESS
      JMP R4
COL56 CLO          CLEAR O
      SLB,RSS      SET O IF COL 5
      STO
      LDB CCONT    LOAD COUNT
      ADA M10
      SSA
      JMP OKCRD    IF A<10 THEN OK
      ADA M10
      SZA,RSS      IF A=20, CONVERT
      JMP OKCRD    TO ZERO
      ADA M10
      SZA          IF A=30, CONVERT TO ONE
      JMP RRET     INVALID CODE, IGNORE
      INA          A=1
OKCRD ADA ADTBL    GET ADDR OF REF TABLE
      LDA 0,I      GET ENTRY
      SOC          LEFT OR RIGHT?
      ALF,ALF      WAS LEFT, MOVE RIGHT
      AND .77      STRIP TO 6 BITS
      ADA NMLST    N ADD ADDR OF NAME TABLE
      STA ADTMP    SAVE ADDRESS OF CURRENT CHAR
      LDA SP       LOAD SPACE CHAR
      JSB STCHR    STORE CHARACTER
NEXTC LDA ADTMP,I  GET NEXT  HAR
      SOC          LEFT OR RIGHT
      ALF,ALF      WAS LEFT, MOVE RIGHT
      AND B177     7 BITS
      CPA AT       @=END
      JMP FINSH
      JSB STCHR    STORE CHAR
      ISZ ADTMP    GET NEXT CHAR
      JMP NEXTC
FINSH LDA SP       ADD SPACE
      JSB STCHR
      STB CCONT    STORE COUNT
      JMP RRET     WAIT FOR NEXT COLUMN
STNO  ADA M11      IS IT A NUMBER
      SSA,RSS
      JMP RRET     NO - DELET IT
      ADA .11.
      JMP R3
SET12 ISZ TOPFL
TEM   NOP
      ADB .30      RECORD ROW 12 PUNCH
      JMP R1
SET11 ISZ TOPFL
      JMP RRET     INVALID CODE
      ADB .20      RECORD ROW 11 PUNCH
      JMP R1+2
SET10 ISZ TOPFL
      JMP RRET     INVALID
      ADB .10      RECORD IT
      JMP R2-1
SET19 ISZ BTMFL
      JMP RRET     INVALID
      STB TEM      SAVE RUNNING TOTAL
      LDB RCTRX
      CMB,INB
      ADB TEM
      JMP R2+3
*
*
*
*
*     CHECK CONTINUE COLUMN
*
*
CKCON STA CONCD    GET ROW 12 INTO CONTINUE CODE
      CCA
      STA CONDT    SET CONDITION -1 WAIT FOR CARD END
      JMP RRET     RETURN
CKCN1 RAL          CHECK FOR CARD END
      SSA,RSS
      JMP RRET     NO WAIT FOR END
*
      LDA CONCD    LOAD CONTINUE CODE
      SLA,RSS      ROW 12 SET?
      JMP PAU      NO - DONE
      CLA          YES
      STA COLC     RESET COLUMN COUNT
      STA CONDT    RESET CONDITION
      JMP RCOL     START NEW CARD
*
*     RETURN
*
RRET  CLO          RESTORE REGISTER
      LDA CSAVE
      ELA,SLA
      STO
      LDA CSAVA
      LDB CSAVB
      STF 0        ENABLE INTERRUPT SYSTEM       [A]
      JMP CRINT,I  RETURN
*
*
*
*     SUBROUTINE TO STORE THE CHARACTER
*
STCHR NOP
      CPB COUNX    TEST FOR BUFFER OVERFLOW      [A]
      JMP STCHR,I  RETURN IF OVERFLOW            [A]
      AND B177     MASK OFF TO 7 BITS
      SLB,RSS      CHECK COUNT FOR CHAR POSITION
      ALF,SLA,ALF  UPPER CHAR
      IOR CBUFD,I  LOWER,  ADD ON UPPER
      STA CBUFD,I  STORE WORD
      SLB,INB      INCREMENT COUNTER AND TEST
      ISZ CBUFD    GO TO NEXT WORD
      JMP STCHR,I  RETURN
*
*
*
*     SECTION TO START READING A CARD
*
*
RCOLI SSA,RSS      IS STATUS OK?
      JMP CR2      NO
      ISZ CONDT    SET CONDITION CODE
*
      JMP RRET     READ FIRST COLUMN
CR2   RAL
      SSA
      JMP SETM2    END-OF-CARD   "ERROR"
      ISZ TRYCT    TRY AGAIN?
      JMP RCOL+2   YES
      JMP SETM2    NO CARDS   "ERROR"
*
*
*
RCOL  LDA M5       SET RETRY COUNTER
      STA TRYCT
      STC 0,C      ENABLE READER
      CLA,INA      START FEED
      OTA 0
      JMP RRET     READER RETURN
*
*
*     SET DATA FLAG
*
*     AND CLEAR CARD READER
*
*
PAU   CLA,INA
      STA CDATA    SET CARD READER DATA FLAG
      CLA          CLEAR CARD TEMP INC
      STA CRUST
      JMP RRET     RETURN
SETM2 LDA M3       LOAD ERROR CONDITION
      STA CDATA
      CLC 0        CLEAR READER
      JMP *-6
      JMP RRET
*
*
*
***   CHECK CARD READER
*
*
CCARD NOP          SUBROUTINE TO CHECK IF CARD READER
      LDA CDATA    NEEDS SERVICE
      SZA,RSS      IS DATA FLAG 0?
      JMP CCARD,I  YES - GO BACK TO MONITOR
      CLB          NO - RESET IT
      STB CDATA
      STA TEM3     SAVE DATA FLAG
      CCA          SET FLAG1=-1
      STA FLG1,I   TO INDICATE USER CHECK
      ADA CRUSN    USER #-1=BIAS
      STA BIAS.,I
      JSB ACT.,I   ACTIVATE THE USER
      LDA EXU.     IS OT A STOP CONDITION?
      ADA BIAS.,I  CHECK EXU FLAG TO SEE.
      LDA A,I
      SSA
      JSB I.STP,I  YES - GO TO STOP ROUTINE
      LDA CCONT    NO - LOAD CHARACTER COUNT
      LDB TEM3     LOAD DATA FLAG
      SSB          IS FLAG NEGATIVE?
      LDA TEM3     YES GET FLAG TO A REG.
      JMP CARDS,I  RETURN TO BASIC
CDATA NOP          CARD READER DATA FLAG
CRUSN NOP          CARD REACER USER NUMBER
CCONT NOP          CHARACTER COUNT
CBUFD NOP          BUFFER ADDRESS
COLC  NOP          COLUMN COUNT
CONDT NOP          CONDITION OF CARD READER
COUNX NOP                                        [A]
CSAVA NOP          SAVE A REGISTER
CSAVB NOP
CSAVE NOP
TOPFL NOP
BTMFL NOP
RCTRX NOP
TRYCT NOP          COUNTER FOR FEED ATTEMPTS
CIN   EQU 0
ETBLA DEF ETBL
OTBLA DEF OTBL
ADTBL DEF OTBLZ                                  [A]
NMLST DEF *
      ASC 10,SLCIRSATT@CPHU@NRCUH
      ASC 10,N@@RLEEATD@@DPARTIAN
      ASC 10,@TG@OITFO@@NFEOXRT@@
      ASC 10,DEINMD@@DGEOFS@URBE@
      ASC 10,TSUTRONP@@RREEMS@TMO
      ASC 7,ARTE@@ C O M @
B7777 OCT 7777
.20   DEC 20
EXU.  DEF EXU1
CONCD NOP
.11.  DEC 11
ADTMP NOP
CRUST NOP
XINTA DEF XINT
*
*
*
***********************************************
***                                         ***
***   TIME-SHARE BASIC PHOTOREADER DRIVER   ***
***                                         ***
***********************************************
*
*     CALL FROM BASIC:
*
*     LDB <BUFFER START ADDRESS>
*     LDA <BUFFER LENGTH IN CHARACTERS>
*     JSB .HSPR,I
*
*     <P+2>        RETURN
*
*
.HSPR NOP          ENTRY POINT TO PHOTOREADER DRIVER
      STA HSROC    STORE CHARACTER COUNT
      STB BLNTH    SAVE BUFFER ADDRESS
      CLA          CLEAR A-REGISTER AND-
      STA HSPTR    STORE IN CHARACTER IN COUNT
      STC 0,C      INITIATE PHOTOREADER INPUT
      JMP &MON&,I  GO TO MONITOR
*
***   PHOTOREADER INTERRUPT PROCESSOR
*
RDINT NOP
      STA ?SAVA    SAVE CONTENTS OF A-REGISTER
      STB ?SAVB    SAVE CONTENTS OF B-REG
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY
      CPA RTA       IS IT A RETURN?
      JMP CRIN      SET CARRIAGE RETURN FLAG
      CPA LF       IS IT A LINE-FEED?
      JMP ?OMIT    YES-IGNORE
      CPA RBOUT    IS IT A RUBOUT?
      JMP ?OMIT    YES - IGNORE
*
      CPA AMDE     ALT MODE?                     [A]
      JMP NWLNE    YES                           [A]
      CPA EMODE    ESCAPE?                       [A]
      JMP NWLNE    YES - DELETE ENTIRE LINE      [A]
      CPA AROW     LEFT ARROW?                   [A]
      JMP DLET.    YES - DELETE LAST CHARACTER   [A]
      SZA,RSS      TEST FOR NULL
      JMP ?LDR     TEST FOR LEADER/TRAILER TAPE
      ISZ TPFLG    INDEX CHARACTER FLAG
      LDB HSPTR     LOAD CHARACTER IN COUNT
      CPB HSROC    TEST FOR FULL BUFFER
      JMP ?OMIT    YES-IGNORE LAST CHARACTER
      SLB,RSS       STORE
      ALF,SLA,ALF     CHARACTER       *
      IOR BLNTH,I       IN            *
      STA BLNTH,I        BUFFER       *
      SLB,INB                         *
      ISZ BLNTH                       *
      STB HSPTR    SAVE CHARACTER IN COUNT
?OMIT STC 0,C      START NEXT INPUT
      LDA ?SAVA    RESTORE A-REGISTER
      LDB ?SAVB    RESTORE B-REGISTER
      JMP RDINT,I  RETURN
*
CRIN  CLC 0
      STA HSRDT    SET RECORD IN FLAG
      JMP ?OMIT+1
*
?LDR  LDA TPFLG    LOAD LEADER/TRAILER FLAG
      SZA,RSS      TEST FOR TRAILER
      JMP ?OMIT    LEADER TAPE-IGNORE
      CLC 0        TURN OFF PHOTOREADER
      LDB M10      LOAD B=-10
      STB HSRDT    SET EOT FLAG
      JMP ?OMIT    RETURN
*
***   DELETE ENTIRE LINE
*
NWLNE CLB          SET RECORD IN COUNT           [A]
      STB HSPTR      TO ZERO                     [A]
      JMP CRIN     SET RECORD-IN FLAG            [A]
*
***   DELETE LAST CHARACTER IN BUFFER
*
DLET. LDB HSPTR    CHECK FOR EMPTY BUFFER        [A]
      SZB,RSS                                    [A]
      JMP ?OMIT    IF EMPTY - GET NEXT CHARACTER [A]
      CCA                                        [A]
      ADB A        DECREMENT CHARACTER COUNT     [A]
      SLB,RSS      ODD OR EVEN CHARACTER?        [A]
      JMP ?OMIT-1  EVEN - JUST DECREMENT ADDRESS [A]
      ADA BLNTH       POINTER.                   [A]
      LDA BLNTH,I  ODD - DELETE LAST CHARACTER   [A]
      AND MSK1        INPUT.                     [A]
      STA BLNTH,I                                [A]
      JMP ?OMIT-1                                [A]
*
***   PHOTOREADER DATA VALUES
*
*
HSROC NOP          PHOTOREADER ORIGINAL DATA COUNT
BLNTH NOP          PHOTOREADER BUFFER STORE POINTER
HSPTR NOP          CHARACTER IN COUNTER
?SAVA NOP
?SAVB NOP
TPFLG NOP          LEADER/TRAILER TAPE FLAG
HSRDT NOP          PHOTOREADER DATA FLAG
*
AMDE  OCT 176                                    [A]
AROW  OCT 137                                    [A]
***   STORAGE FOR USER # WHILE PTAPE ACTIVATED
*
PTUSN NOP          TAPE USER # STORAGE
*
***   CHECK PHOTOREADER
*
CPHTO NOP
      LDA HSRDT    GET PHOTOREADER DATA FLAG
      SZA,RSS      DATA FLAG SET?
      JMP CPHTO,I  NO-RETURN TO MONITOR
      ISZ .HSPR    SET RETURN TO P+2
      CLB
      STB HSRDT    CLEAR PHOTOREADER FLAG
      STA TEM3     SAVE DATA FLAG
      CCA          SET FLAG1=-1
      STA FLG1,I   (USER CHECK)
      ADA PTUSN    COMPUTE PTAPE USER
      STA BIAS.,I
      JSB ACT.,I   ACTIVATE THE USER
      LDA HSPTR    LOAD CHAR -IN- COUNT
      LDB TEM3     RELOAD DATA FLAG
      CPB M10      END-OF-TAPE?
      RSS          YES-PROCESS EOT
      JMP .HSPR,I  NO-RETURN
.RDR1 CLC 0        TURN OFF PHOTOREADER
      CLB
      STB TPFLG    CLEAR LEADER/TRAILER FLAG.
      LDA .12       OUTPUT "TAPE LOADED"
      LDB TLRDR     TO TELETYPE
      JSB WRITE,I
      LDA M3        LOAD EOT FLAG
      JMP .HSPR,I  RETURN
FLG1  DEF FLAG1
TLRDR DEF *+1
      ASC 6,TAPE LOADED
*
***   RETURN AFTER INPUT FROM LOCAL TTY
*
PTPRC STA TEM3
      CCB          SET LOG TTY BUSY FLAG
      STB BUSY
      CLA          OUTPUT CR-LF
      JSB LCLOT,I
      JSB LCLIN,I  INITIATE NEW INPUT
      CLA          CLEAR LOG TTY BUSY FLAG
      STA BUSY
*
*     MODIFY PTPRC
*
      LDB USN      LOAD THE USER NUMBER
      SZB,RSS      IS IT ZERO?
      JMP *+4      YES NO ONE IN
      ADB .BSKA    NO, GET USER STACK ADDRESS
      LDB B,I
      JSB #MOT#,I  MOVE THE USER OUT
      CLA
      STA USN      CLEAR USER NUMBER
      LDB PTBUF    LOAD INPUT BUFFER
      STB TFLAG    SET PT FLAG
      CPB PT       IS IT A PTABE
      JMP ?PTCR
      CPB CA       IS IT  A CARD?
      RSS
      JMP &MON&,I  NO  RETURN TO MONITOR
?PTCR LDA PTBFA    LOAD PTAPE BUFFER
      RAL
      STA BADDR
      LDA TEM3     LOAD CHARACTER COUNT
      CMA          CHAR TO -#-1
      STA CCNT
      JSB GETCR,I  GET A CHARACTER
      JMP &MON&,I  NO MORE CHARS  INVALID
      JSB DIGCK,I  IS IT A DIGIT?
      JMP *-3      NO
      STA TEM3     SAVE USER #
      SZA,RSS      TEST FOR ZERO USER #          [A]
      JMP &MON&,I  RETURN IF USER 0              [A]
      ADA M5       TEST FOR USER NUMBER          [A]
      SSA,RSS          GREATER THAN 4            [A]
      JMP &MON&,I  RETURN IF TOO LARGE           [A]
      LDA TEM3     RELOAD USER NUMBER            [A]
      LDB TFLAG    LOAD FLAG
      ADA M1       SUBTRACT 1
      STA BIAS.,I  SET BIAS
      ADA DRS.     CHECK FOR INACTIVE USER       [A]
      LDA A,I                                    [A]
      XOR M15      THIS IS A CHANNEL IN THE      [A]
      LDA A,I         LOGGING ROUTINES           [A]
      CPA LOGGR                                  [A]
      JMP &MON&,I  RETURN IF INACTIVE USER       [A]
      LDA BIAS.,I  RESTORE BIAS IN (A)           [A]
      JSB ACT.,I   ACTIVATE THE USER
      LDA TEM3     RELOAD USER #
      CPB CA       IS IT CARD READER
      STA CRUSN    YES
      CPB PT       PTAPE?
      STA PTUSN    YES
      CCA          SET A=-1 FOR PT
      CPB CA       IS IT CARDS?
      LDA M15      YES A=15
      STA TFLAG    SET FLAG
      JMP PTAP,I   GO TO PTAPE IN BASIC
*
TEM3  NOP
&BAD& NOP
&CNT& NOP
LOGGR DEF LOGON+3                                [A]
DRS.  DEF DRS+1                                  [A]
*
PT    ASC 1,PT
CA    ASC 1,CA
#MOT# DEF MVUOT
BIAS. DEF BIAS
.BSKA DEF BSK1-1
ACT.  DEF ACT
*
*
*
***    EXECUTE "MESG" COMMAND
*
MSSG  CLA          OUTPUT CR-LF ON
      JSB WRITE,I  USER TTY
      LDA BUSY     LOAD BUSY FLAG
      SZA          AND RETURN IF
      JMP NOGO2    LOG TTY IS BUSY
      LDA PNCMD    OTHERWISE-SET LOG
      STA BUSY     TTY MOTOR ON AND
LTTY3 OTA 0        SET BUSY FLAG.
      LDB D500     FOR LOG TTY
      LDA D500     GIVE DELAY
      INA,SZA      MOTOR
      JMP *-1      TO COME
      INB,SZB      UO TO
      JMP *-4      PRINT SPEED
      LDA USN      GET USER #
      IOR .48      ADD ON ASCII # BITS
      ALF,ALF      POSITION TO UPPER WORD
      STA CMSG     PUT IN BUFFER
      LDA .13      OUTPUT MESSAGE:
      LDB MSGA     "MSG CH: X"
      JSB LCLOT,I
      JSB LCLIN,I
      CLA          CLEAR BUSY FALG
      STA BUSY
      JMP RDYDA,I  RETURN TO BASIC
*
.13   DEC 13
MSGA  DEF *+1
      OCT 3407
      OCT 3407
      ASC 4,MSG CH:
CMSG  BSS 1
D500  DEC -500
*
ACCT# NOP
TBL   NOP
SYIN# BSS 1
SINA  BSS 1
SLENA BSS 1

*
*
*     LOGGING ROUTINES
*
*
*
*****************************
***                       ***
***   LOG-ON SUBROUTINE   ***
***                       ***
*****************************
*
LOGON LDA .72      ASK FOR 72 CHARS INPUT
      LDB .BUFA    GIVE I/O BUFFER ADDRESS
      JSB REED,I   GET KEYBOARD INPUT
      SSA           RECORD DELETED?
      JMP DLET
      STA INFO1    SAVE INPUT COUNT
      LDA .6       SET (A) TO 6
      LDB .BUFA    LOAD BUFFER ADDRESS
      JSB SETUP    SET-UP CALL TO TABLE SEARCH
      LDA HELLO    GET "HELLO" ADDRESS
      CCB
      JSB TSRCH,I  SEARCH TABLE
      JMP INVAL    NO- INVALID ACCESS
      LDB .BUFA    RELOAD BUFFER ADDRESS
      ADB .3       INDEX BY 3.
      LDA INFO1    RELOAD CHAR INPUT COUNT
      ADA M6       SUBTRACT 6
      JSB SETUP    SET-UP CALL TO TABLE SEARCH
      LDA ACCT#    GET ACCOUNT CODE ADDRESS
      LDB TBL      GET TABEL LENGTH
      JSB TSRCH,I  SEARCH TABLE
      JMP INVAL    NOT VALID- INVALID ACCESS
      ALF,ALF      ROTATE ACCOUNT NUMBER
      RAR          INTO POSITION
      LDB USAC#    LOAD USER ACCOUNT ADDRESS.
      ADB USN      INDEX BY USER NUMBER.
      STA B,I      SAVE USER ACCOUNT #
*
***   INPUT USER NAME AND I.D.
*
NAME  LDA M11      OUTPUT MESSAGE:
      LDB MES1A    NAME-I.D.
      JSB WRITE,I
      LDA .72      INPUT 72 CHARS
      LDB .BUFA    GIVE INPUT BUFFER ADR
      JSB REED,I   ASK FOR KEY BOARD INPUT
      SZA,RSS      TEST FOR NULL INPUT
      JMP NAME     NULL INPUT - TRY AGAIN
      SSA          TEST FOR DELETED RECORD
      JMP NAME     RECORD DELETED - TRY AGAIN
      STA INFO2    SAVE INPUT COUNT
      LDB BUSY     LOAD BUSY FLAG
      SZB          LOG TTY BUSY?
      JMP NOGO1    YES-TRY AGAIN
      LDA PNCMD    LOAD PUNCH COMMAND
      STA BUSY     TURN ON LOG TTY AND
LTTY1 OTA 0        SET BUSY FLAG
      CLA          OUTPUT
      JSB WRITE,I  CR-LF ON USER TTY
      JSB ONOFF    SET UP HEADER
      STA INFO3    SAVE CHARACTER COUNT
*
***   SET UP "TIME-ON" HEADER
*
      LDB .10      SET CCNT TO 10
      STB CCNT     CHARS OUT
      LDB LGOM5    SET BADDR TO BUFFER
      STB BADDR    ADDRESS -1
      LDA HOUR     LOAD HOURS COUNT
      JSB OUTIM    OUTPUT HOURS COUNT
      LDA MINTS    LOAD MINUTES COUNT
      JSB OUTIM    OUTPUT MINUTES COUNT
*
***   OUTPUT LOG-ON DATA
*
*
      LDA INFO3    OUTPUT CHANNEL
      LDB LGOM1    INFO TO USER
      JSB WRITE,I
      LDA GTBSL    OUTPUT TIME TO
      LDB LGOM4    USER
      JSB WRITE,I
      CLA          OUTPUT
      JSB LCLOT,I  CR-LF
      LDA INFO3    OUTPUT CHANNEL
      LDB LGOM1    INFOR TO LOG
      JSB LCLOT,I
      LDA GTBSL    OUTPUT TIME-ON
      LDB LGOM4    TO LOG.
      JSB LCLOT,I
      LDA INFO2
      LDB .BUFA    OUTPUT USER MESSAGE
      JSB LCLOT,I  TO LOG.
      JSB LCLIN,I
      CLA
      STA BUSY     CLEAR BUSY FLAG
*
*    OUTPUT SYSTEMS INFO
*
*     SYIN# IS NUMBER OF LINES TO BE OUTPUTTED
*     SLENA IS ADDRESS OF TABLE OF LINE LENGTHS
*     SINA IS ADDRESS OF TABLE OF LINE ADDRESSES
*
*
      LDA SYIN#    LOAD NUMBER OF LINES
      STA INFO1    SAVE IN COUNT
      LDA SLENA    GET ADDRESS OF LENGTH TABLE
      STA INFO2    SAVE IT
      LDA SINA     GET ADDRESS OF ADDRESS TABLE
      STA INFO3    SAVE IT
*
SYST  LDA INFO2,I  GET LENGTH
      LDB INFO3,I  GET ADDRESS
      JSB WRITE,I  OUTPUT LINE
      ISZ INFO2    INDEX TO NEXT LENGTH
      ISZ INFO3    NEXT ADDRESS
      ISZ INFO1    CHECK IF LAST ONE
      JMP SYST     NO
*     CLEAR TIME
      JSB CLTM
      JMP ONADR,I  GO TO BASIC
*
*
***   SUBROUTINE TO SET UP "TIME-ON" HEADER
*
OUTIM NOP
      STA DTMP     SAVE IN TEMP
      ADA  M10     SUBTRACT 10
      SSA,RSS      POS?
      JMP *+3      YES-TIME>=0
      LDA .48      OUTPUT A ZERO
      JSB OUTCR,I  TO CLOCK BUFFER
*
      LDA DTMP     RELOAD CLOCK COUNT
      SZA          ZERO?
      JMP *+4      NO-SET WITH OUTIN
      LDA .48      YES-PUT IN ZERO
      JSB OUTCR,I  IN CLOCK BUFFER
      RSS
      JSB OUTIN,I  INSERT TIME IN BUFFER
      JMP OUTIM,I  RETURN
*
DTMP  NOP
*
*     INVALID ACCESS
*
*
INVAL CLA          OUTPUT A CR-LF
      JSB WRITE,I
      LDA .14      OUTPUT MESSAGE:
      LDB INVA     "INVALID ACCESS"
      JSB WRITE,I
      JMP LOGON    GO TO LOG-IN SECTION
*
INVA  DEF *+1
      ASC 7,INVALID ACCESS
*
***   SET UP CALL TO TABLE SEARCH
*
SETUP NOP
      CMA,SSA,RSS  MAKE COUNT = -1-COUNT
      JMP INVAL
      STA CCNT
      BLS          GET ADDRESS*2
      STB BADDR    SET AS BUFFER POINTER
      JSB GETCR,I  GET A CHARACTER
      JMP INVAL    NOT A VALID CHARACTER
      LDB SBUFA    *
      STB SBPTR    * INITIALIZE SYNTAX BUFFER
      STA SBPTR,I
      JMP SETUP,I  RETURN
*
HELLO DEF *+1
      OCT 0006
      ASC 3,HELLO-
DLET  CLA,INA      OUTPUT AN ESCAPE (\)
      LDB ESCP     ON USER TTY
      JSB WRITE,I
      JMP LOGON
ESCP  DEF *+1
      ASC 1,\
***************************
*                         *
***   LOG-OFF ROUTINE   ***
*                         *
***************************
LOGOF CLA
      JSB WRITE,I  OUTPUT CR-LF
      LDA BUSY     LOAD BUSY FLAG
      SZA          IS LOG TTY BUSY?
      JMP NOGO2    YES- PRINT BUSY MESSAGE
      LDA PNCMD    NO- LOAD PUNCH COMMAND
      STA BUSY     SET BUSY FLAG
LTTY2 OTA 0        OUTPUT MOTOR CONTROL COMMAND
      JSB ONOFF    SET UP USER XX ACCOUNT XX
      STA INFO3    SAVE CHARACTER COUNT
      LDB LGOM1      OUTPUT IT
      JSB WRITE,I     ON USER TTY
*
***   OUTPUT CONNECT TIME TO USER
*
      LDA .14      SET CHARACTER OUT COUNT
      STA CCNT     TO 14.
      LDB TIME1    GET CONNECT TIME STORE ADDRESS
      STB BADDR
      LDA MINA     GET MINUTES ADDRESS
      ADA USN      INDEX BY USER NUMBER
      LDA A,I      LOAD MINUTES
      JSB OUTIN,I  OUTPUT CONNECT TIME TO BUFFER
      LDA CCNT     THEN OUTPUT
      LDB CONTA         CONNECT TIME
      JSB WRITE,I            ON USER TTY
*
*
***   GLAD TO BE OF SERVICE, BYE
*
      LDA GTBSL    LOAD MESSAGE LENGTH
      LDB GTBSA    LOAD ADDRESS
      JSB WRITE,I  OUTPUT MESSAGE ON USER TTY
*
***   OUTPUT LOG-OFF ON LOG TTY
*
      CLA           OUTPUT CR-LF
      JSB LCLOT,I
      LDA INFO3    GET USER # ACCOUNT #
      LDB LGOM1
      JSB LCLOT,I
      LDA CCNT      GET CONNECT TIME COUNT
      LDB CONTA     LOAD MESSAGE START ADRESS
      JSB LCLOT,I   OUTPUT CONNECT TIME ON LOG TTY
*
*
      CLA           OUTPUT CR-LF
      JSB LCLOT,I
      JSB CLTM      CLEAR TIME
*
      JSB LCLIN,I
      CLA
      STA BUSY     CLEAR BUSY FLAG
      JMP LOGON
*
***   THIS SUBROUTINE SETS UP THE HEADER:
*
***   USER # ACCOUNT #
*
*
ONOFF NOP
      LDA USN      LOAD USER NUMBER
      IOR .48      ADD ON ASCII # BITS
      ALF,ALF      POSITION TO UPPER WORDS
      IOR BLANK    ADD ON SPACE CHAR
      STA LGOM2,I  PUT IN BUFFER
      LDA .16      SET OUTPUT COUNT TO 16 CHARS
      STA CCNT
      LDB LGOM3    FETCH ACCOUNT # STORE ADDRESS
      STB BADDR
      LDB USAC#    GET ADDRESS OF ACCOUNT TABLE
      ADB USN      INDEX BY USER NUMBER
      LDA B,I      LOAD ACTUAL USER ACCOUNT NUMBER
      JSB OUTIN,I  ADD IT TO CHARACTER STRING
      LDA CCNT     LOAD CHARACTERS IN COUNT
      JMP ONOFF,I  RETURN
*
LGOM1 DEF *+1
      ASC 9,CHAN:   ACCOUNT
LGOM2 DEF LGOM1+4
LGOM3 DEF LGOM1+8
LGOM4 DEF *+1
      ASC 13,TIME ON:          /   /
LGOM5 DEF LGOM4+5
*
NOGO1 CLA
      JSB WRITE,I
      LDB NOGOA
      LDA NOGOL    LOAD LENGTH OF BUSY MESSAGE
      JSB WRITE,I  OUTPUT MESSAGE
      JMP NAME
NOGO2 LDB NOGOA
      LDA NOGOL    LOAD LENGTH
      JSB WRITE,I
      JMP PEXMA,I
NOGOL DEC 19
NOGOA DEF *+1
      ASC 10,LOG BUSY, TRY AGAIN
*
*
*     CLEAR TIME SUBROUTINE
*
*
CLTM  NOP
      CLA          A=0
      LDB SECA
      ADB USN
      STA B,I      CLEAR CONNECT SEC COUNTER
      INA          A=1
      LDB MINA
      ADB USN
      STA B,I      MINUTE COUNTER = 1
      JMP CLTM,I   RETURN
*
***************************
***                     ***
***   INTERRUPT TIMER   ***
***                     ***
***************************
*
TIMR  NOP
*
      STA SAVAC
      STB SAVBC
      LDB #USRS    LOAD -NUMBER OF USERS
      STB CHN      SET FOR COUNTER
      LDB .60      SET FOR 60 SEC=1 MIN
      LDA SECA     GET SECOND TABLE ADDRESS
      INA          ADD 1
      STA SEC      SAVE ADDRESS
      LDA MINA     GET MINUTE TABLE ADDRESS
      INA          ADD 1
      STA MIN      SAVE IT
      CLA          SET A=0
*
INC.  ISZ SEC,I    INCREMENT SECONDS
      CPB SEC,I    IS IT 60?
      JMP MINUT    YES
NEXTU ISZ SEC      NEXT USER
      ISZ MIN
      ISZ CHN
      JMP INC.
*
      ISZ SEKS     INCREMENT SECONDS COUNTER
      CPB SEKS     60 SECONDS ELAPSED?
      RSS          YES-INDEX MINUTES COUNT
      JMP STM-2    NO-RETURN
*
      STA SEKS     RESET SECONDS TO ZERO
      ISZ MINTS    INCREMENT MINUTES COUNT
      CPB MINTS    60 MINUTES ELAPSED?
      RSS          YES-INDEX HOUR COUNT
      JMP STM-2    NO-RETURN
*
      STA MINTS    RESET MINUTES TO ZERO
      ISZ HOUR     INCREMENT HOURS COUNT
      LDB ?24      LOAD (B)=24
      CPB HOUR     24 HOURS ELAPSED?
      RSS          YES-PROCESS DAY
      JMP STM-2    RETURN
*
      STA HOUR     RESET HOURS TO ZERO
      ISZ DATE     INDEX DATE
      ISZ FLG2A,I  SET DAY CHANGE FLAG
*
*
* RESTORE REGISTERS AND RETURN
*
      LDA SAVAC
      LDB SAVBC
STM   STC 0,C      SET CONTROL ON CLOCK
      JMP TIMR,I   RETURN
*
*
MINUT ISZ MIN,I    INCREMENT MINUT COUNTER
      STA SEC,I    CLEAR SECONDS COUNT
      JMP NEXTU
*
*
*
*
FLG2A DEF FLAG2
SEKS  NOP
MINTS NOP
HOUR  NOP
DATE  NOP
?24   DEC 24
DBUF  DEF LGOM4+10
PNCMD OCT 110000
*
BUSY  NOP
USAC# DEF *        USER ACCOUNTS-1
      BSS 4        USER ACCOUNTS
CONTA DEF *+1
      ASC 7,CONNECT TIME:
      BSS 2
TIME1 DEF *-3
*
*
GTBSL DEC 26
GTBSA DEF *+1
      ASC 13,GLAD TO BE OF SERVICE, BYE
MIN   NOP
SEC   NOP
CHN   NOP
SAVAC NOP
SAVBC NOP
.14   DEC 14
.16   DEC 16
.60   DEC 60
MINA  DEF *
      NOP
      NOP
      NOP
      NOP
SECA  DEF *
      NOP
      NOP
      NOP
      NOP
#USRS NOP
*
*
*
MES1A DEF *+1
      OCT 6412
      ASC 5,NAME-I.D.
LCLOT ABS OUTL
*
LCLIN ABS READL
      SKP
*
*
*
*
*     SINGLE CHARACTER SUBROUTINES
*
*
*     USER # 1
*
*
CHIN1 NOP
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY
      CPA RTA      IS IT A CARRIAGE RETURN?
      JMP CHIN1,I  YES- RETURN TO P+1
      OTB 0        NO, OUTPUT TTY BOARD COMMAND
      STC 0,C      START INPUT
      JMP CHIN1,I  RETURN
*
*
CHOT1 NOP
      OTB 0        OUTPUT COMMAND
      OTA 0        OUTPUT CHARACTER
      STC 0,C      START OUTPUT
      JMP CHOT1,I
*
*     USER # 2
*
CHIN2 NOP
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY
      CPA RTA      IS IT A CARRIAGE RETURN?
      JMP CHIN2,I  YES- RETURN TO P+1
      OTB 0        NO, OUTPUT TTY BOARD COMMAND
      STC 0,C      START INPUT
      JMP CHIN2,I  RETURN
*
*
CHOT2 NOP
      OTB 0        OUTPUT COMMAND
      OTA 0        OUTPUT CHARACTER
      STC 0,C      START OUTPUT
      JMP CHOT2,I
*
*     USER # 3
*
CHIN3 NOP
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY
      CPA RTA      IS IT A CARRIAGE RETURN?
      JMP CHIN3,I  YES- RETURN TO P+1
      OTB 0        NO, OUTPUT TTY BOARD COMMAND
      STC 0,C      START INPUT
      JMP CHIN3,I  RETURN
*
*
CHOT3 NOP
      OTB 0        OUTPUT COMMAND
      OTA 0        OUTPUT CHARACTER
      STC 0,C      START OUTPUT
      JMP CHOT3,I
*
***   USER # 4
*
CHIN4 NOP
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY BIT
      CPA RTA      IS IT A CR?
      JMP CHIN4,I  YES-RETURN TO P+1
      OTB 0        NO-OUTPUT TTY BOARD COMMAND
      STC 0,C      START INPUT
      JMP CHIN4,I  RETURN
*
CHOT4 NOP
      OTB 0        OUTPUT TTY COMMAND
      OTA 0        OUTPUT CHARACTER
      STC 0,C      START OUTPUT
      JMP CHOT4,I  RETURN
*
*     LOG TTY
*
CHINL NOP
      LIA 0        LOAD CHARACTER
      AND M177     MASK PARITY
      CPA RTA      IS IT A CARRIAGE RETURN?
      JMP CHINL,I  YES- RETURN TO P+1
      OTB 0        NO, OUTPUT TTY BOARD COMMAND
      STC 0,C      START INPUT
      JMP CHINL,I  RETURN
*
*
CHOTL NOP
      OTB 0
      OTA 0
      STC 0,C
      JMP CHOTL,I
*
*
RTA   OCT 15
PTBFA DEF PTBUF
PTBUF BSS 3

ENBUF EQU *
      SKP
      ORG 36000B
*
***   MONITOR
*
*
*     PRIMARY MONITOR LOCATION
*
MONIT JSB CHIFL    CHECK INTERRUPT FLAGS
      CLA
      LDB FLAG1    LOAD FLAG
      SSB          IS IT IN LOCAL?
      JMP USER     YES
      SZB          IS IT IN USER?
      JMP MON2     NO IN EXECUTION CHECK
      JMP MON1     YES  CHECK I/O FLAGS
*
*
*
*     CHECK LOCAL TTY
*
CKL   LDA FLAG2    LOAD DAY CHANGE FLAG
      SZA
      JMP DAYCH    DAY CHANGE
      CCA          SET A= -1
      STA FLAG1    USER CHECK
      CLB          B=0
      LDA DATAL    LOAD DATA FLAG
      SZA,RSS      IS IT ZERO?
      JMP CKPTR    GO CHECK PHOTOREADER
      STB DATAL    CLEAR DATA FLAG
      CPA M15      DATA FLAG OUTPUT
      JMP .LD.     YES
      CPA M2       NO - DELETED?
      JMP REDL     YES
      LDA PCNTL    NO - INPUT
      JMP PTPRA,I  CHECK LOCAL INPUT
*
.LD.  CCA          A=-1
      ADA LUSN     ADD LOCAL USER #
      STA BIAS     SAVE BIAS
      JSB ACT      ACTIVATE USER
      JMP WRITL,I  RETURN
*
REDL  JSB READL
*
***   CHECK PHOTOREADER IF IN SYSTEM
*
CKPTR JSB @CARD,I  CHECK IF CARD READER SERVICE
      JSB @PHTO,I  CHECK IF PHOTO READER NEED SERVICE
*
*
*     CHECK USERS
*
USER  STA FLAG1    CLEAR FLAG
      STA BIAS      CLEAR BIAS COUNTER
      LDB IOSKA    LOAD I/O STACK POINTER ADDRESS
      STB MAIN     SAVE IT
      LDB &USR     LOAD NUMBER OF USERS
      STB CT       SAVE IN COUNTER
CKDF  LDB MAIN,I   LOAD STACK ADDRESS
      ADB .5       ADD INDEX
      LDA B,I      LOAD DATA FLAG
      SZA          0?
      JMP .D.      YES
*
MON1  ISZ BIAS     NO - NEXT USER
      ISZ MAIN
      ISZ CT       INC. COUNTER
      JMP CKDF     NOT DONE
*
*     CHECK EXECUTION FLAGS
*
      LDA EXUA.    GET ADDRESS OF EXU FLAGS
      STA FLAG1    SET FLAG
      STA MAIN
      LDA &USR     LOAD NUMBER OF USERS
      STA CT
      CLA
      STA BIAS     CLEAR BIAS
MON3  LDA MAIN,I   LOAD EXU FLAG
      SZA          0?
      JMP .X.      NO
MON2  ISZ MAIN
      ISZ BIAS
      ISZ CT
      JMP MON3
      JSB CHIFL    CHECK USER INTERRUPT FLAGS
      JMP CKL      LOOP THROUGH MONITOR
*
DAYCH LDB USN      LOAD USER #
      SZB,RSS      ZERO?
      JMP *+4      YES - NO ONE IN
      ADB BSKA     NO - ADD USER STACK POINTER
      LDB B,I      LOAD DORMANT STACK ADR
      JSB MVUOT    AND MOVE OUT
      CLA          CLEAR DAY FLAG
      STA FLAG2
      STA CCNT
      STA USN      USN=0
      LDA DDBUF
      STA BADDR    STORE BUFFER ADDRESS
      LDA ADTA,I   OUTPUT NEW DAY
      JSB OUTM,I   BUFFER
      JMP CKL+3    CHECK LOCAL TTY
ADTA  DEF DATE
OUTM  DEF OUTIM
FLAG2 NOP
DDBUF DEF LGOM4+10
*
*
*
*
***   SUBROUTINE TO CHECK INTERRUPT FLAGS
*
CHIFL NOP
      LDA M5       LOAD -5 FOR 4 CHAN + LOG
      STA &CT      SAVE -NUMBER OF USERS
      CLA,INA      SET USER NUMBER -
      STA &BIAS     -- TO 1
      LDA INTF     LOAD ADDRESS OF INTERRUPT FLAGS
      STA &MAIN
&INT& LDA &MAIN,I   LOAD INTERRUPT FLAG
      SZA          ZERO ?
      JMP &EXE&    NO - PROCESS INTERRUPT
&NEX& ISZ &BIAS     INDEX USER BIAS COUNTER
      ISZ &MAIN     COMPUTE NEXT ADDRESS
      ISZ &CT       FINISHED?
      JMP &INT&    NO
      JMP CHIFL,I  YES - RETURN
*
&EXE& CLB
      STB &MAIN,I   CLEAR INTERRUPT FLAG
      LDB INTA     LOAD INTERRUPT ADDRESS
      ADB &BIAS     INDEX BY USER BIAS
      LDB B,I      LOAD INTERRUPT PROCESS ADR
      JSB B,I      PROCESS INTERRUPT
      JMP &NEX&    CHECK NEXT USER
*
*
*     DATA FLAG SET
*
.D.   STA TEMP1    SAVE FLAG
      JSB ACT      ACTIVATE THE USER
      CLA          CLEAR
      STA B,I        DATA FLAG
      LDA EXUA.    LOAD EXU FLAG ADDRESSES
      ADA BIAS     GET USER FLAG ADDRESS
      LDA A,I      GET EXU FLAG
      SSA          TEST FOR STPP CONDITION
      JSB I.STP,I  STOP!
      LDA TEMP1    RELOAD FLAG
      CPA M2       -2?
      JMP RRED     READ RETURN
      CPA M1       -1?
      JMP RRED     READ RETURN
      CPA M15      BIT 15?
      JMP WRRET    WRITE RETURN
      ADB .4       INDEX TO TAPE FLAG
      LDA B,I      LOAD TAPE FLAG
      SZA,RSS      TAPE?
      JMP *+6      NO
*
      LDA TCNTA    LOAD TAPE CNT ADDRESS TABLE
      ADA BIAS
      INA          SET A= ADR OF TAPE COUNTER
      LDA A,I      LOAD TAPE COUNTER
      JMP RRED     RETURN
*
      ADB M2       SUBTRACT 2
      LDA B,I      LOAD PCNT
*
*     READ RETURN
*
RRED  LDB DRS      GET ADDRESS OF READ ADDRESSES
      ADB BIAS     ADD USER BIAS
      LDB B,I      LOAD RETURN ADDRESS INTO -B-
      JMP B,I      RETURN
*
*     WRITE RETURN
*
WRRET LDB DWS      GET ADDRESS OF WRITE ADDRESSES
      ADB BIAS     ADD USER BIAS
      LDB B,I      LOAD RETURN ADDRESS INTO -B-
      JMP B,I
*
*
*     EXECUTION FLAG SET
*
.X.   STA TEMP1    SAVE FLAG
      CPA M2       I/O STOP?
      JMP MON2     YES - GO BACK TO MONIT
      JSB ACT      ACTIVATE THE USER
      LDA TEMP1    RELOAD EXU FLAG
      INA,SZA,RSS  -1?
      JSB I.STP,I  YES STOP
      JMP XECUT,I  NO - EXECUTE PROGRAM
      SKP
*
*
*
*
*     ACTIVATE THE USER
*
ACT   NOP
      STB BTEM     SAVE B REG
      LDA BIAS     GET USER BIAS
      INA          ADD 1 TO GET USER #
      CPA USN      COMPARE WITH PRESENT ACTIVE USR
      JMP ACT,I    SAME
      LDA USN      LOAD USER NUMBER
      SZA,RSS      IF 0 THEN NO ONE TO BE MOVED OUT
      JMP *+5
*
      LDB BSKA     GET ADDRESS OF STACK ADDRESSES
      ADB USN      ADD OLD USER NUMBER
      LDB B,I      GET ACTUAL STACK ADDRESS
      JSB MVUOT    MOVE USER OUT
*
      LDA BIAS     GET BIAS
      INA          CONVERT TO NEW USN
      STA USN       SET NEW USER #
      ADA BSKA     ADD ADDRESS OF STACK ADDRESSES
      LDA A,I      GET ACTUAL STACK ADDRESS
      JSB MVUIN    MOVE USER IN
      LDB BTEM     RESTORE B
      JMP ACT,I    USER IS ACTIVATED
BTEM  NOP
*
*
*
***   MOVE USER OUT ROUTINE
*
*     <B> CONTAINS USER DORMANT STACK ADDRESS
*
MVUOT NOP
      LDA ASTK     LOAD ADDRESS OF ACTIVE STACK
      JSB &MSTK     MOVE STACK
      DEC 87
      JMP MVUOT,I  RETURN
*
***   MOVE USER IN ROUTINE
*
*     <A> CONTAINS ADDRESS OF USER'S DORMANT STACK
*
MVUIN NOP
      LDB ASTK     LOAD ADDRESS OF ACTIVE STACK
      JSB &MSTK     MOVE STACK
      DEC 87
      JMP MVUIN,I  RETURN
*
***  ACTIVATION MOVE-STACK SUBROUTINE
*
&MSTK NOP
      STA &ORST     SAVE ORIGIN STACK ADDRESS
      LDA &MSTK,I   LOAD # OF WORDS TO TRANSFER
      CMA,INA       MAKE COUNT NEGATIVE FOR COUNTER
      STA &TEMP     SAVE AS COUNTER
P1&&& LDA &ORST,I   LOAD CELL FROM ORIGIN STACK
      STA B,I       TRANSFER TO DESTINATION STACK
      INB           B = NEXT ADR IN D - STACK
      ISZ &ORST     INDEX TO NEXT ADR IN O - STACK
      ISZ &TEMP     TEST IF FINISHED
      JMP P1&&&     NO, CONTINUE
      ISZ &MSTK     FINISHED, COMPUTE RETURN ADDRESS
      JMP &MSTK,I   RETURN
*
&ORST NOP
&TEMP NOP
*
*     SET I/O INTERRUPT
*
IINT  NOP
      LDA IINTA    GET ADDRESS OF I/O INT LINK ADDR
      ADA USNT     INDEX BY USER # TEMP
      LDA A,I      GET ACTUAL LINK
      LDB INTA     LOAD ADDRESS OF LINKAGE AREA-1
      ADB USNT     INDEX BY USER NUMBER
      STA B,I      STORE LINK
      JMP IINT,I
*
IINTA DEF *
      DEF INT1
      DEF INT2
      DEF INT3
      DEF INT4
*
*     EXECUTION INTERRUPT PROCESSOR
XNT   NOP
      CLF 0        TURN OFF INTERUPT
      STA XSVA     SAVE A REGISTER AND B REGISTER
      STB XSVB
      LIA 4        LOAD INTERRUPT SELECT CODE
      STA SCNUM    SAVE IT
      LDA CLCC     LOAD CLC COMMAND
      IOR SCNUM    ADD IN SELECT CODE
      STA *+1
      NOP          EXECUTE CLC INST.
      LDB CHTBA    LOAD ADDRESS OF CHANNEL NUMBER TABLE
      INB          NEXT CHANNEL
      LDA B,I      LOAD SC NUMBER
      CPA SCNUM    SAME?
      RSS          YES  COMPUTE CHANNEL NUMBER
      JMP *-4
      LDA CHTBA    COMPUTE CHANNEL NUMBER
      CMA,INA
      ADA B        CHANNEL # IN A REG
      CCB          B=-1  FOR EXECUTION STOP
      CPA CRSTA,I  CARD READER STOP?
      LDB M2       YES I/O STOP
      ADA &EXU     COMPUTE EXU FLAG ADDRESS
      STB A,I      STORE STOP CONDITION
      LDA XSVA     RESTORE REGISTERS
      LDB XSVB
      STF 0        TURN ON INTERRUPT
      JMP XNT,I    RETUNR
XSVA  NOP
XSVB  NOP
SCNUM NOP
CLCC  CLC 0
CHTBA DEF *
      BSS 4        TABLE FOR SC CODES FOR EACH CHANNEL
CRSTA DEF CRUST
*
*
*
*
*
*     SET EXECUTION FLAG
*
*     A REG CONTAINS FLAG SETTINGS
*
SEXU  NOP
      STA SA       SAVE A
      STB SB        SAVE B
      CCB          B=-1
      ADB EXUA.    B=ADDRESS OF EXU FLAGS-1
      ADB USN      ADD USER NUMBER
      STA B,I      STORE EXU
      SZA,RSS
      JMP RESSR
      JSB XINT     SET EXECUTION INTERRUPT
RESSR LDA SA       RESTORE A
      LDB SB       RESTORE B
      JMP SEXU,I
SA    NOP
SB    NOP
*
*     SET UP EXECUTION INTERRUPT
*
XINT  NOP
      LDA STPIA    GET ADDRESS OF EXU INT LINK ADDR
      LDB INTA     GET ADDRESS OF INT LINKS-1
      ADB USN      ADD USER #
      STA B,I      STORE TRANSFER ADDRESS
      LDB INCMD    GET INPUT COMMAND
      CCA          A=-1
      ADA IOSKA    GET I/O STACK ADDRESS
      ADA USN      ADD USER NUMBER
      LDA A,I      GET ACTUAL I/O STACK ADDRESS
      ADA .2       ADD CHIN INDEX
      IOR M15      ADD IN INDIRECT BIT
      JSB A,I      REQUEST INPUT
      JMP XINT,I
*
STPIA DEF XNT      LINK TO EXECUTION STOP
      SKP
*
****************************************
***                                  ***
***   LOCATION OF CALLS TO MONITOR   ***
***                                  ***
****************************************
*
*
***   OUTPUT CALL FROM CHANNEL # 1
*
WRIT1 NOP
      STA OCNT1    SAVE COUNTER
      STB BFAD1    SAVE ADDRESS
WCONT LDA USN      LOAD USER NUMBER
      STA DFLG     SET DRIVER BUSY FLAG
      STA USNT     INITIATE WRITE CONTINUATOR
      JSB IINT     SET INTERRUPT IS I/O
      JSB IOIN     MOVE USER IN
      CLA          CLEAR TAPE FLAG
      STA BPTR
      JSB DRIVO    INITIATE OUTPUT
.RET. JSB IOOT
      CLA          CLEAR DRIVER BUSY FLAG
      STA DFLG     CLEAR DRIVER BUSY FLAG
      JMP MONIT    GO TO THE MONITOR
*
*     INPUT CALL FOR USER 1
*
READ1 NOP
      STA OCNT1    SAVE COUNTER
      STB BFAD1    SAVE ADDRESS
RCONT LDA USN      LOAD USER NUMBER
      STA DFLG     SET DRIVER BUSY FLAG
      STA USNT     INITIATE READ CONTINUATOR
      JSB IOIN
      CLA          RESET TAPE FLAG
      STA BPTR     RESET TAPE FLAG TO ZERO
SIMP  JSB IINT     SET INTERRUPT IS I/O
      JSB DRIVI    START INPUT
      JMP .RET.
*
***   TAPE CALL FOR USER 1
*
TAPE1 NOP
      LDA TAPE1    STORE RETURN ADDRESS IN READ NOP
      STA READ1
TCONT LDA USN      LOAD USER NUMBER
      STA DFLG     SET DRIVER BUSY FLAG
      STA USNT     STORE USER NUMVER
      JSB IOIN     MOVE USER IN
      LDA .72      SET LENGTH = 72
      STA OCNT
      LDB .BUFA    GET I/O BUFFER
      CMB,INB      MAKE NEG
      STB BPTR     SET TAPE FLAG
      LDB .BUFA    GET I/O BUFFER
      ADB .36      COMPUTE TAPE BUFFER
      STB BUFAD    STORE IN BUFFER ADDRESS
      JMP SIMP
*
***   CHANNEL # 1 INTERRUPT PROCESSOR
*
INT1  NOP
      STA &SV1     SAVE A-REGISTER
      LDA DFLG     LOAD DRIVER FLAG
      SZA          BUSY?
      JMP &INT1    YES- SET INTERRUPT FLAG
      CCA          A=-1
      STA DFLG     SET DRIVER FLAG
      JSB SAVRG    SAVE REGISTERS
      CLA,INA      A = CHANNEL 1
      JSB INT      PROCESS CHARACTER
      CLA          CLEAR DRIVER...
      STA DFLG     ... BUSY FLAG
      LDA &SV1     RESTORE A-REGISTER
      JMP INT1,I   RETURN
*
&INT1 ISZ INT1F    INDEX INTERRUPT FLAG
      JMP *-3      RETURN
&SV1  NOP

*
*
*
*
*
*     WRITE REQUEST FROM USER 2
*
WRIT2 NOP
      STA OCNT2    SAVE COUNTER
      STB BFAD2    SAVE ADDRESS
      JMP WCONT    MOVE IN AND PROCESS
*
*     READ REQUEST FROM USER 2
*
READ2 NOP
      STA OCNT2    SAVE COUNTER
      STB BFAD2    SAVE ADDRESS
      JMP RCONT     CONTINUE SETTING UP INPUT
*
***   TAPE CALL FOR USER 2
*
TAPE2 NOP
      LDA TAPE2
      STA READ2
      JMP TCONT
*
*
*
***   CHANNEL # 2 INTERRUPT PROCESSOR
*
INT2  NOP
      STA &SV2     SAVE A-REGISTER
      LDA DFLG     LOAD DRIVER FLAG
      SZA          BUSY?
      JMP &INT2    YES- SET INTERRUPT FLAG
      CCA          A=-1
      STA DFLG     SET DRIVER FLAG
      JSB SAVRG    SAVE REGISTERS
      LDA .2       A = CHANNEL 2
      JSB INT      PROCESS CHARACTER
      CLA          CLEAR DRIVER...
      STA DFLG     ... BUSY FLAG
      LDA &SV2     RESTORE A-REG
      JMP INT2,I   RETURN
*
&INT2 ISZ INT2F    INDEX INTERRUPT FLAG
      JMP *-3      RETURN
&SV2  NOP
*
*
*
*     WRITE REQUEST FOR USER 3
*
WRIT3 NOP
      STA OCNT3
      STB BFAD3
      JMP WCONT    MOVE IN AND PROCESS
*
*      READ REQUEST FOR USER 3
*
READ3 NOP
      STA OCNT3
      STB BFAD3
      JMP RCONT
*
*      TAPE REQUEST FOR USER 3
*
*
TAPE3 NOP
      LDA TAPE3
      STA READ3
      JMP TCONT
*
***   CHANNEL # 3 INTERRUPT PROCESSOR
*
INT3  NOP
      STA &SV3     SAVE A-REGISTER
      LDA DFLG     LOAD DRIVER FLAG
      SZA          BUSY?
      JMP &INT3    YES- SET INTERRUPT FLAG
      CCA          A=-1
      STA DFLG     SET DRIVER FLAG
      JSB SAVRG    SAVE REGISTERS
      LDA .3       A = CHANNEL 3
      JSB INT      PROCESS CHARACTER
      CLA          CLEAR DRIVER...
      STA DFLG     ... BUSY FLAG
      LDA &SV3     RESTORE A-REG
      JMP INT3,I   RETURN
*
&INT3 ISZ INT3F    INDEX INTERRUPT FLAG
      JMP *-3      RETURN
&SV3  NOP
*
***   WRITE REQUEST FROM USER 4
*
WRIT4 NOP
      STA OCNT4    SAVE BUFFER LENGTH
      STB BFAD4    SAVE BUFFER ADDRESS
      JMP WCONT    MOVE IN AND PROCESS
*
***   READ REQUEST FROM USER 4
*
READ4 NOP
      STA OCNT4    SAVE COUNTER
      STB BFAD4    SAVE ADDRESS
      JMP RCONT    CONTINUE SETTING UP INPUT
*
***   TAPE REQUEST FOR USER 4
*
TAPE4 NOP
      LDA TAPE4
      STA READ4
      JMP TCONT
*
***   CHANNEL 4 INTERRUPT PROCESSOR
*
INT4  NOP
      STA &SV4     SAVE A-REGISTER
      LDA DFLG     LOAD DRIVER FLAG
      SZA          BUSY?
      JMP &INT4    YES-SET INTERRUPT FLAG
      CCA          A=-1
      STA DFLG     SET DRIVER FLAG
      JSB SAVRG    SAVE REGISTERS
      LDA .4       A=CHANNEL 4
      JSB INT      PROCESS INTERRUPT
      CLA          CLEAR DRIVER---
      STA DFLG     ---BUSY FLAG
      LDA &SV4     RESTORE A-REGISTER
      JMP INT4,I   RETURN
*
&INT4 ISZ INT4F    INDEX INTERRUPT FLAG
      JMP *-3      RETURN
&SV4  NOP
*
CLC1  NOP
      CLC 0
      JMP CLC1,I
*
CLC2  NOP
      CLC 0
      JMP CLC2,I
*
CLC3  NOP
      CLC 0
      JMP CLC3,I
*
CLC4  NOP
      CLC 0
      JMP CLC4,I
*
CLCL  NOP
      CLC 0
      JMP CLCL,I
*
***   INPUT CALL FOR LOG TTY
*
READL NOP
      LDA .6
      LDB PTBA
      STA OCNTL    SAVE CHARS REQUESTED COUNT
      STB BFADL    SAVE BUFFER ADDRESS
      LDA .5       A = 5 : USER # 5 (LOG TTY)
      STA DFLG     SET DRIVER BUSY FLAG
      STA USNT     SAVE IN USER TEMP
      JSB IOIN     MOVE USER IN
      JSB DRIVI    INITIATE INPUT
      JSB IOOT     MOVE USER OUT
      CLA          CLEAR DRIVER ->
      STA DFLG     --> BUSY FLAG
      JMP READL,I  RETURN
*
*     OUTPUT CALL FOR LOCAL TTY
*
OUTL  NOP
      STA OCNTL
      STB BFADL
      LDA USN      LOAD USER NUMBER
      STA LUSN     SAVE IN LOCAL USER NUMBER
      LDA .5       A = 5 : USER # 5 (LOG TTY)
      STA DFLG     SET DRIVER BUSY FLAG
      STA USNT     SET TO USER # 5 (LOG)
      JMP WCONT+4
*
***   LOG TTY INTERRUPT PROCESSOR
*
INTL  NOP
      STA &SVL     SAVE A-REGISTER
      LDA DFLG     LOAD DRIVER FLAG
      SZA          BUSY?
      JMP &INTL    YES- SET INTERRUPT FLAG
      CCA          A=-1
      STA DFLG     SET DRIVER FLAG
      JSB SAVRG    SAVE REGISTERS
      LDA .5       A = 5 : USER # 5 (LOG TTY)
      JSB INT      PROCESS CHARACTER
      CLA          CLEAR DRIVER...
      STA DFLG     ... BUSY FLAG
      LDA &SVL     RESTORE A-REG
      JMP INTL,I   RETURN
*
&INTL ISZ INTLF    INDEX INTERRUPT FLAG
      JMP *-3      RETURN
&SVL  NOP
*
*******************************************
***                                     ***
***   TIME-SHARED INTERRUPT PROCESSOR   ***
***                                     ***
*******************************************
*
*
INT   NOP
      STA USNT
      JSB IOIN
      JSB DRIV
      JSB IOOT
      JMP INT,I
*
*
*
***   INPUT - OUTPUT UTILITY ROUTINES
*
IOIN  NOP           MOVE USER IN
      CCA           A= -1
      ADA IOSKA     ADD ON USER STACK ADDRESS
      ADA USNT     INDEX BY USER NUMBER
      LDA A,I      LOAD SOURCE ADDRESS
      LDB DRVSK    LOAD DRIVER STACK
      JSB MVSTK    MOVE I/O STACK
      DEC 11
      JMP IOIN,I   RETURN
*
IOOT  NOP          MOVE USER OUT
      CCB          GET I/O STACK ADDRESS
      ADB IOSKA
      ADB USNT     INDEX BY USER NUMBER
      LDB B,I      LOAD ACTUAL DESTINATION ADDRESS
      LDA DRVSK    LOAD SOURCE ADDRESS
      JSB MVSTK    MOVE USER OUT
      DEC 11
      CLO          CLEAR OVERFLOW
      LDA SAVE     GET E & O
      SLA,ELA      CHK OV AND MOVE E INTO POS
      STO          OVERFLOW SET
      LDB SAVB     LOAD B-REG
      JMP IOOT,I   RETURN
*
*
*
*
*
*     MOVE STACK SUBROUTINE
*
*
*
***   SUBROUTINE TO MOVE STACK OF VALUES
*
*     CALL:
*     LOAD A-REGISTER WITH ADDRESS OF ORIGIN STACK
*     LOAD B-REGISTER WITH ADDRESS OF DESTINATION STACK
*     (P)          JSB MVSTK
*     (P+1)        OCT<N>  N IS NUMBER OF WORDS TO MOVE
*     (P+2)        RETURN
*
MVSTK NOP          ADDRESS OF NUMBER OF WORDS TO MOVE
      STA ORSTK    SAVE ORIGIN STACK ADDRESS
      LDA MVSTK,I  LOAD # OF WORDS TO TRANSFER
      CMA,INA,SZA,RSS
      JMP NORET
      STA TEMP     STORE AWAY COUNTER
P1... LDA ORSTK,I  LOAD CELL FROM ORIGIN STACK
      STA B,I      TRANSFER TO DESTINATION STACK
      INB          B= NEXT ADDRESS IN D-STACK
      ISZ ORSTK    INDEX TO NEXT ADDRESS IN O-STACK
      ISZ TEMP     TEST IF FINISHED
      JMP P1...    NO, CONTINUE
NORET ISZ MVSTK      COMPUTE RETURN ADDRESS
      JMP MVSTK,I  RETURN VIA ADDRESS IN MVSTK
*
*
*
*
*
*
*     SAVE REGISTER SUBROUTINE
*
SAVRG NOP
      STB SAVB     SAVE B-REGISTER
      ERA,ALS      SAVE E IN BIT 15
      SOC          CHECK OVERFLOW
      INA          INDEX A IF O SET
      STA SAVE     SAVE E & O
      JMP SAVRG,I
*
*
*
*
IMON  NOP           TURN ON STOP
      CCA
      ADA IOSKA     GET STACK ADDRESS
      ADA USN
      LDA A,I
      ADA .10       ADD INDEX TO INHIBIT FLAG
      CLB           CLEAR INHIBIT
      STB A,I
      JMP IMON,I
*
IMOFF NOP           TURN OFF STOP
      CCA
      ADA IOSKA
      ADA USN
      LDA A,I
      ADA .10
      STA A,I       SET STOP INHIBIT FLAG
      JMP IMOFF,I
*
*
***   MAIN CONSTANTS AND TABLES FOR TSB DRIVERS
*
ORSTK NOP
TEMP  NOP
SAVB  NOP
SAVE  NOP
.5    OCT 5
&CT   NOP
&BIAS NOP
&MAIN NOP
&USR  NOP
LUSN  NOP
DWS   DEF *+1
      DEF WRIT1,I
      DEF WRIT2,I
      DEF WRIT3,I
      DEF WRIT4,I
DRS   DEF *+1
      DEF READ1,I
      DEF READ2,I
      DEF READ3,I
      DEF READ4,I
*
FLAG1 NOP
MAIN  NOP
CT    NOP
BIAS  NOP
@CARD DEF CCARD
@PHTO DEF CPHTO
TEMP1 NOP
BSKA  DEF BSK1-1
INTA  OCT 30
USNT  NOP
WRITL EQU OUTL
*
***   INTERRUPT FLAGS
*
INTF  DEF *+1
INT1F NOP
INT2F NOP
INT3F NOP
INT4F NOP
INTLF NOP
*
TCNTA DEF *
      NOP
      NOP
      NOP
      NOP
*
ADR1  NOP
*
*************************************
***                               ***
***   MONITOR - USER I/O STACKS   ***
***                               ***
*************************************
*
***   USER #1 I/O STACK
*
BFAD1 NOP          ADDRESS OF USER BUFFER
      NOP          NEGATIVE COUNTER
      DEF CHIN1
      DEF CHOT1
IO1   NOP
DATA1 NOP          DATA IN-OUT-ERROR FLAG
OCNT1 NOP          LENGTH FROM I/O CALL
      NOP          POSITIVE COUNTER
      DEF CLC1
      NOP          TAPE FLAG
      OCT 1
*
***   USER #2 I/O STACK
*
BFAD2 NOP
      NOP          NEGATIVE COUNTER
      DEF CHIN2
      DEF CHOT2
IO2   NOP
DATA2 NOP          DATA FLAG
OCNT2 NOP          ORIGINAL COUNTER
      NOP          POSITIVE COUNTER
      DEF CLC2
      NOP          TAPE FLAG
      OCT 1
*
***   USER #3 I/O STACK
*
*
BFAD3 NOP
      NOP          NEGATIVE COUNTER
      DEF CHIN3
      DEF CHOT3
IO3   NOP
DATA3 NOP
OCNT3 NOP
      NOP          POSITIVE COUNTER
      DEF CLC3
      NOP          TAPE FLAG
      OCT 1
*
***   USER # 4 I/O STACK
*
BFAD4 NOP
      NOP          NEGATIVE COUNTER
      DEF CHIN4
       DEF CHOT4
IO4    NOP
DATA4 NOP
OCNT4 NOP
      NOP          POSITIVE COUNTER
      DEF CLC4
      NOP          TAPE FLAG
      OCT 1
*
***   LOCAL TTY ( USER # 5) I/O STACK
*
BFADL NOP
      NOP          NEGATIVE COUNTER
      DEF CHINL
      DEF CHOTL
IOL   NOP
DATAL NOP          DATA IN-OUT-ERROR FLAG
OCNTL NOP
PCNTL NOP
      DEF CLCL
      NOP          TAPE FLAG
      OCT 1
*
*     USER I/O STACK NAMES
*
IOSKA DEF *+1
      DEF BFAD1    USER # 1 I/O STACK NAME
      DEF BFAD2    USER # 2 I/O STACK NAME
      DEF BFAD3    USER # 3 I/O STACK NAME
      DEF BFAD4    USER # 4 I/O STACK NAME
      DEF BFADL    LOG TTY STACK NAME
*
*
***   DRIVER BUSY FLAG
*
DFLG  NOP
*
*
*     DRIVER DATA STACK
*
*
BUFAD NOP          BUFFER ADDRESS
NCNT  NOP          NEGATIVE COUNTER
CHIN  NOP          ADDRESS OF INPUT SUBROUTINE
CHOUT NOP          ADDRESS OF OUTPUT SUBROUTINE
IOFLG NOP          INPUT/OUTPUT FLAG
DATA  NOP          DATA-IN-OUT-ERROR FLAG
OCNT  NOP          ORIGINAL COUNTER
PCNT  NOP          POS COUNTER
CLC   NOP
BPTR  NOP
STPIN OCT 0
*
DRVSK DEF BUFAD    DRIVER STACK POINTER
INCMD OCT 160001   INPUT COMMAND
OTCMD OCT 130000
*
PTPRA ABS PTPRC
PTBA  ABS PTBUF
      SKP
*
**************************************
***                                ***
***   TIME-SHARE TELETYPE DRIVER   ***
***                                ***
**************************************
*
*
*
*
*
*     INITIATE OUTPUT
*
RESET NOP
      JSB CLEAR     PUT RUBOUT INTO BOARD
      CLA          CLEAR
      STA DATA     DATA FLAG
      STA PCNT     POSITIVE COUNTER
      LDA OCNT     LOAD NEGATIVE COUNTER
      SSA,RSS      CHECK IF NEGATIVE
      CMA,INA      NO - MAKE NEG
      STA NCNT     SAVE NEGATIVE COUNTER
      JMP RESET,I
*
DRIVO NOP
      JSB RESET
      LDB BUFAD    CHECK BUFFER ADDRESS
      SZB,RSS      IS IT ZERO?
      STA OCNT     YES - RESET OCNT TO NEGATIVE
      LDA OTCMD    LOAD OUTPUT COMMAND
      STA IOFLG    SAVE IN I/O FLAG
      JSB DRIV     GO TO CONTINUATOR
      JMP DRIVO,I  RETURN TO MONITOR*
*
*
*     INITIATE INPUT
*
*
DRIVI NOP
      JSB RESET
      LDB INCMD    SET INPUT COMMAND
      STB IOFLG    IN I/O FLAG
      JSB CHIN,I   START INPUT
      JMP DRIVI,I  RETURN
*
*

*
*
      SKP
*
*
*******************************
***                         ***
***    TIME-SHARE DRIVER    ***
***   CONTINUATOR SECTION   ***
***                         ***
*******************************
*
*
*
DRIV  NOP
*
*     CHECK I/O FLAG
*
      LDB IOFLG    LOAD I/O FLAG
      SLB          CHECK IF INPUT
      JMP INPUT    YES - GO TO INPUT SECTION
*
*
***   OUTPUT SECTION   ***
*
*
      LDA CHIN     TEST FOR STOP COMMAND
      INA          COMPUTE ADDRESS OF LIA INSTR
      LDA A,I      LOAD LIA INSTRUCTION
      STA INST.    STORE FOR EXECUTION
INST. NOP          EXECUTE LIA CHANXX
      AND M177     MASK TO LOWER 7-BITS
      CPA RBOUT    IS IT A RUBOUT
      JMP OK       YES
      JMP STOP     SET STOP FLAG
OK    LDA NCNT
      SSA,RSS      CHECK IF DONE
      JMP OT1      YES
      LDB BUFAD    CHECK BUFFER ADDRESS
      SZB,RSS      IS IT ZERO?
      JMP LEADR    YES
OT5   JSB ACCHR    GET NEXT CHARACTER
      IOR M200     ADD PARITY
      LDB IOFLG    LOAD I/O FLAG
      JSB CHOUT,I  OUTPUT CHARACTER
      JMP DRIV,I   RETURN
*
*     CHECK FOR CR-LF
*
OT1   LDA OCNT     GET ORIGINAL COUNTER
      SSA          CHECK IF CR-LF
      JMP OT2      NO - DONE
      LDA M4       LOAD -4 CHARACTERS
      LDB CRLFA    LOAD CARRIAGE RETURN LINE FEED
      STA OCNT     SAVE COUNT
      STA NCNT     SAVE NEGATIVE COUNTER
      STB BUFAD    SAVE BUFFER
      CLA          CLEAR POSITIVE COUNTER
      STA PCNT
      JMP OT5      OUTPUT
*
OT2   LDA M15       LOAD BIT 15=1
      STA DATA     SET DATA OUT FLAG
      JSB CLC,I
      JMP DRIV,I
*
*
***   SET STOP FLAG
*
STOP  LDA STPIN     LOAD STOP INHIBIT
      SZA           INHIBITED?
      JMP OK       YES
      JSB CLEAR    CLEAR USER TTY BOARD
      LDA &EXU     SET EXU FLAG TO I/O STOP
      ADA USNT     BY SETTING IT TO -2
      LDB M2
      STB A,I
      JMP OK       STOP FLAG SET- OUTPT NEXT CHAR
*
*
*
***   PUT RUBOUT CHARACTER INTO TTY
*
CLEAR NOP
      LDA CHOUT    GET CHARACTER OUTPUT ADDRESS
      INA          INDEX TO OTB INST.
      LDA A,I      LOAD INSTRUCTION
      STA INS..    STORE IT
      LDB RBOUT    LOAD RUBOUT CHARACTER
INS.. NOP          INSTRUCTION LOCATION
      JMP CLEAR,I  RETURN
      SKP
*
***   INPUT SECTION   ***
*
*
INPUT JSB CHIN,I   INPUT CHAR
      CPA RT       CARRIAGE RETURN?
      JMP IN1      YES - DONE
      LDB NCNT     LOAD NEG COUNTER
      SSB,RSS      CHECK IF DONE
      JMP IN2      YES
      SZA,RSS      TEST FOR NULL RECORD
      JMP TPTST    GO SEE IF IN TAPE INPUT MODE
      CPA LF       TEST FOR LINE-FEED
      JMP DRIV,I   YES, THEN IGNORE
      CPA RBOUT    TEST FOR RUBOUT
      JMP DRIV,I   RUBOUT, IGNORE
      CPA AMODE    ALT MODE?
      JMP IN4      YES, SET DELETE FLAG
      CPA EMODE    ESCAPE MODE?
      JMP IN4      YES, SET DELETE FLAG
      CPA LFTAR    IS IT A LEFT ARROW?
      JMP DLETE    YES, DELETE PREVIOUS CHARACTER
      JSB STORC    STORE CHARACTER
IN2   JMP DRIV,I   RETURN
*
IN1   LDB NCNT     LOAD NEG COUNTER
      CLA,INA      SET A=1
      SSB          CHECK IF OK
      JMP IN3      YES
      SLB          MAYBE - CHECK BIT 0
      CCA          SET A=-1
IN3   STA DATA     STORE DATA FLAG
      LDB BPTR     LOAD TAPE FLAG
      SZB,RSS      TAPE?
      JMP IN3.5    NO
      SSB          SET BPTR POSITIVE
      CMB,INB
      STB BPTR
      LDA PCNT     LOAD POSITIVE COUNTER
      SZA,RSS      0?
      JMP RSTRT    YES
      INA          COMPUTE # OF WORDS
      CLE,ERA      DIVIDE BY 2 AND SAVE ODD/EVEN
      STA !L!      STORE WORD COUNT
      CMA,SEZ,INA,RSS
      INA          ODD NUMBER OF CHARS
      ADA BUFAD    COMPUTE START OF TAPE BUFFER
      STA BUFAD    RESTORE TAPE BUFFER ADDRESS
*
      JSB MVSTK    MOVE STRING TO I/O BUFFER
!L!   NOP
*
      LDA PCNT     RELOAD COUNT
      LDB TCNTA    LOAD TAPE COUNTER ADDRESS TABLE
      ADB USNT     INDEX TO USER
      STA B,I      SAVE COUNT
*
      LDA DATA     LOAD DATA FLAG
      STA STPIN    SAVE IN INTERRUPT INHIBIT
      JSB DRIVI    START NEW OPERATION
      LDA STPIN
      STA DATA     RESTORE DATA FLAG
      JMP DRIV,I   RETURN
*
IN3.5 JSB CLC,I    TURN OFF TTY
      JMP DRIV,I   RETURN
*
IN4   LDA M2       RECORD DELETED
      LDB BPTR     IN TAPE?
      SZB,RSS
      JMP IN3      NO
*
      LDA PCNT     YES LOAD COUNT
      INA
      ARS
      CMA,INA
      ADA BUFAD    COMPUTE TAPE BUFFER ADDRESS
      STA BUFAD    RESTORE TAPE BUFFER
RSTRT JSB DRIVI    RESTART INPUT
      JMP DRIV,I   RETURN
*
*
***   DELETE CHARACTER FROM BUFFER (_)
*
DLETE LDB PCNT     FETCH BUFFER COUNTER
      SZB,RSS      IS BUFFER EMPTY?
      JMP DRIV,I   YES, IGNORE AND RETURN
      CCA          SET A=-1
      ADB A        DECREMENT CHARACTER COUNT
      STB PCNT     RESTORE BUFFER COUNT
      ADA NCNT     DECREMENT NEGATIVE COUNTER
      STA NCNT     RESTORE IT
      SLB,RSS      TEST FOR ODD/EVEN CHARACTER
      JMP DRIV,I   EVEN, JUST DECREMENT COUNT
      CCA          RESET A =-1
      ADA BUFAD    DECREMENT ADDRESS POINTER
      STA BUFAD    AND STORE IT
      LDA BUFAD,I  LOAD LAST TWO CHARACTERS
      AND MSK1     DELETE LAST CHARACTER
      STA BUFAD,I  RESTORE CHARACTER
      JMP DRIV,I   RETURN
*
*
LEADR LDB OCNT     LOAD ORIGINAL COUNTER
      SZB,RSS      IS IT ZERO?
      JMP OT1      YES - CR-LF
      LDB IOFLG    GET I/O FLAG
      CLA          NULL CHARACTER
      JSB CHOUT,I
      ISZ NCNT
      JMP DRIV,I
      JMP DRIV,I
*
***   SECTION TO TEST FOR LEADER / TRAILER TAPE
*
TPTST LDA BPTR     LOAD TAPE FLAG
      SZA,RSS      0?
      JMP DRIV,I   YES
      SSA          LEADER?
      JMP DRIV,I   YES
      CLA          END-OF-TAPE
      STA PCNT     CLEAR COUNTER
      STA BPTR     CLEAR TAPE FLAG
      CLA,INA      SET DATA FLAG
      JMP IN3
CRLFA DEF *+1
      OCT 6412,177777
RT    OCT 15       CARRIAGE RETURN
LFTAR OCT 137
AMODE OCT 176
*
      SKP
*
*
***************************************
***                                 ***
***   SPECIAL SERVICE SUBROUTINES   ***
***                                 ***
***************************************
*
*     SUBROUTINE TO STORE CHARACTER
*
*
STORC NOP
      LDB PCNT     GET POSITIVE COUNTER
      SLB,RSS      CHECK UPPER/LOWER FLAG
      ALF,SLA,ALF  UPPER - ROTATE AND SKIP
      IOR BUFAD,I  LOWER - ADD TO UPPER CHAR
      STA BUFAD,I  STORE WORD
      SLB,INB      CHECK U/L AND INC COUNTER
      ISZ BUFAD    LOWER - NEW WORD
      STB PCNT     STORE POS COUNTER
      ISZ NCNT     INC NEG COUNTER
      JMP STORC,I  RETURN
      ISZ NCNT     DATA IN - SET DINF
      JMP STORC,I  RETURN
*
*
*     SUBROUTINE TO ACCESS ONE CHARACTER
*
*
ACCHR NOP
      LDB PCNT     LOAD POSITIVE COUNTER
      LDA BUFAD,I  LOAD WORD
      SLB,RSS      CHECK UPPER OR LOWER
      ALF,ALF      ROTATE UPPER CHAR TO LOW BITS
      AND M177     MASK OFF UPPER BITS
      IFN
* CSL MODIFICATIONS TO REMOVE BRACKETS.
*   DO NOT INCLUDE IN HP VERSION***
*
      CPA LBRAK
      LDA LPREN
      CPA RBRAK
      LDA RPREN
*
*
      XIF
      SLB,INB      CHECK IF NEW WORD NEEDED
      ISZ BUFAD    YES - INCREMENT ADDRESS
      STB PCNT     SAVE POS COUNTER
      ISZ NCNT     INCREMENT NEG COUNTE
      JMP ACCHR,I  RETURN
      JMP ACCHR,I  RETURN
EXUA  DEF EXU1
EXUA. EQU EXUA
&EXU  DEF EXU1-1
      IFN
*
*
*    BRACKET TEST   UNNECESSARY IN HP VERSION
*
LBRAK EQU 442B
LPREN EQU 417B
RPREN EQU 420B
RBRAK OCT 135
      XIF
      SKP
*
***   THIS SECTION OF TIME-SHARE DRIVERS AND MONITOR
***   IS DESIGNED TO SAVE ALL RUNNING CONDITION
***   POINTERS WHEN A POWER FAIL OCCURS AND TO RE-
***   INITIATE THE COMPUTER WHEN POWER RETURNS.
*
*
***   THIS SECTION STOPS THE COMPUTER
*
!FAIL NOP          ENTRY POINT FROM INTERRUPT
      CLF 0        TURN OFF INTERRUPT
      SFC PFL      UP OR DOWN?
      JMP UP^^^    GO TO RESTERT SECTION
      STA ASTR     SAVE A - REGISTER
      STB BSTR     SAVE B - REGISTER
      ERA,ALS
      SOC
      INA          SAVE E & O REGISTERS
      STA EO
      LDA !FAIL    LOAD RETURN ADDRESS
      STA RETAD    SAVE FOR RETURN
      CLC PFL      TURN ON RESTART
      HLT PFL      STOP COMPUTER
      JMP UP^^^
*
***   THIS SECTION RE-INITIATES THE COMPUTER
*
UP^^^ CLO
      LDA EO
      SLA,ELA      RESTORE E & O REGISTERS
      STO
      LDB RBOUT
LTTY4 OTB 0        SET RUBOUT CHAR IN LOG TTY
      NOP          (OTB USER #1)
      NOP          (OTB USER #2)
      NOP          (OTB USER #3)
      NOP          (OTB USER #4)
      LDB IO1      LOAD CHAN 1 I/O FLAG
      NOP          OTB CHAN 1
      LDB IO2      LOAD CHAN 2 I/O FLAG
      NOP
      LDB IO3      LOAD CHANNEL 3 I/O FLAG
      NOP          OTB CHAN3
      LDB IO4      LOAD CHANNEL 4 I/O FLAG
      NOP          OTB CHAN4
      LDB IOL      LOCAL TTY I/O FLAG
ZT[   NOP
*
*
      LDA .4
CL4   OTA 0
      LDA ASTR     RESET A - REGISTER
      LDB BSTR     RESET B-REGISTER
LTTY5 STC 0,C
      NOP          (STC,C CHAN 1)
      NOP          (STC,C CHAN 2)
      NOP          (STC,C CHAN 3)
      NOP          (STC,C CHAN 4)
?PFLI NOP          (CLC RDR IF IN SYSTEM)
      NOP          (CLC CARD IF IN SYSTEM)
CL3   STC 0,C
      STC PFL      SET UP FOR NEXT FAILURE
      STF 0        TURN ON INTERRUPT
      JMP RETAD,I  RETURN TO INTERRUPTED SEQUENCE
*
***   STORAGE FOR POWER FAIL PROGRAM
*
ASTR  NOP
BSTR  NOP
EO    NOP
RETAD NOP
LWAMS EQU *
*
*
*
      SKP
*
**********************************
***                            ***
***   BASE PAGE LINKAGE AREA   ***
***                            ***
**********************************
      ORG 3B
      DEF PTSBS
      JSB PFAIL,I  POWER FAIL INTERRUPT LOCATION
      HLT 5B
*
*     I/O CHANNELS
*
PFL   EQU 4B       POWER FAIL CHANNEL
      ORG 10B
      REP 9
      NOP          INTERRUPT NOP'S
      ORG 30B
*
*     INTERRUPT LINKS
*
*
I/O1  ABS TIMR
I/O2  ABS INT1
I/O3  ABS INT2
I/O4  ABS INT3
I/O5  ABS INT4
I/O6  ABS INTL
I/O7  ABS RDINT
I/O8  ABS CRINT
PFAIL DEF !FAIL    LINK TO POWER FAIL ROUTINE
*
***   BASE PAGE LINKS TO BASIC AND MONITOR
*
      ORG 60B
      DEF CARDS    LINK TO CARD READER INITIATE
PTAP  BSS 1
      DEF .HSPR
USN   BSS 1
ASTK  BSS 1
EXU1  EQU *
EXU2  EQU *+1
EXU3  EQU *+2
EXU4  EQU *+3
      ORG 71B
BSK1  DEF SK1
BSK2  DEF SK2
BSK3  DEF SK3
BSK4  DEF SK4
      ORG 101B
      DEF LOGOF
      DEF MSSG
&MON& DEF MONIT
      DEF SEXU
      DEF IMON
      DEF IMOFF
XECUT BSS 1
I.STP BSS 1
ACTIV EQU *
WRITE EQU ACTIV+1
REED  EQU ACTIV+2
FWAM  EQU ACTIV+3
LWAM  EQU ACTIV+4
.BUFA EQU ACTIV+5
SYMTA EQU .BUFA+1
PBUFF EQU SYMTA+2
PBPTR EQU PBUFF+1
.LNUM EQU PBPTR+2
SBUFA EQU ACTIV+7
BADDR EQU ACTIV+12
CCNT  EQU ACTIV+13
SBPTR EQU ACTIV+18
      ORG 205B
TEMPS EQU *
INFO1 EQU TEMPS+18
INFO2 EQU TEMPS+19
INFO3 EQU TEMPS+20
ONADR EQU 100B
RDYDA EQU 255B
TSRCH EQU RDYDA+5
PEXMA EQU RDYDA-1
OUTIA EQU RDYDA+13
OUTIN EQU OUTIA
DIGCK EQU RDYDA+18
LETCK EQU DIGCK+1
GETCR EQU DIGCK-1
OUTCR EQU DIGCK-2
      ORG 370B
.1    EQU *
.2    EQU *+1
.3    EQU *+2
.4    EQU *+3
.6    EQU *+4
.7    EQU *+5
.10   EQU *+8
.12   EQU *+9
LF    EQU .10
BLANK EQU *+17
.32   EQU BLANK
.15   EQU *+10
.36   EQU *+21
.41   EQU *+24
.48   EQU *+29
.63   EQU *+32
.72   EQU *+36
EMODE EQU *+13
M177  EQU .72+7
RBOUT EQU M177
M200  EQU M177+1
M377  EQU M177+2
      ORG 477B
M1    EQU *
M2    EQU *+1
M3    EQU *+2
M4    EQU *+3
M5    EQU *+4
M6    EQU *+5
M7    EQU *+6
M8    EQU *+7
M9    EQU *+8
M10   EQU *+9
M11   EQU *+10
M16   EQU *+12
M19   EQU *+13
M21   EQU *+14
M25   EQU *+15
D72   EQU *+18
D100  EQU *+19
MSK1  EQU *+24
D1000 EQU *+26
M15   EQU D1000+5
[SEX[ EQU .SEX.-1
B177  EQU M177
SEXUA EQU &MON&+1
.77   EQU .72-4
TFLAG EQU CCNT+1
AT    EQU .63+1
.30   EQU .10+7
.37   EQU .10+14
SP    EQU .32
BLNK  EQU PBPTR+1
LNUM  EQU PBPTR+2
RUNA  EQU PEXMA-2
DRQST EQU PEXMA+2
STK19 EQU TEMPS-7
ERROR EQU 544B
..ERR EQU 545B     LINK TO ERROR+1 IN BASIC
RN.$. EQU 2141B    LINK TO "RUN" ADDRESS IN BASIC
$RUN$ EQU PEXMA-2
$LST$ EQU PEXMA+3
$FS3$ EQU PEXMA-1
      ORG 53B
X1    DEF Y1
X2    DEF Y2
X3    ABS 2012B
X4    DEF Y3
X6    DEF Y6       LINK TO Y6 FROM LIST, ETC.
*
***   SET UP USER STACKS
*
      ORG 13203B
STCKS EQU *
SK1   ABS TAPE1
      ABS WRIT1
      ABS READ1
FWAM1 NOP
LWAM1 NOP
      BSS 83
SK2   ABS TAPE2
      ABS WRIT2
     ABS READ2
FWAM2 NOP
LWAM2 NOP
      BSS 83
SK3   ABS TAPE3
      ABS WRIT3
      ABS READ3
FWAM3 NOP
LWAM3 NOP
      BSS 83
SK4   ABS TAPE4
      ABS WRIT4
      ABS READ4
FWAM4 NOP
LWAM4 NOP
      BSS 83
*
FINIS EQU *
      END
