|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 27550 (0x6b9e)
Notes: pts_type(SC)
Names: »LOGOP.SC«
└─⟦8ac270cab⟧ Bits:30009705 Philips computer tape "LINSIM8-2"
└─⟦this⟧ »LINSIM82/LOGOP.SC«
└─⟦fce1dcf99⟧ Bits:30009704 Philips computer tape "KMD15"
└─⟦this⟧ »LINSIM/LOGOP.SC«
IDENT LOGOP REL 1.1 82-09-28 870150040110
#1
UPDATE #0 77.01.26 JES
*
*
* CC SIMULATION TOOL
*
* OPERATOR CONTROL
*
* PROGRAMMER: PAN
*
*******************************************************
*
* THIS MODULE COMMUNICATES WITH
* THE OPERATOR
*
* ALLOWED INPUT KEYS:
*
* O: OPEN RECEIVER
*
* I: INSERT IN BUFFER SPECIFIED BY FOLLOWING HEXDEC NUMBER
* THEN FILL THE BUFFER WITH CHARACTERS
* /: THE TWO FOLLOWING CHARACTERS FORM AN ASCII CHARACTER
* /83 OR /97 ARE AUTOMATICALLY FOLLOWED BY LRC CALCULATED
* FROM FIRST STX OR SOH
* TO DELETE LAST CHARACTER PRESS: FEL
* *: END OF BUFFER
* CR:=*
*
* L: LIST BUFFER
* *: ALL BUFFERS
* CR:=*
* <HEXDEC>: ONE BUFFER
*
* <HEXDEC>: PUT THIS BUFFER IN TRANSMITT QUEUE
* (TIME OUT FOR RESPONSE MAY BE SPECIFIED AFTER:
* WITH UP TO TWO HEXDEC CHARACTERS)
* N,: NEW BUFFER IN QUEUE
* SEND: TRANSMITT THE BUFFER QUEUE
* CR:=SEND
* L: SEND CONTINUOUS
*
* R: RESET RECEIV BUFFER
*
* W: WRITE BUFFERS ON CASSETTE
* S: READ BUFFERS FROM CASSETTE
* X: SHIFT IDLE MODE OF TRANSMITTER
* CARRIER OFF/ MARK HOLD
* H: STOP CONTINUOUS SENDING
*
* P: DISABLE OR ENABLE PRINTER
*
**************************************************************
EJECT
*
*
*
ENTRY CODE
ENTRY ASTART
ENTRY ETX
ENTRY ETB
ENTRY SYN
ENTRY PRFLAG
*
*
EXTRN TAB1 CHAR TABLE 1
EXTRN TAB2 CHAR TABLE 2
EXTRN TAB3
EXTRN TAB4
EXTRN AREA TRANSMIT AREAS
EXTRN LENGTH TOTAL INDIVIDUAL AREA LENGTH
EXTRN TRQ TRANSMIT QUEUE
EXTRN TRQE END OF TRANSMIT QUEUE
EXTRN LOGIN LOG INPUT TASK START ADDRESS
EXTRN WRITE WRITE TASK ACTIVATION
EXTRN WRECB WRITE ECB
EXTRN PRPOOL OCCUPIE PRINTER BUFFER POOL
EXTRN TEXT1
EXTRN TEXT2 ***CASSETTE ERROR***
EXTRN TEXT3 ***BUFFERS DUMPED ON CASSETTE***
EXTRN TEXT4 ***BUFFERS LOADED***
EXTRN ASTOEB
EXTRN CRCCAL
*
*
* EQUATES
*
*
SOH EQU /01
STX EQU /02
ECBBA EQU 2
ECBRL EQU 4
ECBRC EQU 8
ECBCW EQU 10
*
*
RES 20 STACK FOR A14
STB EQU *-2
PROCCB DATA 0 ADDRESS TO PRINTER OCCUPIED BUFFFER
CODE DATA 0 0 = ASCII , 1 = EBCDIC
XBCC DATA 0 SWITCH FOR BCC ACCUMULATION
SYN DATA 0
ETB DATA 0
ETX DATA 0
HEXCHA DATA 0
EJECT
*
*
* START LOOP TEST TOOL
*
*
ASTART EQU *
CM PROCCB RELEASE PRINTER BUFFER
ASTA20 EQU *
LDK A1,/80
SC A1,WRECB SET WRITE ECB NOT BUSY
LDKL A7,'OP'
LKM
DATA -4,OPCTRL ACTIVATE OPERATOR CONTROL TASK
LDKL A7,'IN'
LKM
DATA -4,LOGIN ACTIVATE LOG TASK
LKM
DATA 3
EJECT
*
*
* OPERATOR CONTROL TASK
*
*
OPCTRL EQU *
LDKL A14,STB
LDK A7,' '
CF A14,OCCPR OCCUPIE PRINTER
OPCT10 EQU *
CF A14,CRLF
LDKL A2,TEXT1
CF A14,PRTXT
CF A14,READE READ E OR A
DATA KT050,FT050
LDK A7,'?'
CF A14,PRCH INVALID KEY
RB OPCT10 TRY AGAIN
*
*
KT050 DATA /0241,'E'
FT050 DATA OPCT20,OPCT30
*
*
EJECT
OPCT20 EQU *
CM CODE
LDK A1,/16
ST A1,SYN
LDK A1,/97
ST A1,ETB
LDK A1,/83
ST A1,ETX
RF OPCT40
OPCT30 EQU *
IM CODE
LDK A1,/32
ST A1,SYN
LDK A1,/26
ST A1,ETB
LDK A1,/03
ST A1,ETX
OPCT40 EQU *
CF A14,CRLF
LDKL A8,CTECB
LDK A7,/84
LD A3,SYN
ST A3,ECBBA,A8 STORE SYNCPATTERN
LDK A1,5
ST A1,ECBCW,A8
LKM
DATA 1 TRANSFER SYNCPATTERN
RF OPCONT
EJECT
*
* PRINT TEXT
*
PRTXT EQU *
LDR* A3,A2 GET LENGTH
ST A2,PRXECB+2
ADK A3,2
ST A3,PRXECB+4
LDK A7,/86
LDKL A8,PRXECB
LKM
DATA 1 STANDARD WRITE
CF A14,CRLF
RTN A14
*
*
PRXECB DATA /31,0,0,0,0,0
*
*
EJECT
OPCONT EQU *
LD A8,PROCCB GET BUFFER ADDRESS
RF(Z) OPCO10 NO BUFFER
LKM
DATA -8,PRPOOL RELEASE PRINTER
CM PROCCB
OPCO10 EQU *
LDKL A14,STB
CF A14,CRLF
CF A14,READ READ COMMAND
DATA KT100,FT100
CF A14,HEXCH
ABL(Z) QT QUEUE AREA FOR TRANSM.
EJECT
*
*
* TYPE: ?
*
ERRORA EQU *
CF A14,OCCPR OCCUPIE PRINTER
ERROR EQU *
LDKL A14,STB LOAD STACK BASE
LDK A7,'?' INVALID KEY
CF A14,PRCH PRINT '?'
RB OPCONT
*
*
KT100 DATA /0949,'LORWSXHP'
FT100 DATA INPUT,LIST,OPEN,RESET,WRTC,RDTC,IDLE,STPCON
DATA PRTCON
*
* PRINTER CONTROL
*
PRTCON EQU *
LD A1,PRFLAG GET THE PRINTER FLAG
RF(Z) PRTC05 NOT SET, SET IT
CM PRFLAG SET, CLEAR IT
RB OPCONT
PRTC05 EQU *
LDK A1,'P' PUT A P IN THE FLAG
ST A1,PRFLAG
RB OPCONT
PRFLAG EQU *
DATA 0
EJECT
*
*
* INPUT TO TRANSMIT BUFFER
*
* A9 =LRC
* A10=AREA POINTER
* A11=CHAR COUNTER FOR CURRENT LINE
*
*
INPUT EQU *
CF A14,OCCPR OCCUPIE PRINTER
CF A14,PRSPAC SPACE
CF A14,READE READ AREA NUMBER
DATA 0
DATA FT200
FT200 EQU *
CF A14,HEXCH
RB(NZ) ERROR
IN050 EQU *
LDKL A10,AREA COMPUT E AREA BASE
IN100 SUK A7,1
RF(N) IN120
ADKL A10,LENGTH
RB IN100
IN120 LDR A12,A10 SAVE AREA BASE
CF A14,CRLF
ADKL A10,2 ADJUST POINTER
LDKL A11,0
LDK A5,0 RESET INDEX
SUR A9,A9 RESET LRC
CM XBCC
EJECT
*
*
* READ INPUT CHAR
*
*
IN200 CF A14,READE
DATA KT300,FT300
CM HEXCHA
CF A14,ITAB1 SEARCH IN TABLE 1
LDR A1,A1
RB(NZ) ERROR NOT FOUND
IN230 CWK A11,/70
RB(NG) IN200 LINE NOT FULL
CF A14,CRLF NEW LINE
RB IN200
KT300 DATA /042A,/0D2F,/2300 '*',CR,'/','#'
FT300 DATA IN900,IN900,IN800,IN700
EJECT
*
* BACK-SPACE
*
*
IN700 SUK A5,1
RF(N) IN710 BUFFER START
SUKL A10,1
RB IN200
IN710 LDK A5,0
RB IN200
EJECT
*
*
* HEXADECIMAL INPUT
*
*
IN800 CF A14,RDHEX READ HEXADECIMAL
LDR A6,A7 SAVE FIRST DIGIT
SLL A6,4
CF A14,RDHEX READ 2ND DIGIT
IM HEXCHA
ADR A7,A6
CF A14,STORE STORE IT
CF A14,PRSPAC SPACE
RB IN230
*
*
* END OF INPUT
*
*
IN900 LDKL A7,/FF
CF A14,STORE STORE END CHARACTER
STR A5,A12 SAVE LENGTH
ABL OPCONT WAIT FOR NEXT COMMAND
EJECT
*
*
* QUEUE AREA FOR TRANSMISSION
*
*
QT EQU *
LDR A2,A7 SAVE CHAR.
LDR A5,A7
CF A14,TRANSL TRANSLATE FOR PRINTER
CF A14,OCCPR OCCUPIE PRINTER
LDKL A8,CTECB
LDK A1,4
ST A1,ECBCW,A8 REMOVE REQUEST IF ANY
LDK A7,/84
LKM
DATA 1
LDR A7,A2 RESTORE A7
LDKL A5,TRQ
LDK A6,1
QT050 EQU *
STR A7,A5
ADK A5,2 INCR. INDEX
LDK A7,':'
CF A14,PRCH PRINT @
LDK A3,0
CF A14,QTREAD READ TIME OUT
LDR A3,A7
LDR A3,A3
RF(NZ) QT060
LDKL A3,/8000
QT060 EQU *
CF A14,QTREAD
SLL A3,4
ORR A3,A7
LDR A3,A3
RF(NZ) QT070
LDKL A3,/8000
QT070 EQU *
CF A14,QTREAD
ABL ERROR
*
*
* COMMA; READ NEXT TANSMITT BUFFER NUMBER
*
*
QT100 EQU *
LDKL A14,STB
STR A3,A5 STORE TIME OUT
ADK A5,2 INCR INDEX
CWK A6,60
RF(NG) QT101
LDKL A11,1
LDK A6,1
CF A14,CRLF
QT101 EQU *
CF A14,QTRED1
ABL QT050
*
*
* SEND; ACTIVATE WRITE TASK
*
*
QT150 EQU *
STR A3,A5 STORE TIME OUT
ADK A5,2 INCR INDEX
LDKL A3,/FFFF
STR A3,A5
QT155 EQU *
LDKL A7,'UT'
LKM
DATA -4,WRITE
ABL OPCONT
*
* SEND CONTINUOUS
*
QT160 EQU *
STR A3,A5 STORE TIME OUT
ADK A5,2 INCR. INDEX
LDKL A3,/CCCC INDICATE CONTINUOUS
STR A3,A5
ST A5,CUEND SAVE QUEUE-END
RB QT155 ACTIVATE WRITE TASK
CUEND EQU *
DATA 0
*
* STOP CONTINUOUS SENDING
*
STPCON EQU *
LD A5,CUEND RESTORE QUEUE POINTER
ABL(Z) OPCONT NO QUEUE, QUIT
LDKL A3,/FFFF END OF QUEUE INDICATION
STR A3,A5 FLAG END OF QUEUE.
CM CUEND CLEAR QUEUE POINTER
ABL OPCONT GET NEXT COMMAND
*
* + ; READ TRANSMIT DELAY
*
QT200 EQU *
LDKL A14,STB
LDKL A3,/8000
CF A14,RDHEX
ADR A3,A7
CF A14,QTREAD
SLL A3,4
ADKL A3,/8000
ORR A3,A7
RB QT070
EJECT
*
*
* READ TIME OUT
*
*
QTREAD EQU *
LDKL A1,TRQE
SUK A1,10
CWR A5,A1
ABL(G) ERROR
ADK A6,1
CF A14,READE
DATA KT600,FT600
CF A14,HEXCH
ABL(NZ) ERROR
RTN A14
*
*
KT600 DATA /042C,/280D,/4C00 ',''(''CR' OR'Z'
FT600 DATA QT100,QT150,QT150,QT160
*
* READ BUFFER NR OR +
*
QTRED1 EQU *
LDKL A1,TRQE
SUK A1,10
CWR A5,A1
ABL(G) ERROR
ADK A6,1
CF A14,READE
DATA KT650,FT650
CF A14,HEXCH
ABL(NZ) ERROR
RTN A14
*
KT650 DATA /012B
FT650 DATA QT200
EJECT
*
*
* CHECK HEXADEC. INPUT AND TRANSLATE
*
* CR=0 OK
* CR=1,2 ILLEGAL CHAR
*
*
HEXCH EQU *
ADKL A14,4 SKIP STACK
LDR A1,A7
SUK A1,'0'
RF(N) HEXC90
SUK A1,9
RF(NP) HEXC10 NUMBER
SUK A1,8
RF(N) HEXC90
SUK A1,5
RF(P) HEXC90
ADK A1,15 TRANSLATE HEX LETTER
LDR A7,A1
RF HEX20
HEXC10 EQU *
ADK A1,9
LDR A7,A1
HEX20 EQU *
SUR A1,A1
RF HEX99
HEXC90 EQU *
LDK A1,1
HEX99 EQU *
ABR* A14
EJECT
*
*
* LIST COMMAND
*
*
LIST EQU *
CF A14,OCCPR OCCUPIE PRINTER
CF A14,PRSPAC
CF A14,READE
DATA 0,FT400
FT400 EQU *
CF A14,HEXCH
RF(Z) LI100
CWK A7,/2A
RF(Z) LISALL
CWK A7,/0D CR?
ABL(NZ) ERROR
EJECT
*
*
* LIST ALL AREAS
*
*
LISALL LDK A5,0 AREA NUMBER IN A5
LISA10 CF A14,LISAR LIST ONE AREA
ADK A5,1
CWK A5,16
RB(NE) LISA10
ABL OPCONT
*
*
* LIST ONE AREA
*
*
LI100 EQU *
LDR A5,A7
CF A14,LISAR
ABL OPCONT
*
*
* TRANSLATE NUMBER IN A7 TO ASCII
*
*
TRANSL EQU *
CF A14,CRLF
LDK A7,'0'
ADR A7,A5 PRINT AREA NUMBER
CWK A7,/39
RF(NG) LI180
ADK A7,7
LI180 EQU *
RTN A14
EJECT
*
*
* LIST ONE AREA
*
* A5 CONTAINS AREA NUMBER
*
*
LISAR EQU *
CF A14,TRANSL
CF A14,PRCH
LDK A1,2
ST A1,PRECBL EMPTY PRINTBUFFER
LDK A1,1
ST A1,LSPACE
LDKL A10,AREA
LDK A1,0
LI200 CWR A1,A5
RF(E) LI210
ADKL A10,LENGTH
ADK A1,1
RB LI200
LI210 LDR* A9,A10 GET LENGTH
CWK A9,500
RF(NG) LI215
LDKL A9,0
LI215 EQU *
ADKL A10,2
LI220 SUKL A9,1
RF(N) LI250 ALL EDITED
LCR A7,A10 GET CHARACTER
ADKL A10,1
CW A7,ETX
RF(E) LI270 ETX
CW A7,ETB
RF(E) LI270 ETB
LD A1,CODE
RF(NZ) LI260 EBCDIC
CF A14,STAB1
RF(Z) LI230 TEXT FOUND
CF A14,STAB2
RF(Z) LI230 TEXT FOUND
LI225 EQU *
CF A14,EDHEXL EDIT IN HEXA
LI230 EQU *
LDK A1,100
CW A1,PRECBL
RB(G) LI220
LI240 EQU *
CF A14,PRLINE
RB LI220
LI250 EQU *
CF A14,PRLINE
RTN A14
LI260 EQU *
CF A14,STAB3
RB(Z) LI230
CF A14,STAB4
RB(Z) LI230
RB LI225
LI270 EQU *
LD A1,CODE
RF(NZ) LI280
CF A14,STAB2 ASCII
LI275 EQU *
SUKL A9,1
RB(N) LI250 ALL DONE
LCR A7,A10 GET LRC
ADKL A10,1
CF A14,EDHEXL
RB LI230
LI280 EQU *
CF A14,STAB4 EBCDIC
SUKL A9,1
RB(N) LI250 ALL DONE
LCR A7,A10 GET FIRST CRC CHARACTER
ADKL A10,1
CF A14,EDHEXL
RB LI275
EJECT
*
*
* CONTROL COMMANDS
*
*
IDLE LDK A2,6 SHIFT IDLE TRANSMITT
RF WRCTRL
OPEN LDK A2,1
RF WRCTRL
RESET LDK A2,2
WRCTRL EQU *
CF A14,OCCPR OCCUPIE PRINTER
LDKL A8,CTECB LOAD ECB ADDRESS
LDK A7,/84 AND AORDER
ST A2,ECBCW,A8 STORE COMMAND IN CW
LKM
DATA 1
ABL OPCONT NEXT COMMAND
*
*
CTECB DATA /60,0,0,0,0,0
EJECT
*
*
* PRINT ONE CHARACTER FROM A7
*
*
PRCH LDKL A8,PRECB
SC* A7,ECBBA,A8
LDK A7,/85
LKM
DATA 1
ADKL A11,1 COUNT CHARACTERS
LDK A7,0
ST A7,XSPACE RESET SPACE INDICATOR
LC* A7,ECBBA,A8 RESTORE A7
RTN A14
*
*
TYECB DATA /20,TYBUF,1,0,0,0
TYBUF RES 1
PRECB DATA /31,PRBUF,1,0,0,0
PRBUF DATA 0
EJECT
*
*
* GENERATE CRLF
*
*
CRLF LDR A11,A11
RF(Z) CRLF90 ALREADY NEW LINE
LDK A7,/0D
CF A14,PRCH
LDK A7,/0A
CF A14,PRCH
IM XSPACE SET SPACE INDICATOR
SUR A11,A11
CRLF90 EQU *
RTN A14
EJECT
*
*
* READ ONE CHARACTER FROM KEYBOARD TO A7
*
* TWO WORDS FOLLOWING CALL GIVE KEYTABLE AND FUNCTION TABLE ADDRESSES
*
* ON ERROR GO TO NEXT INSTRUCTION ELSE TO FUNCTION
*
* A1 IS DESTROYED
*
*
READ LD A7,4,A14
LD A1,2,A7 GET FUNCTION TABLE ADDRESS
LDR* A7,A7 GET KEYTABLE ADDRESS
LDKL A8,TYECB
ST A7,ECBCW,A8 STORE KEYTABLE ADDRESS
LDK A7,/82 STANDARD READ
LKM
DATA 1
READ05 EQU *
ADKL A11,1 COUNT CHARS
LDK A7,1
ST A7,XSPACE SET SPACE INDICATOR
LC* A7,ECBBA,A8 GET CHARACTER TO A7
ANK A7,/7F
LD A2,ECBRC,A8
RF(Z) READ10 READING OK
LDK A1,4
ADS A1,4,A14 INCR RETURN ADDRESS
RTN A14
READ10 AD A1,ECBCW,A8 ADD INDEX
ADKL A14,4
ABR* A1 RETURN TO FUNCTION
*
*
* READ AND ECHO
*
*
READE EQU *
LD A7,4,A14
*
LD A1,2,A7 GET FUNCTION TABLE ADDRESS
LDR* A7,A7 GET KEYTABLE ADDRESS
LDKL A8,TYECB
ST A7,ECBCW,A8 STORE KEYTABLE ADDRESS
LDK A7,/82 STANDARD READ
LKM
DATA 1
LC* A7,ECBBA,A8
CF A14,PRCH ECHO
LDKL A8,TYECB
RB READ05
EJECT
*
*
* SEARCH FOR A7 CHAR IN TABLE 1
*
* CR=0 IF FOUND
* CR=1 IF NOT FOUND
*
*
ITAB1 LDK A2,3
LDK A1,1 CR IF NOT FOUND
ITAB10 CW A2,TAB1
RF(G) ITAB30 END OF TABLE
CC A7,TAB1-1,A2
RF(E) ITAB20 FOUND
ADK A2,2
RB ITAB10
ITAB20 LC A7,TAB1,A2 GET CODE
CF A14,STORE AND STORE IT
LDK A1,0 CR=0
ITAB30 ADKL A14,4
ABR* A14 RETURN
EJECT
*
*
* STORE A7 CHARACTER IN TRANSMIT AREA
*
* A9 =LRC OR CRC
* A10=BUFFER POINTER
*
*
STORE EQU *
LD A1,CODE
RF(Z) STOREA ASCII
LD A1,HEXCHA
RF(NZ) STOR01
LDR A1,A7
CF A14,ASTOEB
LDR A7,A2
STOR01 EQU *
CF A14,CRCCAL CALCULATE CRC
RF STOREB
STOREA EQU *
XRR A9,A7 CALCULATE LRC
STOREB EQU *
CWK A7,SOH
RF(E) STOR08
CWK A7,STX
RF(NE) STOR10
STOR08 EQU *
LD A1,XBCC
RF(NZ) STOR10
IM XBCC
SUR A9,A9 STX: RESET BCC
STOR10 CWK A5,LENGTH
ABL(E) ERROR OVERFLOW
ADK A5,1 COUNT CHAR
SCR A7,A10
ADKL A10,1
CW A7,ETX
RF(E) STOR11
CW A7,ETB
RF(NE) STOR20
STOR11 EQU *
LDR A7,A9
CWK A5,LENGTH
ABL(E) ERROR
ADK A5,1 COUNT CHAR
LD A1,CODE
RF(NZ) STOR30
ORK A7,/80
ECR A1,A7 GENERATE PARITY ON LRC
STOR12 SLL A1,1
RF(Z) STOR15
RB(NN) STOR12
XRK A7,/80
RB STOR12
STOR15 EQU *
SCR A7,A10
ADKL A10,1
CF A14,EDHEX PRINT LRC
STOR20 RTN A14
STOR30 EQU *
SCR A7,A10
ADKL A10,1
ANK A7,/FF
CF A14,EDHEX
LDR A7,A9
SRL A7,8
CWK A5,LENGTH
ABL(E) ERROR
ADK A5,1
SCR A7,A10
ADKL A10,1
CF A14,EDHEX
RB STOR20
EJECT
*
*
* READ HEXADECIMAL CHARACTER
*
*
RDHEX CF A14,READE
DATA KTRDH
KTRDH DATA 0 NO KEYTABLE
RDH100 SUK A7,/30
ABL(N) ERROR
CWK A7,9
RF(NG) RDH110
SUK A7,7
ABL(N) ERROR
CWK A7,/F
ABL(G) ERROR
RDH110 RTN A14
EJECT
*
*
* EDIT CHAR FROM A7 IN HEXADECIMAL FORM
*
*
EDHEX LDR A6,A7 SAVE A7
CF A14,SPACE
LDK A7,'/'
CF A14,PRCH
LDR A7,A6
SRL A7,4
LC A7,HEXTAB,A7
CF A14,PRCH 1ST CHAR
LDR A7,A6
ANK A7,/F
LC A7,HEXTAB,A7
CF A14,PRCH 2ND CHAR
CF A14,SPACE SPACE
RTN A14
HEXTAB DATA '0123456789ABCDEF'
*
EJECT
*
*
* EDIT CHAR FROM A7 IN HEXADECIMAL FORM
*
*
EDHEXL CF A14,SPACEL
LDK A1,'/'
CF A14,STOREL
LDR A1,A7
SRL A1,4
LC A1,HEXTAX,A1
CF A14,STOREL 1ST CHAR
LDR A1,A7
ANK A1,/F
LC A1,HEXTAX,A1
CF A14,STOREL 2ND CHAR
CF A14,SPACEL SPACEL
RTN A14
HEXTAX DATA '0123456789ABCDEF'
EJECT
*
*
* PRINT ONE LINE ON PRINTER
*
*
PRLINE LDK A1,2
CW A1,PRECBL
RF(E) PRLI10 NOTHING IN BUFFER
LDK A7,/86 STD WRITE AND WAIT
LDKL A8,PRLECB
LKM
DATA 1
PRLI05 EQU *
ST A1,PRECBL RESET LENGTH
LDK A1,1
ST A1,XSPACE SET SPACE INDICATOR
PRLI10 RTN A14
PRLECB DATA /31,PRLBUF,2,0,0,0
PRECBL EQU PRLECB+4 REQUESTED LENGTH
PRLBUF DATA 0
RES 60
EJECT
*
*
* SEARCH FOR A7 CHAR IN TABLE 1
*
*
* CR=1 IF NOT FOUND ELSE
* CR=0 AND CORRESPONDING CODE IS STORED
*
*
STAB1 LDK A2,3 SET INDEX
LDK A1,1 CR IF NOT FOUND
STAB10 CW A2,TAB1
RF(G) STAB30 END OF TABLE
CC A7,TAB1,A2
RF(E) STAB20 FOUND
ADK A2,2
RB STAB10 TRY NEXT
STAB20 LC A1,TAB1-1,A2 GET CORRESPONDING CODE
CF A14,STOREL AND PRINT IT
LDK A1,0
STAB30 LC A2,2,A14 SET CR FOR RETURN
ANK A2,/FC
ANK A1,3
ADR A1,A2
SC A1,2,A14
RTN A14
EJECT
*
*
* SEARCH FOR A7 CHAR IN TABLE 3
*
*
* CR=1 IF NOT FOUND ELSE
* CR=0 AND CORRESPONDING CODE IS STORED
*
*
STAB3 LDK A2,3 SET INDEX
LDK A1,1 CR IF NOT FOUND
STA10 CW A2,TAB3
RF(G) STA30 END OF TABLE
CC A7,TAB3,A2
RF(E) STA20 FOUND
ADK A2,2
RB STA10 TRY NEXT
STA20 LC A1,TAB3-1,A2 GET CODE
CF A14,STOREL AND PRINT IT
LDK A1,0
STA30 LC A2,2,A14 SET CR FOR RETURN
ANK A2,/FC
ANK A1,3
ADR A1,A2
SC A1,2,A14
RTN A14
EJECT
*
*
* SEARCH FRO A7 CHAR IN TABLE 2
*
* CR=1 IF NOT FOUND
* CR=0 IF FOUND AND CORRESPONDING TEXT IN BUFFER
*
*
STAB2 LDK A4,3 SET INDEX
LDK A1,1 CR IF NOT FOUND
STAB40 CW A4,TAB2
RF(G) STAB80 END OF TABLE
CC A7,TAB2,A4
RF(E) STAB50 FOUND
ADK A4,4
RB STAB40 NEXT CHAR
STAB50 CF A14,SPACEL
LD A3,TAB2+1,A4 GET STRING ADDRESS
LDR* A4,A3 GET LENGTH
ADK A3,2
STAB60 SUK A4,1
RF(N) STAB70
LCR A1,A3 PRINT TEXT
ADK A3,1
CF A14,STOREL
RB STAB60
STAB70 CF A14,SPACEL SPACEL
LDK A1,0
STAB80 RB STAB30 SET CR FOR RETURN
RTN A14
EJECT
*
*
* SEARCH FRO A7 CHAR IN TABLE 4
*
* CR=1 IF NOT FOUND
* CR=0 IF FOUND AND CORRESPONDING TEXT IN BUFFER
*
*
STAB4 LDK A4,3 SET INDEX
LDK A1,1 CR IF NOT FOUND
STA40 CW A4,TAB4
RF(G) STA80 END OF TABLE
CC A7,TAB4,A4
RF(E) STA50 FOUND
ADK A4,4
RB STA40 NEXT CHAR
STA50 CF A14,SPACEL
LD A3,TAB4+1,A4 GET STRING ADDRESS
LDR* A4,A3 GET LENGTH
ADK A3,2
STA60 SUK A4,1
RF(N) STA70
LCR A1,A3 PRINT TEXT
ADK A3,1
CF A14,STOREL
RB STA60
STA70 CF A14,SPACEL SPACEL
LDK A1,0
STA80 RB STA30
RTN A14
EJECT
*
*
* STORE CHAR FROM A1 IN PRINT BUFFER
*
*
STOREL LD A2,PRECBL
SC A1,PRLBUF,A2
IM PRECBL
LDK A1,0
ST A1,LSPACE
RTN A14
*
* PUT SPACE IN BUFFER
*
SPACEL LD A1,LSPACE
RF(NZ) LSP100
LDK A1,/20
CF A14,STOREL
IM LSPACE
LSP100 RTN A14
LSPACE DATA 0 SPACE INDICATOR
EJECT
*
*
* PUT SPACE IN BUFFER
*
*
SPACE LD A1,XSPACE
RF(NZ) SPA100
PRSPAC LDK A7,' '
CF A14,PRCH
IM XSPACE
SPA100 RTN A14
XSPACE DATA 0 SPACE INDICATOR
*
*
*
* OCCUPIE PRINTER AND ECHO CHARACHTER IN A7
*
*
OCCPR EQU *
LDR A1,A7 SAVE CHAR
LDK A7,1
LKM
DATA -7,PRPOOL GET BUFFER
ST A8,PROCCB SAVE BUFFER ADDRESS
CF A14,CRLF
LDR A7,A1 RESTORE CHAR
CF A14,PRCH ECHO
RTN A14
*
*
*
EJECT
*
*
* WRITE BUFFERS ON CASSETTE
*
*
WRTC EQU *
CF A14,OCCPR OCCUPIE PRINTER ECHO COMMAND
CF A14,CRLF
CF A14,LOAD LOAD CASSETTE
CM TCECB+10
CF A14,WRTM WRITE TAPE MARK
LDK A1,32
LDKL A2,AREA
WRTC10 EQU *
ST A2,ECBBA,A8
LDKL A3,256
ST A3,ECBRL,A8
LDK A7,/86
LDKL A8,TCECB
LKM
DATA 1 WRITE ONE BLOCK
LD A3,TCECB+8
ANK A3,4
RF(NZ) WRTC20
ADKL A2,256
SUK A1,1
RB(NZ) WRTC10 NOT END OF AREA
CF A14,WRTM
CF A14,UNLOAD
LDKL A2,TEXT3
RF RETCAS RETURN TO OPERATOR CONTROL
*
* CASSETTE ERROR
*
WRTC20 EQU *
CF A14,UNLOAD
LDKL A2,TEXT2
RF RETCAS RETURN TO OPERATOR CONTROL
TCECB DATA /12,AREA,256,0,0,0
*
* LOAD CASSETTE
*
LOAD EQU *
LDK A7,/B7
LDKL A8,TCECB
IM TCECB+10 NO SEQUENCE NUMBER
LOAD10 EQU *
LKM
DATA 1 LOAD CASSETTE
LD A3,TCECB+8
ANKL A3,/0201
RB(NZ) WRTC20
RTN A14
*
* WRITE TAPE MARK
*
WRTM EQU *
LDK A7,/A2
LDKL A8,TCECB
RB LOAD10
*
* UNLOAD CASSETTE
*
UNLOAD EQU *
LDK A7,/B8
LDKL A8,TCECB
LKM
DATA 1
RTN A14
*
LOAD1 EQU *
LDK A7,/B7
LDKL A8,TCECB
IM TCECB+10
LKM
DATA 1
LD A3,TCECB+8
ANK A3,1
RB(NZ) WRTC20
RTN A14
EJECT
*
*
* READ BUFFERS FROM CASSETTE
*
*
RDTC EQU *
CF A14,OCCPR OCCUPIE PRINTER ECHO COMMAND
CF A14,CRLF
CF A14,LOAD1 LOAD1 CASSETTE
RDTC10 EQU *
LDK A7,/82
LDKL A8,TCECB
LDKL A2,AREA
ST A2,ECBBA,A8
LDK A1,32
LKM
DATA 1 READ ONE BLOCK
LC A3,TCECB+8
ANK A3,/10
RB(NZ) RDTC10 TAPE MARK
RDTC20 EQU *
ADKL A2,256
SUK A1,1
RF(Z) RDTC30 AREA FILLED
ST A2,ECBBA,A8
LKM
DATA 1 READ ONE BLOCK
LC A3,TCECB+8
ANK A3,/10
RF(NZ) RDTC30 TAPE MARK
RB RDTC20
RDTC30 EQU *
CF A14,UNLOAD
LDKL A2,TEXT4
*
*
* PRINT MESSAGE AND RETURN TO OPERATOR CONTROL
*
RETCAS EQU *
CF A14,PRTXT
LDKL A11,1 SET A11 NOT ZERO
ABL OPCONT
END ASTART