Trailing-Edge
-
PDP-10 Archives
-
BB-V552A-SB_1983
-
xl3780.p11
There are 16 other files named xl3780.p11 in the archive. Click here to see a list.
.SBTTL XL3780 - translate task for 2780/3780 lines
; this section contains the translate task
; and the tables used by the translate (xlate) task
; to convert between ascii and ebcdic, and to simulate
; a printer carriage control tape.
.REPT 0
COPYRIGHT (c) 1982,1981,1980, 1979
DIGITAL EQUIPMENT CORPORATION, maynard, mass.
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
.ENDR
;REVISION HISTORY
; 3(001) BS PAD CARDS TO 80. CHARACTERS WHEN IRS RECEIVED IN 3780 MODE
;
; 3(002) BS REMOVE EBCDIC TO ASCII TRANSLATION TABLES FOR USE WITH TRNTAB
;
; 3(003) BS RESET CDR TCHPS TO 0 FOR 2780/3780 SUPPORT AFTER 80 CHARACTERS
;
; 3(004) BS ALLOW TASK TO PROCESS ONLY ONE MESSAGE AT A TIME
;
; 3(005) BS SIGNAL INPUT EOF ONLY AFTER LAST MESSAGE SENT TO PDP-10
;
; 3(006) RLS NEW STORAGE MGT CHANGES
;
; 3(007) RLS SET DEVICE ACTIVE BIT WHEN TCIEC SET SINCE ACTION BY TEN
; REQUIRED TO CLEAR IT.
;
; 3(010) RLS ADD HSPIGO PARAMETER USE IN XLEBAS TO CONTROL REPETITIVE
; TRANSLATION OF INPUT BLOCKS WITHOUT SLEEPING.
; 3(011) RLS REDUCE WAIT AFTER PERMISSION GRANT IN XLWAIT.DON'T CLEAR TCIRN
; UNTIL TCIEC CLEARED IN XLEBAS.
;
; 3(012) RLS REMOVE HSPIGO. ADD MORE GLOBAL FLOW CONTROL.
; 3(013) RLS 6-Mar-81
; Create common end of message fucntion XLSNDE to be used
; by XLSNDM and XLEOFO.
; Makes XLEOFO increment LB.MSC when queuing EOF msg also.
; 3(014) RLS 9-MAR-81
; Make XLOABT and XLIABT check for LS.ENB clear so they won't
; wait in vain for the 10 to clear abort complete bits
; 3(015) RLS 07-APR-81
; Changes to reflect use of message header to store data.
; 3(016) RLS 17-APR-81
; Transform static flow control to static/line control
; 4(017) RLS 17-MAR-82 GCO 4.2.1270
; Check for input request before output requests at XLATE.
; 4(020) RLS 14-APR-82 GCO 4.2.1316
; if TCOPR set, check for TCOPG already set in bsc...race.
; 4(021) RLS 19-APR-82 GCO 4.2.1326
; Fix obscure race condtions in XLIABT,XLOABT,XLODMP.
; 4(022) RLS 18-JUN-82 GCO 4.2.1392
; do input abort processing similar to input eof.
; 4(023) RLS 25-JUN-82 GCO 4.2.1402
; check for signed on emulation node before granting input permission
; 4(024) RLS 28-JUN-82 GCO 4.2.1405
; check for error returns might happen from GETSTG if aborting
; 4(025) RLS 28-JUN-82 GCO 4.2.1407
; check for active io on device before waiting for ack of abort
; 4(026) RLS 01-JUL-82 GCO 4.2.1415
; in XLESEB set LF.SON after eof completes so input can be accepted
; 4(027) RLS 07-JUL-82 GCO 4.2.1425
; in XLEBAS restore R1 after call to SACTI to prevent crash when
; line is disabled.
; 4(030) RLS 09-AUG-82 GCO 4.2.1489
; in XLIABT, fix initial not running test to save ps before going
; to label that restores it(15$)
; 4(031) RLS 16-AUG-82 GCO 4.2.1491
; in XLOABT, account for reserved chunks when discarding ascii chunks
; 4(032) RLS 23-AUG-82 GCO 4.2.1500
; in XLOCNK, ignore null ascii characters
; 4(033) RLS 30-OCT-82 GCO 4.2.1524
; in XLIMSG, do end of line processing even if IRS omitted
V3780=033
VEDIT=VEDIT+V3780
; specify translate options available
; bit 0 = ibm 3780/2780
; bit 1 = hasp multileaving
; bit 2 = ibm 3270
; bits 3-15 = reserved
XLOPTN=XLOPTN!B0 ;2780/3780 translation available
.SBTTL XLATE - 2780/3780 translate task
; this task translates data from ascii to ebcdic and from
; ebcdic to ascii.
XLATE: CALL XLWAIT ;check for input
BIT #TCOPR,TCFG2(R5) ;no - output permission requested?
BNE 11$ ;yes, start output.
BIT #TCOAB,TCFG2(R5) ;was abort flag set?
BEQ 10$ ;no.
CALL XLOABT ;yes, clear it (no output running)
10$: DSCHED #EBINTR!EBQCHK!EBQMSG,#JIFSEC/4
BR XLATE ; and try again.
; here if the pdp-10 program is requesting output permission.
11$: MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R0 ;point to bsc task
BIT #TCOPG,TCFG2(R0) ;do we already have output permission?
BNE 13$ ;yes - no waiting
BIS #TCOPR,TCFG2(R0) ;ask for a bid for the line
MOV #20.*JIFSEC,R0 ;wait this long for response
12$: DSCHED #EBINTR,R0
MOV LB.TC1(R4),R0 ;point to bsc task
BIT #TCOPG,TCFG2(R0) ;do we have output permission?
BNE 13$ ;yes - proceed
BIT #TCOPR,TCFG2(R0) ;no - still bidding for the line?
BEQ 15$ ;no - bid failed
MOV TCTIM(R5),R0 ;yes, did time expire?
BNE 12$ ;no, keep waiting.
BIC #TCOPR,TCFG2(R0) ;yes, cease bidding
15$: BIC #TCOPR,TCFG2(R5) ;kill output request
BR XLATE ;the bid was a failure.
; here when bidding is complete.
13$: BIS #TCOPG,TCFG2(R5) ;yes, tell the pdp-10 we have permission
BIC #TCOPR,TCFG2(R5) ;no longer requesting permission
CALL SACTO ;set the output device active
CLR LB.MSC(R4) ;initialize count of msgs to transmit
MOV TCBFP(R5),R0 ;initialize r0 and r2 for
CLR R2 ; line buffer
CLR TCHPS(R5) ;assume we start at left margin
CLR TCVPS(R5) ; and at the top of a page
BIT #TCPRO,TCFG1(R5) ;carriage control on output?
BEQ 14$ ;no.
MOV #EBCESC,R1 ;yes, put an escape at the front
CALL XLAPBF ; of the line buffer
MOVB ASCEBC+'M,R1 ;and an 'M' in the second place
CALL XLAPBF ; to mean "no spacing".
14$: ; fall into XLASEB
.SBTTL XLASEB - 2780/3780 output processing
; here to translate chunks from ASCII to EBCDIC.
XLASEB:
11$: MOV R0,-(SP) ;save r0 (line buffer pointer)
MOV R2,-(SP) ; and r2 (line buffer counter)
12$: BIT #TCOAB,TCFG2(R5) ;is the stream aborted?
BEQ 29$
JMP 22$ ;yes, empty the queues
29$: CALL DEQCHK ;no, get a chunk
BCC 16$ ;got one.
BIT #TCOEF,TCFG2(R5) ;none, end of file?
BNE 17$ ;yes, send etx.
BIT #TCDMP,TCFG1(R5) ;no, has pdp-10 requested a dump?
BEQ 13$ ;no.
MOV (SP)+,R2 ;yes, restore r2
MOV (SP)+,R0 ; and r0
CALL XLODMP ;empty our buffers
BCS 23$ ;stream aborted
BR 11$ ;recirculate
13$: MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R0 ;point to bsc task
BIT #TCORN,TCFG2(R0) ;is output running?
BEQ 15$ ;no.
BIS #TCORN,TCFG2(R5) ;yes, set our flag for pdp-10
BIC #TCOPG,TCFG2(R5) ; and clear permission flag
15$: DSCHED #EBINTR!EBQCHK
BR 12$ ; and test again.
; here when there is a chunk available
16$: MOV R0,R3 ;point r3 to new chunk
MOV (SP)+,R2 ;restore r2
MOV (SP)+,R0 ;restore r0
CALL XLOCNK ;translate a chunk from ascii to ebcdic
MOV TCLCB(R5),R4 ;get the lcb
SUB #TXLN,LB.RES(R4) ;unreserve translation chunks
BR 11$ ;try to translate another chunk
; here on end of file.
17$: MOV (SP)+,R2 ;restore r2
MOV (SP)+,R0 ;restore r0
18$: CALL XLEOFO ;signal end of file to the printer
19$: DSCHED #EBINTR,#JIFSEC/2
MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R1 ;point to bsc task
BIT #TCOAB,TCFG2(R1) ;stream aborted?
BNE 23$ ;yes.
BIT #TCOAB,TCFG2(R5) ;stream aborted?
BNE 23$ ;yes.
BIT #TCOEC,TCFG2(R1) ;no, completed eof processing?
BEQ 19$ ;no, wait for it.
BIS #LF.SON,LB.FGS(R4) ;set signon so input can be accepted
BIC #TCOEF!TCOEC,TCFG2(R1) ;yes, its all done.
BIS #TCOEC,TCFG2(R5) ;signal eof complete.
BIC #TCORN!TCOPG,TCFG2(R5) ;clear permission and running flags
20$: BIT #TCOAB,TCFG2(R5) ;has the stream aborted?
BNE 23$ ;yes, (may be too late, but try.)
BIT #LS.ENB,(R4) ;has the line been blown away?
BEQ 23$ ;yes - can't expect eof to be cleared by the 10
BIT #TCOEC,TCFG2(R5) ;output eof acknowledged?
BEQ 21$ ;yes, all done.
DSCHED #EBINTR,#JIFSEC/2
BR 20$ ;see if acknowldeged yet
21$:
CALL CACTO ;clear the output device active
JMP XLATE ;when all is done, recirculate
; here when the message stream is aborted.
22$: MOV (SP)+,R2 ;discard line counter
MOV (SP)+,R0 ; and line pointer
23$: CALL XLOABT ;do the abort processing
JMP XLATE ; and recirculate
.SBTTL XLOCNK - 2780/3780 translate an ASCII chunk to EBCDIC
; subroutine to translate a chunk from ASCII to EBCDIC
; R0 = pointer into line buffer
; R2 = count of chars in line buffer
; R3 = pointer to chunk to translate
; on return:
; R0 = updated pointer into line buffer
; R2 = updated count of chars in line buffer
XLOCNK:
11$: CLR -(SP) ;count of chars processed so far
MOV R3,R4 ;build pointer to data space
ADD #CHDAT,R4
12$: CMP CHLEN(R3),(SP) ;have we processed all chars?
BEQ 18$ ;yes, done with the chunk.
INC (SP) ;no, increment chars processed
MOVB (R4)+,R1 ;get next char
BEQ 12$ ;flush nulls
TRACE TRCXLD,R1 ;trace xlate char processing
MOV R3,-(SP) ;save chunk pointer
MOV R4,-(SP) ;save data pointer
13$: BIT #TCPRO,TCFG1(R5) ;printer-style output?
BNE 14$ ;yes.
CALL XLASCD ;no, card style output
BR 16$
14$: CALL XLASPR ;send character to printer
; here if we successfully sent the character
16$: MOV (SP)+,R4 ;restore r4
MOV (SP)+,R3 ;restore r3
BR 12$ ;go get next character
; here when an abort is detected while waiting for message
; space to free up.
17$: MOV (SP)+,R4 ;restore r4
MOV (SP)+,R3 ;restore r3
; here when the chunk is depleted or the stream aborted.
18$: MOV R0,(SP) ;save buffer pointer (done with count)
MOV R3,R0 ;put chunk pointer in r0
CALL FRECHK ;flush the garbage
MOV (SP)+,R0 ;restore r0
;set or clear the device active bit
XLCSAB: SAVE <R0,R1,R2>
MOV TCLCB(R5),R2 ;point to lcb
22$: MOV LB.TCD(R2),R0 ;point to xlate task
TST TCCHKQ(R0) ;any messages queued to this task ?
BEQ 23$ ;no, set device active bit
25$: CALL CACTO ;yes, clear device active bit, buffers full
BR 24$ ;continue
23$: CALL SACTO ;no, buffers empty, set device active bit
24$: RESTOR <R2,R1,R0>
RETURN
.SBTTL XLOABT - output abort processing
; subroutine called when the message stream is aborted. wait for
; all the data we have sent to the bsc task to
; be processed and then indicate that the message termination
; is complete.
XLOABT: MOV TCMSG(R5),R0 ;are we building a message?
BEQ 12$ ;no.
CALL FREMSG ;flush the garbage
CLR TCMSG(R5) ;we no longer have a message
BR 12$ ;no need to sleep immediately
11$: DSCHED #EBINTR!EBQCHK,#JIFSEC/4
12$: CALL DEQCHK ;is there a chunk?
BCS 13$ ;no.
CALL FRECHK ;yes, free it
MOV TCLCB(R5),R4
SUB #TXLN,LB.RES(R4) ;unreserve resources
BGE 12$
CLR LB.RES(R4)
BR 12$ ; and get the rest.
13$: MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R1 ;point to bsc driver tcb
BIT #TCOAC,TCFG2(R1) ;has it completed the abort?
BNE 14$ ;yes - proceed
BIS #TCOAB,TCFG2(R1) ;be sure it's aborted [1(715]
SIGNAL R1,EBINTR ;wake the bsc task
BR 11$
14$: TST TCMSG1(R1) ;maybe, has it more messages?
BNE 11$ ;yes, wait until it flushes those
;aborts all done - have only to wait for 10
MOV TCLCB(R5),R4 ;yes, point to lcb
BIS #TCOAC,TCFG2(R5) ;we have completed the abort
BIT #TCOPR!TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5) ;check if running
BEQ 20$
16$: BIT #LS.ENB,(R4) ;line disabled ?
BEQ 20$ ; yes - can't wait for 10 to come by
PIOFF
BIT #TCOAC,TCFG2(R5) ;abort acknowledged?
BEQ 19$ ;yes - clean up
;not yet. (ack is from the pdp-10)
CALL SACTO ;keep the active bit on
PION
DSCHED #EBINTR,#JIFSEC/4
BR 16$
19$: PION
20$: MOV LB.TC1(R4),R1 ;point to bsc driver tcb
BIC #TCOAB!TCOAC,TCFG2(R1) ;acknowledge abort
;clear abort and running bits
BIC #TCOAB!TCOAC!TCOPR!TCOPG!TCORN!TCOEF!TCOEC,TCFG2(R5)
SIGNAL R1,EBINTR ;wake the bsc task
CALL CACTO ;device no longer active
RETURN
.SBTTL XLWAIT - check for input to do
; subroutine to wait for a message from the line driver, a
; chunk from the dl10 driver, or just for some time to pass.
; called from output routine when there is no output going.
XLWAIT: MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R0 ;point to bsc task
PIOFF
BIT #TCIPR!TCIRN,TCFG2(R0) ;input permission requested or still running?
BEQ 14$ ;no - go away
;yes - try to synchronize 10 and remote
BIT #LF.SIM,LB.FGS(R4) ;check for emulation
BEQ 10$ ;no - grant permission
BIT #LF.SON,LB.FGS(R4) ;yes - check if signed on already
BEQ 14$ ;no - don't grant permission
10$: BIS #TCIPG,TCFG2(R0) ;pass grant to bsc task
BIS #TCIRN,TCFG2(R5) ;we are now running
BIC #TCIPG!TCIPR!TCIWR,TCFG2(R5) ;clear grant flag
SIGNAL R0,EBINTR ;wake the bsc task
PION
BR XLEBAS ;translate ebcdic to ascii
; here if input permission has not been requested.
14$: PION
BIT #TCIAB!TCIAC,TCFG2(R0) ;check for bsc task abort
BNE XLEBAS ;yes - go do the abort processing
BIT #TCIAB,TCFG2(R5) ;xlate abort while idle?
BNE XLEBAS ;yes, process the abort.
15$: RETURN
.SBTTL XLEBAS - translate chunk from EBCDIC to ASCII
; here when we have the bsc task running, at end-of-file
; or aborted. set up for input data processing.
XLEBAS: CLR TCHPS(R5) ;clear hpos
CLR TCVPS(R5) ; and vpos
BIC #TCESC!TCIGS,TCST2(R5) ;not in escape or igs sequence
MOVB ASCEBC+'/,TCCCI(R5) ;initial spacing is single
11$:
19$: CALL DEQMSG ;get a message
BCS 12$ ;none
MOV R0,R1
CALL CNTMSG ;count the chunks
SAVE R0 ;save it til later
MOV R1,R0
CALL XLIMSG ;got one, process it.
MOV TCLCB(R5),R4
SUB (SP)+,LB.RES(R4) ;unreserve xlate chunks
BGE 19$
CLR LB.RES(R4)
BR 19$ ;try again
20$: DSCHED #EBQMSG!EBINTR
BR 11$ ; and do the rest.
; here if no message to process.
12$: MOV TCLCB(R5),R4 ;get lcb
MOV LB.TC1(R4),R1 ;get bsc task
BIT #TCIAB!TCIAC,TCFG2(R1) ;is the bsc task input aborted?
BNE 10$ ;yes - check for cleaup
BIT #TCIAB,TCFG2(R5) ;has stream been aborted?
BEQ 13$ ;no.
10$: BIS #TCIAB,TCFG2(R1) ;make sure bsc is input aborted
BIT #TCIAC,TCFG2(R1) ;check if bsc input abort complete
BEQ 20$ ;continue processing input til it is
CALL XLIABT ;yes, do abort processing
RETURN
13$: BIT #LS.ENB,(R4) ;has the line been blown away?
BEQ 10$ ;yes - can't expect eof to be cleared by the 10
BIT #TCIEC,TCFG2(R1) ;have we reached eof?
BEQ 20$ ;no - nap awhile
;EOF
14$: BIS #TCIEC,TCFG2(R5) ;flag end of file
15$: CALL SACTI ;set device active bit since ten must clear tciec
MOV LB.TC1(R4),R1 ;restore pointer to bsc task
BIT #LS.ENB,(R4) ;has the line been blown away?
BEQ 10$ ;yes - can't expect eof to be cleared by the 10
DSCHED #EBQMSG!EBINTR
BIT #TCIEC,TCFG2(R5) ;eof acknowledged yet?
BNE 15$ ;no, keep waiting
BIC #TCIRN,TCFG2(R5) ; 3(011) rls flag no longer running
BIC #TCIEC,TCFG2(R1) ;clear its eof complete bit
BIT #TCIRN,TCFG2(R5) ;check if input still running(blocked messages)
BEQ 25$
JMP XLWAIT ;yes - another message is already here
25$: CALL CACTI ;device no longer active
; here to return to check for output
16$: RETURN
.SBTTL XLIABT - process input abort
; subroutine to process an input abort.
XLIABT: ;come here only when bsc input abort complete
12$: MOV TCLCB(R5),R4 ;point to lcb
13$: BIS #TCIAC,TCFG2(R5) ;indicate abort complete
BIT #TCIRN!TCIPG!TCIEF!TCIEC,TCFG2(R5) ;check if running
BEQ 16$
14$: PIOFF
BIT #LS.ENB,(R4) ;line disabled?
BEQ 15$ ;yes - can't wait for 10 to acknowledge
BIT #TCIAC,TCFG2(R5) ;is it acknowledged?
BEQ 15$ ;yes - clean up
CALL SACTI ;keep the active bit on
PION
DSCHED #EBINTR,#JIFSEC/4
BR 14$
16$: PIOFF ;accomodate main loop
15$: ;clear abort and running bits
BIC #TCIAB!TCIAC!TCIPR!TCIWR!TCIPG!TCIRN!TCIEF!TCIEC,TCFG2(R5)
MOV LB.TC1(R4),R1 ;point to bsc task
BIC #TCIAB!TCIAC,TCFG2(R1) ;clear abort bits
PION
SIGNAL R1,EBINTR ;wake the BSC task
CALL CACTI ;device no longer active
RETURN
.SBTTL XLAPBF - stash EBCDIC character in line buffer
; subroutine to accept a character from the 10 and put it in
; the line buffer. the character is already in ebcdic.
; R0 points to the current position in the line buffer
; R1 contains the character to be stored
; R2 contains the number of characters stored already
; on return:
;
; R0 and R2 are updated
XLAPBF: CMP R2,TCBFC(R5) ;buffer full?
BEQ 11$ ;yes, dont store.
MOVB R1,(R0)+ ;no, store char
INC R2 ;increment character count
11$: RETURN
.SBTTL XLASPR - translate printer character from ASCII to EBCDIC
; subroutine to translate a character from ascii to
; line printer ebcdic.
; handles format effectors and compression.
; R0 = pointer to the current position in the line buffer
; R1 = the character to be translated
; R2 = the number of characters already stored in the line buffer
; TCHPS(R5) = the current horizontal line position.
; (left margin = 0)
; TCVPS(R5) = the current vertical page position.
; (top of page = 0)
; on return:
; TCHPS(R5) and TCVPS(R5) are updated.
; c is set if we ran out of chunks, clear if not.
XLASPR: CMPB R1,#' ;compare char with blank
BGE 12$ ;graphic, space or del.
MOVB ASCSPC(R1),R3 ;control--get its code
JMP @11$(R3) ;dispatch on the code
; dispatch table for ascii control character types
11$: .WORD 26$ ;invalid -- ignore
.WORD 25$ ;ht
.WORD 26$ ;esc (invalid) -- ignore
.WORD 24$ ;cr
.WORD 17$ ;ff
.WORD 19$ ;other vertical control (lf, vt)
; here on space, graphic or del.
12$: CMPB #177,R1 ;is this a del?
BEQ 26$ ;yes, dont send to printer.
BIT #TCLBK,TCST2(R5) ;no, is previous line broken?
BNE 16$ ;yes, graphic or space after line break
CMP TCHPS(R5),#132. ;no, beyond end of line?
BLT 13$ ;no.
MOV R1,-(SP) ;yes, save character
MOV #12,R1 ;give free lf (= crlf)
CALL XLASPR ;this will break the line
MOV (SP)+,R1 ;restore character
BR 16$ ;send the line
; here if the line has not overflowed.
13$: MOVB ASCEBC(R1),R1 ;translate to ebcdic
CMPB #EBCBLK,R1 ;blank?
BNE 14$ ;no.
CALL XLASSP ;yes, try to compress it.
BCC 15$ ;nothing to store, just inc hpos
14$: CALL XLAPBF ;store character in buffer
15$: INC TCHPS(R5) ;increment horizontal position
BR 26$ ; and give successful return.
; here if the previous line had ended. since this character
; is a graphic or space, send the previous line.
16$: CALL XLSNDL ;send line
BR 12$ ;append to buffer
; here on a form feed or a vertical motion character which
; has no stops below the current vertical position.
; go to the top of the next page.
17$: CALL XLASTF ;top of form
CLR TCVPS(R5) ;clear vertical position
BR 24$ ;clear hpos and give ok return.
; here on other vertical motion character -- lf, vt, dc...
19$: MOV TCVPS(R5),R3 ;current vertical position
INC R3 ;look at next position
TSTB XLVFU(R3) ;at bottom of page?
BPL 21$ ;no.
BR 17$ ;yes, skip to top of next form.
20$: CALL XLASSF ;single space the printer
INC TCVPS(R5) ;down one vertical space
BR 24$ ;clear hpos and give ok return.
; here if we are not at the bottom of the vfu.
21$: BITB XLLPCH-12(R1),XLVFU(R3) ;should this char stop here?
BNE 20$ ;yes, single space and quit
; see if there is a stop for this character before the end of
; form. if so, space down to it. if not, just skip to
; the top of the next page.
22$: INC R3 ;look at next position
TSTB XLVFU(R3) ;bottom of form?
BLT 17$ ;yes, treat as form feed.
; here if we are not yet at bottom of form. see if the
; vfu says we should stop here.
23$: BITB XLLPCH-12(R1),XLVFU(R3) ;this channel punched here?
BEQ 22$ ;no, look at next position
CALL XLASSF ;yes, give single space
CLR TCHPS(R5) ;move to left margin
INC TCVPS(R5) ;down one vertical space
BR 19$ ;do it again until we get there.
; here on carriage return and after vertical motion.
; set "tclbk", which
; will cause the next graphic to output the current line buffer.
24$: CLR TCHPS(R5) ;horiz. pos. to left margin
BIS #TCLBK,TCST2(R5) ;set "tclbk"
BR 26$ ;give ok return.
; here on horizontal tab. output spaces until the horizontal
; position is a multiple of 8. always output at least one
; space.
25$: MOV #' ,R1 ;space
CALL XLASPR ;output it
BIT #7,TCHPS(R5) ;is horizontal position mod 8 = 0?
BNE 25$ ;no, output another space
; here to give ok return.
26$: CLC ;signal success
27$: RETURN
.SBTTL XLASTF - skip printer to top of page
; subroutine to skip the printer to the top of the next page.
; note: caller sets tclbk on return to force the buffer out
; on the next character. we could call xlsndl from here but
; for end-of-file processing, which would cause an extra line
; in that case.
; on return:
; c is set if the function could not be performed due
; to lack of chunks, clear otherwise.
XLASTF: MOV TCBFP(R5),R3 ;point to line buffer
CMPB ASCEBC+'M,1(R3) ;carriage control = no spacing?
BEQ 11$ ;yes, change to top of form.
CALL XLSNDL ;no, finish off that line
; here after making sure the current line specifies no spacing.
; change to "top of form".
11$: MOV TCBFP(R5),R3 ;point to line buffer
MOVB ASCEBC+'A,1(R3) ;make carriage control = top of form
BIT #TCPCE,TCFG1(R5) ;is page counter enabled?
BEQ 12$ ;no.
DEC TCPGC(R5) ;yes, decrement page counter
BNE 12$ ;it has not overflowed
BIS #TCPCO,TCFG1(R5) ;it has overflowed, "interrupt"
12$: CLC ;indicate no error
13$: RETURN
.SBTTL XLASSF - vertical space printer
; subroutine to space the printer vertically by one.
; escalate carriage control from no spacing through
; 1, 2 and 3 spaces if possible before releasing the line.
; note: caller takes responsibility for setting tclbk on return.
XLASSF: MOV TCBFP(R5),R3 ;point to line buffer
INC R3 ;point to carriage control
CMPB ASCEBC+'M,(R3) ;no spacing?
BEQ 11$ ;yes, make single space
CMPB ASCEBC+'/,(R3) ;no, single space?
BEQ 12$ ;yes, make double space
CMPB ASCEBC+'S,(R3) ;no, double space?
BEQ 13$ ;yes, make triple space
CALL XLSNDL ;no, send the line
BR XLASSF ;change no spacing to single
; here on no spacing to change to single
11$: MOVB ASCEBC+'/,(R3) ;make single spacing
BR 14$
; here on single spacing to change to double
12$: MOVB ASCEBC+'S,(R3) ;make double spacing
BR 14$
; here on double spacing to change to triple
13$: MOVB ASCEBC+'T,(R3) ;make triple spacing
14$: CLC ;signal ok
15$: RETURN
.SBTTL XLASCD - translate card reader character from ASCII to EBDCIC
; subroutine to translate a character from ascii to card punch
; or card reader ebcdic.
; r1 = character to be translated
; tchps(r5) = current horizontal position
; on return:
; tchps(r5) is updated
; c is set if we are out of chunks. the character
; should be re-sent.
XLASCD: CMPB R1,#' ;space?
BEQ 15$ ;yes.
BGT 11$ ;no, graphic or del
TST R1 ;null?
BEQ 13$ ;yes, just ignore it.
CMPB #12,R1 ;no, is it line feed?
BEQ 16$ ;yes, end of card.
CMPB #11,R1 ;no, horizontal tab?
BEQ 20$ ;yes, simulate with spaces.
CMPB #15,R1 ;carriage return?
BEQ 13$ ;yes, ignore.
; here on graphic, del or miscellaneous control characters.
11$: CMP TCHPS(R5),#80. ;is line full?
BEQ 13$ ;yes, ignore character.
MOVB ASCEBC(R1),R1 ;no, translate to ebcdic
BEQ 13$ ;ignore untranslatable chars
BIT #300,R1 ;control character?
BNE 12$ ;no, it is ok to send.
TSTB EBCSPC(R1) ;yes, data link ctl or irs?
BNE 15$ ;yes, convert to space
; here on graphic, del, miscellaneous control characters
; which are not data link control characters or irs
; and if the space subroutine wants to store a character.
; the character is in r1 and is in ebcdic.
12$: INC TCHPS(R5) ;increment hpos
CALL XLAPBF ;store in line buffer
13$: CLC ;indicate success
14$: RETURN
; here on space or improper control character, treated as space.
15$: CMP TCHPS(R5),#80. ;is line already full?
BGE 13$ ;yes, ignore character
CALL XLASSP ;no, worry about space compression
BCS 12$ ;store something
INC TCHPS(R5) ;nothing to store, increment hpos
BR 13$ ;and give success return.
; here on line feed. this marks the end of the card.
16$: BIT #TCOBS,TCFG1(R5) ;old bsc protocol
BEQ 19$ ;no, no need for padding.
17$: CMP TCHPS(R5),#80. ;yes, have we finished padding?
BEQ 19$ ;yes.
CALL XLASSP ;no, append a space
BCC 18$ ;nothing to store
CALL XLAPBF ;append character to buffer
18$: INC TCHPS(R5) ;we have padded by one character
BR 17$ ;see if we need more.
; here when the card has been padded to 80 characters if necessary
19$: CALL XLSNDL ;send the card, blocking with
; previous if possible
CLR TCHPS(R5) ;now back to col. zero
BR 13$ ;give success return.
; here on horizontal tab. convert to the proper number of
; spaces.
20$: MOV #' ,R1 ;space
CALL XLASCD ;output it
BIT #7,TCHPS(R5) ;are we at a mult. of 8 ?
BEQ 13$ ;yes, give success return.
CMP TCHPS(R5),#80. ;no, at end of card?
BEQ 13$ ;yes, we are all done.
BR 20$ ;no, give another space.
; subroutine to store a blank into the line buffer, compressing
; if indicated.
; on return:
; c clear - do nothing.
; c set - put r1 in the line buffer.
XLASSP: BIT #TCCPS,TCFG1(R5) ;compression active?
BEQ 12$ ;no, treat as graphic
TST TCHPS(R5) ;any chars on line?
BEQ 12$ ;no, first space is graphic
CMPB #EBCBLK,-1(R0) ;yes, prev. char a blank?
BEQ 11$ ;yes, make 2 comp. blanks
CMP TCHPS(R5),#1 ;no, at least 2 chars already?
BLE 12$ ;no, cant be in a compression.
CMPB #EBCIGS,-2(R0) ;yes, already in a compression?
BNE 12$ ;no, first blank just stored
CMPB #EBCBLK+63.,-1(R0) ;yes, already full?
BEQ 12$ ;yes, just store blank
INCB -1(R0) ;no, increment blank count
CLC ;indicate dont store anything
RETURN
; here on the second blank in a row
11$: MOVB #EBCIGS,-1(R0) ;turn blank into "igs"
MOV #EBCBLK+2,R1 ;store char indicating...
SEC ; two blanks.
RETURN ;put into line buffer
; here to return indicating that the blank character in r1
; should be stored in the line buffer.
12$: MOV #EBCBLK,R1 ;put ebcdic blank in r1
SEC ;flag to store r1
RETURN
.SBTTL XLSNDL - 2780/3780 send line buffer to BSC task
; subroutine to send the line buffer to the bsc task. build
; it into a message.
; r0 points to the last used position of the buffer.
; on return:
; c is set if out of chunks. otherwise, c is clear and:
; the line buffer (and r0 and r2, which refer to it)
; contains "esc" "m" if we are doing printer output,
; otherwise (card output) the line buffer is empty.
; tclbk is clear.
XLSNDL: MOV R1,-(SP) ;save current character
MOV R0,-(SP) ;save pointer to end of buffer
11$: MOV TCBFP(R5),R3 ;point r3 to start of buffer
BIT #TCOBS,TCFG1(R5) ;old bsc mode?
BEQ 12$ ;no.
BIT #TCPRO,TCFG1(R5) ;yes, printer output?
BEQ 12$ ;no.
CMPB ASCEBC+'M,1(R3) ;yes, overprint request?
BNE 12$ ;no.
MOV (SP)+,R2 ;yes, discard pointer to end of buffer
BR 20$ ;we can't overprint, so ignore line.
; here when the line does spacing or we have new bsc protocol,
; which permits overprinting.
12$: MOV TCMSG(R5),R0 ;point to partial message
BNE 14$ ;there is one.
13$: CALL MSGSUP ;none, set up a message
MOV R0,TCMSG(R5) ;we now have a message
BR 17$ ;put this line in it
; here when there is already a partially filled message
14$: MOV TCBFP(R5),R3 ;point to start of buffer
SUB (SP),R3 ;compute length of buffer
ADD R3,MSGSNL(R0) ;deplete sync count by length
NEG R3 ;true count
CALL XLSNDM ;send message if record too big
MOV TCMSG(R5),R0 ;do we still have a message?
BEQ 13$ ;no, build another.
; here if there is enough room for this record in the message.
; first end the previous record.
BIT #TCOBS,TCFG1(R5) ;old bsc protocol?
BNE 15$ ;yes, use ius with bcc.
MOV #EBCIRS,R1 ;no, end record with irs
KGACUM R1 ;accumulate in bcc
CALL MSGAPC ;append to message
BR 16$ ;rejoin common path.
15$: CALL XLIBCC ;store intermediate bcc
16$: TST MSGSNL(R0) ;will we need a sync?
BGT 17$ ;no, wait for next record
MOV #EBCSYN,R1 ;yes, append a sync
CALL MSGAPC ; to the message
MOV #SYNLEN,MSGSNL(R0) ;come back later
; here to store the line buffer in the message.
17$: MOV TCBFP(R5),R3 ;point to line buffer
MOV (SP)+,R2 ;point to end of line buffer
; fall into copy loop
; this is the loop which copies characters from the line buffer
; into the transmission message.
18$: CMP R2,R3 ;all done?
BEQ 19$ ;yes.
MOVB (R3)+,R1 ;no, get next character
KGACUM R1 ;accumulate bcc
CALL MSGAPC ;append to message
BR 18$ ;process all the characters
; here when all done.
19$: INC MSGNLR(R0) ;count logical records in message
; processing of the line buffer is now complete.
20$: BIC #TCLBK,TCST2(R5) ;line is no longer broken
MOV TCBFP(R5),R0 ;point r0 to line buffer
CLR R2 ;clear line buffer counter
BIT #TCPRO,TCFG1(R5) ;are we doing carriage control?
BEQ 21$ ;no.
MOV #EBCESC,R1 ;yes, put escape at start of buffer
CALL XLAPBF
MOVB ASCEBC+'M,R1 ;second char is "m"
CALL XLAPBF
21$: MOV (SP)+,R1 ;restore current character
CLC ;signal all ok
RETURN
.SBTTL XLIBCC - insert IUS and BCC in message
; subroutine to insert ius, bcc in a message.
; this is used only in "old bsc" mode, since hasp does not
; support ius from ibm 3780's.
XLIBCC: MOV #EBCIUS,R1 ;start with ius
KGACUM R1 ;include the ius in the bcc
CALL MSGAPC ;put in the block
JMP STOBCC ;put bcc after the ius
.SBTTL XLSNDM - send the message if current record won't fit
; subroutine to determine if there is enough room in
; the current message for the next record, and if not
; end the message. worries about logical record limit.
; R0 and TCMSG(R5) point to the current message
; R3 contains the length of the next record
; on return:
;
; TCMSG(R5) is zero if we had to finish off the current message
; either because we had reached our record limit or because
; the next record is so long that it would have caused the message
; to exceed the length limit.
.ENABL LSB
XLSNDM: MOV TCLCB(R5),R1 ;point to lcb
CMP MSGNLR(R0),LB.MLR(R1) ;have we reached record limit?
BEQ 11$ ;yes, end message now.
ADD MSGLEN(R0),R3 ;no, compute new length
ADD #7,R3 ;add overhead
CMP R3,LB.MBL(R1) ;would result be too big?
BLT 13$ ;no, append it.
11$: BIT #TCOBS,TCFG1(R5) ;old bsc protocol?
BNE 12$ ;yes, etb implies irs
MOV #EBCIRS,R1 ;no, include an explicit irs
KGACUM R1 ;include in bcc
CALL MSGAPC ;append to message
12$: MOV #EBCETB,R1 ;"etb"
XLSNDE: ; wind up a message
; r0/msg ptr
; r1/end character
KGACUM R1 ;accumulate bcc
CALL MSGAPC ;append to message
CALL STOBCC ;append bcc
CALL XLPADS ;append pads to message
CALL MSGAPE ;return unused chunks
MOV TCLCB(R5),R4 ;point to lcb
MOV LB.TC1(R4),R1 ;point to bsc driver
CALL QUEMSG ;send it the message
CLR TCMSG(R5) ;we no longer have a message
INC LB.MSC(R4) ;one more message for bsc task to transmit
13$: RETURN
.DSABL LSB
.SBTTL XLODMP - 2780/3780 dump output buffers
; subroutine to dump output, as requested by the pdp-10.
; all local buffers are cleared.
; on return, c set if stream aborted, c clear if all messages
; are dumped.
XLODMP: CALL XLSNDL ;empty the line buffer
MOV R0,-(SP) ;save line buffer position
MOV R2,-(SP) ; and count
MOV TCMSG(R5),R0 ;is there a message waiting?
BEQ 13$ ;no.
MOV TCLCB(R5),R1 ;point to lcb
MOV LB.MLR(R1),MSGNLR(R0) ;yes, pretend it is full...
CALL XLSNDM ; and send it.
11$: DSCHED #EBINTR,#JIFSEC/4
13$: BIT #TCOAB,TCFG2(R5) ;is stream aborted?
BNE 12$ ;yes, return immediately.
MOV TCLCB(R5),R4 ;no, point to lcb
TST LB.MSC(R4) ;are all messages sent?
BNE 11$ ;no, wait for them all.
BIC #TCDMP,TCFG1(R5) ;yes, clear "dumping" flag
MOV (SP)+,R2 ;restore line buffer count
MOV (SP)+,R0 ; and position
CLC ;indicate not abort
RETURN
; here if the stream is aborted.
12$: MOV (SP)+,R2 ;restore line buffer count
MOV (SP)+,R0 ; and position
SEC ;flag stream aborted
RETURN
.SBTTL MSGSUP - 2780/3780 message setup
; subroutine to set up a message. all the leading bsc stuff
; is placed in the data portion.
; on return, c is set if we are out of chunks.
; otherwise, r0 points to the first chunk of the message.
; note: msgsup will not fail for translate tasks - only for tentsk and
; bsc tasks.
.ENABL LSB
MSGSUP: CALL CREATM ;get a message header
BCS 17$ ;out of chunks.
MOV #EBCLPD,R1 ;get leading pad character (alt bits)
CALL MSGAPC ;store in message
BCS 16$
MOV #5,R2 ;count of leading syncs
11$: MOV #EBCSYN,R1 ;"synchronous idle"
CALL MSGAPN ;put character in string
BCS 16$
MOV TCLCB(R5),R4 ;point to lcb
.IF NE,FT.HSP
CMP #TTHASP,LB.DVT(R4) ;hasp mode?
BNE 21$ ;no, send stx for 2780/3780
BIT #LF.TSP,LB.FGS(R4) ;transparent mode?
BNE 22$ ;yes, use dle-stx
MOV #EBCSOH,R1 ;no, use soh-stx for non-trans
BR 23$ ;put in message
22$: MOV #EBCDLE,R1 ;use dle for transparent
23$: CALL MSGAPC ;append to message
BCS 16$
.ENDC ;.IF NE,FT.HSP
21$: MOV #EBCSTX,R1 ;"start of text"
CALL MSGAPC ;append to string
BCS 16$
CALL XLPREL ;preallocate chunks
BCS 16$
KGLOAD #0 ;initialize the kg11-a
MOV #SYNLEN,MSGSNL(R0) ;initialize intermediate
; synch counter.
CLC ;suc
RETURN
; now pre-allocate enough room for a max-size message so
; we won't have to worry about running out of chunks while
; building it.
XLPREL: ; common to hasp msg allocator
MOV R0,-(SP) ;save pointer to message
20$: MOV TCLCB(R5),R1 ;point to lcb
MOV LB.MBL(R1),R0 ;get max transmission block size
ASL R0 ;compute max length of message
ASL R0 ; as 125 percent of
ADD LB.MBL(R1),R0 ; the max block length
ASR R0
ASR R0
19$: MOV R0,-(SP) ;max message length
12$: CALL GETSTG ;get a hunk
BCS 15$ ;out of chunks
MOV 2(SP),R1 ;point r1 at message
13$: TST (R1) ;is this the last chunk?
BEQ 14$ ;yes, append new chunk here
MOV (R1),R1 ;no, go on to next chunk
BR 13$
; here when we have found the last chunk. append the new
; chunk here.
14$: MOV R0,(R1) ;append new chunk
SUB #CHDATL,(SP) ;we have room for that many more chars
BGT 12$ ;need more room
MOV (SP)+,R0 ;discard depleted count
MOV (SP)+,R0 ;restore pointer to message
CLC ;signal ok
RETURN
; here if we run out of chunks while doing pre-allocation.
15$: MOV (SP)+,R0 ;discard depleted count
MOV (SP)+,R0 ;restore pointer to message
; here if we run out of chunks or short of chunks
; while building the message.
16$: CALL FREMSG ;flush the garbage
SEC ;signal error
17$: RETURN
.DSABL LSB
.SBTTL XLEOFO - 2780/3780 output end of file processing
; subroutine to send an end-of-file indication to the output.
XLEOFO: BIT #TCPRO,TCFG1(R5) ;printer-style output?
BEQ 11$ ;no, lose any unterminated line
CALL XLSNDL ;finish off the current line
11$: MOV TCMSG(R5),R0 ;point to current message
BNE 12$ ;there is one.
CALL MSGSUP ;none, build one.
MOV R0,TCMSG(R5) ;we now have a message
12$: BIT #TCOBS,TCFG1(R5) ;old bsc protocol?
BNE 13$ ;yes, etx implies irs
MOV #EBCIRS,R1 ;no, provide an explicit irs
KGACUM R1 ;include in bcc
CALL MSGAPC ;append to message
13$: MOV #EBCETX,R1 ;end of text
CALL XLSNDE ; wind up the message
BIS #TCOEF,TCFG2(R1) ;indicate last message
CLC ;signal success
RETURN
; subroutine to append some pads to the end of a message.
; only one of these pads is actually transmitted; the
; others are lost in the dq11 transmit buffer.
XLPADS: SAVE R2
MOV TCLCB(R5),R2 ;get line block ptr
MOV LB.TRL(R2),R2 ;count of pads
MOV #EBCPAD,R1 ;pad character
CALL MSGAPN ;append a pad character
RESTOR R2
RETURN
.SBTTL XLIMSG - 2780/3780 translate message from EBCDIC to ASCII
; subroutine to translate an input message. the ascii is sent
; to the dl10 task for the user's buffer.
XLIMSG: MOV R0,-(SP) ;save pointer to message
TST MSGLEN(R0) ;check for null messages
BNE XLIMSR ;[1006]there is a first chunk
JMP XLIIGN ;[1006]there is none, ignore message.
XLIMSR: CALL CREATM ;get a message header even if have to wait all day
BCC 11$
JMP XLIIGN ;things are truly desperate
; we have the header chunk for the ascii message
11$: MOV TCLCB(R5),R4 ;point to lcb
MOV LB.LNU(R4),MSGID(R0) ;store message id (line no.)
MOV (SP),R2 ;point to ebcdic message
MOV TCCCI(R5),-(SP) ;save current carriage control char
MOV TCVPS(R5),-(SP) ; and current vertical position
MOV TCHPS(R5),-(SP) ; and current horizontal position
MOV TCST2(R5),-(SP) ;and two status bits in case we
; run out of chunks and have to restart
BIT #MSGTSP,MSGFGS(R2) ;transparent?
BEQ 12$ ;no.
CALL XLITSP ;yes, special translation
10$: JMP XLIMSE ;successful translation
; here if the message is not transparent.
12$: MOV CHLEN(R2),R3 ;get count in header block
MOV (R2),-(SP) ;save ptr to next chunk
MOV MSGPTR(R2),R2 ;get initial ptr
BIC #TCPRI,TCFG1(R5) ; set punch flag
BR 14$
13$: MOV (R2)+,-(SP) ;save pointer to next chunk
MOV (R2)+,R3 ;get count of bytes in this chunk
14$: TST R3 ;any bytes left?
BEQ 40$ ;no, done with this chunk
DEC R3 ;yes, count down counter
MOVB (R2)+,R1 ;get ebcdic character
BIT #<TCIGS!TCESC>,TCST2(R5) ;last character igs or esc?
BNE 19$ ;yes, treat this character specially
BIT #300,R1 ;no, is this a special character?
BNE 21$ ;no, translate and send to -10
CMPB #EBCESC,R1 ; is this an escape ?
BEQ 24$ ; yes, flag it
; we have a control character
CMPB #EBCIGS,R1 ;is it igs?
BNE 15$ ;no.
BIS #TCIGS,TCST2(R5) ;yes, remember that
BR 14$ ;process next character in special way
; the character is not an igs
15$: BIT #TCPRI,TCFG1(R5) ;are we in "printer" mode?
BEQ 18$ ;no.
; we are in printer mode -- check for esc, irs and ht
CMPB #EBCESC,R1 ;is this an escape?
BNE 16$ ;no.
BIS #TCESC,TCST2(R5) ;yes, remember that
BR 14$ ;process next character in special way
; not an escape
16$: CMPB #EBCIRS,R1 ;is it an irs?
BNE 17$ ;no.
41$: CALL XLIPRS ;yes, process an irs
BR 14$ ;process next character
; not an irs
17$: CMPB #EBCHT,R1 ;horizontal tab?
BNE 21$ ;no, try to treat as ordinary char
CALL XLIPHT ;yes, process horizontal tab
BR 14$ ;process next character
;end of message - check if we need to do end of line processing
40$: TST TCHPS(R5) ;if at beginning of line...
BEQ 22$ ;then we don't have to worry
BIT #TCPRI,TCFG1(R5) ;lpt?
BNE 41$ ;yes - go do lpt IRS
BR 31$ ;no - do cdr IRS
; card mode -- check for irs
18$: CMPB #EBCIRS,R1 ;have we an irs?
BNE 21$ ;no, try to treat as ordinary char
;pad to 80. characters when irs is encountered if less than 80.
31$: CMP TCHPS(R5),#80. ;do we have 80. characters ?
BGE 32$ ;yes, the line is finished
SAVE R2
MOV #' ,R1 ;no, get a blank
MOV #80.,R2 ;calc number to pad
SUB TCHPS(R5),R2
CALL MSGAPN ;append the block
RESTOR R2
32$: CLR TCHPS(R5) ;start the next card at the beginning
MOV #15,R1 ;yes, put crlf in ascii message
CALL MSGAPC
MOV #12,R1
CALL MSGAPC
INC TCVPS(R5) ;we have done a line
BR 14$ ;try for another character.
; here if previous character was igs or esc
19$: BIT #TCIGS,TCST2(R5) ;was last char an igs?
BEQ 20$ ;no, must have been esc
CALL XLIPGS ;yes, process the igs
BR 14$ ;process next character
; here if last character wasn't an igs. it must have been
; an esc and we must be in printer mode.
20$: MOVB R1,TCCCI(R5) ;store character after the esc
; for use by irs
BIC #TCESC,TCST2(R5) ;last char no longer an esc
; esc-4 says this is a punch
CMPB #364,R1 ; ebcdic 4 ?
BEQ 23$ ; yes, continue as punch
BIS #TCPRI,TCFG1(R5) ; no, flag as printer
23$: ;
CMPB #EBCHT,R1 ;have we an "esc ht" sequence?
BNE 14$ ;no. get next character.
CALL XLISHT ;yes, set horiz. tabs.
BR 14$ ;get next character. (probably an escape)
24$: BIS #TCESC,TCST2(R5) ; flag last character was escape
BR 14$ ; continue
; here on normal character in card and printer modes.
21$: MOVB EBCASC(R1),R1 ;translate to ascii
BEQ 14$ ;ignore nulls and untranslatables
INC TCHPS(R5) ;increment horizontal position
CALL MSGAPC ;store ascii character in message
BR 14$ ;go process another character
; here when we run out of bytes in the chunk.
; go on to the next, if there is one.
22$: MOV (SP)+,R2 ;get next chunk pointer
BNE 13$ ;there is one, process it.
BR XLIMSE ;none, end of processing
.SBTTL XLIMSE - end of input message processing
; here when processing is complete. send the ascii message
; to the tentsk task and the ebcdic message to be freed.
XLIMSE: ;r0/ptr to completed ascii message
MOV TCDLDR,R1 ;point to tentsk
CALL QUEMSG ;send it the ascii msg
;discard old tcst2
;discard old tchps
;discard old tcvps
;discard old tccci
ADD #4*2,SP
CALL SACTI ;set device active bit
XLIIGN: ;[1006]here is message has no chunks.
MOV (SP)+,R0 ;get back ebcdic message
CALL FREMSG ;flush the garbage
CLC ;signal all ok
RETURN
.SBTTL XLITSP - translate transparent input messages
; subroutine to translate transparent messages. a crlf is
; inserted every 80 characters and at the end of the record
; if any text is left unterminated. (this is to accomodate
; future extension to support of the ibm 3770's 51-column
; card feature.)
;
; r0 = empty ascii message
; r2 = ebcdic message
XLITSP: MOV CHLEN(R2),R3 ;get count in header block
MOV (R2),-(SP) ;save ptr to next chunk
MOV MSGPTR(R2),R2 ;get initial ptr
CLR TCHPS(R5) ;we are at front of line
BR 12$
11$: MOV (R2)+,-(SP) ;save pointer to next chunk
MOV (R2)+,R3 ;get count of bytes in this chunk [2(772)]
12$: TST R3 ;any more chars in this chunk?
BEQ 14$ ;no, all done.
DEC R3 ;yes, now one fewer char
MOVB (R2)+,R1 ;get char from chunk
MOVB EBCASC(R1),R1 ;translate to ascii
BEQ 13$ ;dont store untranslatables
CALL MSGAPC ;put character in ascii msg
13$: INC TCHPS(R5) ;we have processed a character
BIT #TCPRI,TCFG1(R5) ; lpt mode or card ??
BEQ 9$ ; the venerable card
CMP TCHPS(R5),#132. ; lpt - wider by far
BR 10$
9$: CMP TCHPS(R5),#80. ;reached end of card?
10$: BLT 12$ ;no, process next character
MOV #15,R1 ;yes, send crlf to ascii file
CALL MSGAPC
MOV #12,R1
CALL MSGAPC
CLR TCHPS(R5) ;now back to left margin
BR 12$ ;process next character
; here at end of chunk. get next chunk and process it, if any.
14$: MOV (SP)+,R2 ;point to next chunk
BNE 11$ ;process it, if any.
; here when the message is complete. give an extra crlf
; if necessary.
TST TCHPS(R5) ;odd length line?
BEQ 15$ ;no.
MOV #15,R1 ;yes, give extra crlf
CALL MSGAPC
MOV #12,R1
CALL MSGAPC
15$: CLC ;give ok return
RETURN
.SBTTL XLIPRS - translate printer character from ASCII to EBCDIC
; subroutine to process an irs character in printer mode.
; do the indicated carriage control.
XLIPRS: MOVB TCCCI(R5),R1 ;get char after escape ("/" if none)
MOVB ASCEBC+'/,TCCCI(R5) ;return to single space
CMPB ASCEBC+'M,R1 ;overprint request?
BEQ 14$ ;yes.
CMPB ASCEBC+'A,R1 ;no, skip to top of form?
BEQ 15$ ;yes.
CMPB ASCEBC+'/,R1 ;no, single space?
BEQ 13$ ;yes.
CMPB ASCEBC+'S,R1 ;no, double space?
BEQ 12$ ;yes.
CMPB ASCEBC+'T,R1 ;no, triple space?
BEQ 11$ ;yes.
; if unrecognized carriage control, treat as single space.
BR 13$ ;single space by default
; here on triple space
11$: CALL XLIPSP ;space once
; here on double space
12$: CALL XLIPSP ;space once
; here on single space
13$: CALL XLIPSP ;space once
BR 16$ ;process next character
; here on overprint request
14$: CALL XLIPCR ;just send carriage return
BR 16$ ;process next character
; here on top of form
15$: CALL XLIPTF ;go to top of next page
; here to give successful return. worry about eating all of cpu.
16$: CLC ;indicate no error
17$: RETURN
; subroutine to clear hpos and output a carriage return
; if necessary.
XLIPCR: TST TCHPS(R5) ;already at left margin?
BEQ 11$ ;yes, don't need carriage return.
MOV #15,R1 ;no, send carriage return
CALL MSGAPC ;put in user's buffer
CLR TCHPS(R5) ;horizontal position now = 0
11$: RETURN
; subroutine to space the printer once, returning
; the carriage if necessary and counting vpos.
XLIPSP: CALL XLIPCR ;set hpos = 0
CMP TCVPS(R5),#59. ;getting into perforations?
BLT 11$ ;no.
MOV #23,R1 ;yes, use special spacing command
BR 12$
; here if still in body of page. use normal line feed.
11$: MOV #12,R1 ;line feed
12$: CALL MSGAPC ;put char in user's buffer
INC TCVPS(R5) ;increment vpos
CMP TCVPS(R5),#66. ;reached top of next page?
BNE 13$ ;no.
CLR TCVPS(R5) ;yes, we are now at top of next page
13$: CLC ;no errors
14$: RETURN
; subroutine to go to top of form.
XLIPTF: CALL XLIPCR ;set hpos = 0
MOV #14,R1 ;form feed
CALL MSGAPC ;put in user's buffer
CLR TCVPS(R5) ;set vpos = 0
RETURN
.SBTTL XLIPGS - generate the count of blanks after IGS
; subroutine to process the character following an "igs".
; r1 = the character following the "igs". this is interpreted
; as a count of blanks plus the code for an ebcdic blank.
XLIPGS: BIC #TCIGS,TCST2(R5) ;we are no longer right after an igs.
SUB #EBCBLK,R1 ;convert to blank count
BEQ 12$ ;count is zero
SAVE R2
MOV R1,R2
ADD R2,TCHPS(R5)
MOV #' ,R1 ;get a blank
CALL MSGAPN ;append to output message
RESTOR R2
12$: CLC ;indicate success
RETURN
.SBTTL XLISHT - set horizontal tab stops from input message
; subroutine to set horizontal tab stops. the tab stops are set
; based on an ebcdic message consisiting of "esc ht" followed
; by a series of blanks and "ht"'s, ended by an nl.
; a tab stop is placed for each ht and cleared for each blank.
XLISHT: MOV R0,-(SP) ;save r0
MOV R5,R0 ;build pointer to tchfu
ADD #TCHFU,R0
MOV #<160./16.>,R1 ;length of tab buffer
11$: CLR (R0)+ ;clear out tabs buffer
SOB R1,11$ ; ... all of it.
CLR TCHPS(R5) ;start at left margin
12$: TST R3 ;any characters left in this chunk?
BNE 13$ ;yes, get the next character.
MOV 4(SP),R2 ;no, get next chunk
BEQ 20$ ;end of message, this is not allowed.
MOV (R2)+,4(SP) ;store pointer to next chunk
MOV (R2)+,R3 ;put count in r3
BR 12$ ;get first char in this chunk
13$: DEC R3 ;decrement count of chars in this chunk
MOVB (R2)+,R1 ;get next char from this chunk
MOV #EBCNL,R0 ;get ending character
BIT #TCOBS,TCFG1(R5) ;old bsc protocol?
BEQ 14$ ;no, nl is right.
MOV #EBCIRS,R0 ;yes, check for the irs substituted by
; the bsc task for the ius
; that ended the record.
14$: CMPB R0,R1 ;have we the end character?
BEQ 19$ ;yes, all done.
CMPB #EBCHT,R1 ;no, "ht" character?
BEQ 15$ ;yes, set tab stop
CMPB #EBCBLK,R1 ;no, a blank?
BEQ 18$ ;yes, tab stop is clear.
STOPCD HTS ;error in setting horiz. tabs.
; here to set a horizontal tab stop.
15$: MOV TCHPS(R5),R1 ;get current horiz. position
BIC #177760,R1 ;leave only low-order 4 bits
MOV #1,R0 ;build mask in r0
16$: TST R1 ;mask need any more rotation?
; (note this clears c for the rol)
BEQ 17$ ;no, done.
ROL R0 ;yes, rotate left one.
DEC R1 ;decrement count of rotations
BR 16$ ;do the rest of the rotations
17$: MOV TCHPS(R5),R1 ;get hpos again
ASR R1 ; hpos/2
ASR R1 ; hpos/4
ASR R1 ; hpos/8
BIC #1,R1 ; hpos/16 * 2 for word addressing
ADD R5,R1 ;build pointer to tchfu
BIS R0,TCHFU(R1) ;set tab stop bit
; here on space and from above on ht.
18$: INC TCHPS(R5) ;next horizontal position
CMP TCHPS(R5),#160. ;too many?
BLE 12$ ;no, get next character
STOPCD HTS ;yes, error in horiz. tab setting
; here on nl from an ibm 3780 or end of record from an ibm 2780.
; this is the end of the tab setting message.
19$: CLR TCHPS(R5) ;back to left margin
MOV (SP)+,R0 ;restore r0
RETURN
; here if the message ends before the nl or irs. this is not allowed.
20$: STOPCD HTS ;end of message before nl or irs
.SBTTL XLIPHT - process input horizontal tab
; subroutine to process a horizontal tab found in the
; data stream.
XLIPHT: MOV #' ,R1 ;send a blank to the '10
CALL MSGAPC
INC TCHPS(R5) ;increment horizontal position
MOV R0,-(SP) ;save r0
MOV TCHPS(R5),R1 ;get current horiz. position
CMP R1,#160. ;reached end of line?
BGE 13$ ;yes, return.
MOV #1,R0 ;build mask for tab bit
BIC #177760,R1 ;no, mask out all but bit index
BEQ 12$ ;yes.
11$: CLC
ROL R0 ;rotate left one
SOB R1,11$
12$: MOV TCHPS(R5),R1 ;get horiz. position again
ASR R1 ; hpos/2
ASR R1 ; hpos/4
ASR R1 ; hpos/8
BIC #1,R1 ; hpos/16 * 2 for word addressing
ADD R5,R1 ;build pointer to tchfu
BIT R0,TCHFU(R1) ;is there a tab stop here?
BNE 13$ ;yes, stop.
MOV (SP)+,R0 ;no, restore r0
BR XLIPHT ; and give another space.
; here when we have reached a tab stop or end of line.
13$: MOV (SP)+,R0 ;restore r0
CLC ;indicate success
14$: RETURN
.SBTTL ASCSPC - ASCII special control character table
; ascii special character table for control characters
; 0 1 2 3 4 5 6 7
ASCSPC: .BYTE 000,000,000,000,000,000,000,000 ;000-007
.BYTE 000,002,012,012,010,006,000,000 ;010-017
.BYTE 012,012,012,012,012,000,000,000 ;020-027
.BYTE 000,000,000,000,000,000,000,000 ;030-037
; 0 1 2 3 4 5 6 7
;
; special code assignments used in table ascspc
;
; 000 = invalid character -- ignore
; 002 = horizontal tab character
; 004 = escape character (not currently used)
; 006 = carriage return character
; 010 = form feed character
; 012 = other vertical carriage control character
;
.SBTTL EBCSPC - EBCDIC special control character table
; ebcdic special character table
;
; 0 1 2 3 4 5 6 7
; 8 9 a b c d e f
EBCSPC: .BYTE 000,000,000,006,000,000,000,000 ;00-07
.BYTE 000,000,000,000,000,000,000,000 ;08-0f
.BYTE 016,000,000,000,000,000,000,000 ;10-17
.BYTE 000,000,000,000,000,000,012,010 ;18-1f
.BYTE 000,000,000,000,000,000,004,000 ;20-27
.BYTE 000,000,000,000,000,014,000,000 ;28-2f
.BYTE 000,000,002,000,000,000,000,000 ;30-37
.BYTE 000,000,000,000,000,000,000,000 ;38-3f
; 0 1 2 3 4 5 6 7
; 8 9 a b c d e f
;
; special code assignments used in table ebcspc
;
; 000 = miscellaneous (none of those below)
; 002 = syn
; 004 = etb
; 006 = etx
; 010 = ius
; 012 = irs
; 014 = enq
; 016 = dle
;
.SBTTL XLVFU - carriage control tape
; carriage control tape, for simulating an lp10
XLVFU: .BYTE 000 ; not used
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 055 ; 3-5-6-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 057 ; 3-5-6-7-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 175 ; 2-3-4-5-6-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 057 ; 3-5-6-7-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 055 ; 3-5-6-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 071 ; 3-4-5-8
.BYTE 011 ; 5-8
.BYTE 051 ; 3-5-8
.BYTE 031 ; 4-5-8
.BYTE 051 ; 3-5-8
.BYTE 011 ; 5-8
.BYTE 010 ; 5
.BYTE 010 ; 5
.BYTE 010 ; 5
.BYTE 010 ; 5
.BYTE 010 ; 5
.BYTE 010 ; 5
.BYTE -1 ;flag end of tape
; translate table to convert a vertical motion character into
; a channel number for indexing into the vfu table.
XLLPCH: .BYTE 001 ;lf = channel 8
.BYTE 002 ;vt = channel 7
.BYTE 0,0,0,0 ;not vertical motion chars (14-17)
.BYTE 100 ;dle = channel 2
.BYTE 040 ;dc1 = channel 3
.BYTE 020 ;dc2 = channel 4
.BYTE 010 ;dc3 = channel 5
.BYTE 004 ;dc4 = channel 6
.EVEN ;be sure next section starts
; on a word boundry