home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
rt11
/
krtcon.mac
< prev
next >
Wrap
Text File
|
2020-01-01
|
17KB
|
535 lines
.title KRTCON Terminal emulator
.ident "V03.63"
; /63/ 27-Sep-97 Billy Youdelman V03.63
;
; marktime (scheduler) completion routines are now more efficient
; fix SET CON 8 test for emulator command chars
; /62/ 27-Jul-93 Billy Youdelman V03.62
;
; correct comments to indicate r3 is not preserved between tasks
; fixed error handling for suspend/resume CONSOLE logging
; added handling for logfile errors
; move senbrk here
; speed up keyboard input processing at high data rates
; /BBS/ 1-Dec-91 Billy Youdelman V03.61
;
; this module has been extensively modified and will now run fine
; under any monitor including SJ if it's built with timer support
;
; pulled RT-11 multi-terminal and sj monitor w/o twait stuff..
;
; set/reset a list of "activation" chars under TSX which
; allows non-printing chars input at the terminal, such as ^O,
; to be passed to the remote system during the connect mode
;
; display handler speed (fixed for 19.2k too) when connecting
; display escape sequence when entering CONNECT
; disallow typing TSX lead-in char to TT when running under TSX
; allow suppression of sign-on text, for use with krttra
; skip TT input routine once done flag is set
; tt input now uses con8bit ala TT output
; added MILNET option to wakeup (XON) MILNET TACs
; added send a control char via esc_char "^x" ala VTCOM
; added esc_char "Z" command to hose/refresh handler
; Copyright 1986 Change Software, Inc
;
; 07-MAY-1986 10:55 Brian Nelson
.include "IN:KRTMAC.MAC"
.iif ndf KRTINC .error <; .include for IN:KRTMAC.MAC failed>
.mcall .CMKT ,.MRKT ,.RSUM ,.SCCA ,.SPFUN
.mcall .SPND ,.TTINR ,.TTOUTR,.TWAIT ,.WRITC
BRKDRV = 202 ; /62/ wc=0 ends break, else begin it
STSDRV = 204 ; low byte status, high byte version
$XLV51 = 16. ; RT-11 V5.1 XL/XC version number
.macro beep
mov #bell ,r0 ; load a bell
.ttoutr ; try to beep, but don't wait for it..
.endm beep
.macro schedule taskheader
mov r0 ,-(sp) ; this is a completion routine
mov taskheader,r0 ; top of task's entry in scheduler
mov sp ,state(r0) ; flag task is now ready to run
mov (sp)+ ,r0
.endm schedule
.sbttl Local buffers
.psect condat ,rw,d,lcl,rel,con
brkwrk: .word 0 ,0 ,0 ,0 ; /62/ break mark time work area
cancel: .word 0 ,0 ,0 ,0 ; .cmkt work area
crflag: .word 0 ; if <> last char was a CR
done: .word 0 ; set this <> to exit scheduler
iopend: .word 0 ; if <> XL write completion is pending
rmbuff: .word 0 ; one word buffer for writes to XL
rt.v51: .word 0 ; if <> XL is from RT-11 V5.1
scca: .word 0 ,0 ,0 ; trap ^C here
short: .word 0 ,1 ; wait one tick
stsmark:.word 0 ,0 ,0 ,0 ; status watcher mark time work area
ttmark: .word 0 ,0 ,0 ,0 ; ttdone mark time work area
twait: .word 0 ,0 ; .twait work area
xkmark: .word 0 ,0 ,0 ,0 ; xktime mark time work area
xkwork: .word 0 ,0 ,0 ,0 ,0 ,0 ; writes to handler work area
.sbttl Task scheduler data table
; these are NOT saved and may be used only within the then active task
; r0 = scratch
; r1 = scratch
; r2 = scratch
; r3 = not currently in use ; /62/
; this register is preserved between tasks
; r4 = one word TT input buffer
; r5 = pointer to CURRENT task's entry in table
TASKADDR = 0 ; task's starting address
STATE = 2 ; if <> run this task next time thru
; taskaddr ,state ; /62/ rmhead MUST follow tthead in
tlist: ; /62/ this table, see note in rmproc
xkhead::.word xkproc ,0 ; XL data out to TT
tthead: .word ttproc ,0 ; get TT input
rmhead: .word rmproc ,0 ; send it to XL
sthead: .word stproc ,0 ; check XL status
.word 0 ; terminate table
hdsize = tthead - xkhead ; each entry is this long
.psect $pdata ; /63/ consolidate local data here..
; marktime intervals
ststime:.word 0 ,0 ; /62/ init puts 0.5 sec in ticks here
ttwait: .word 0 ,3 ; poll TT for input every 3 ticks
xktime: .word 0 ,2 ; wait to clear stuffed output buffer
con.01: .asciz "Connecting to "
con.02: .asciz " DTE speed: " ; "DTE" as path speed may be different
con.03: .asciz "N/A"
con.04: .asciz <cr><lf>"Type ^"
con.05: .asciz "C to return to your local machine"<cr><lf>
con.06: .asciz "%KRTCON-W-Carrier "
con.07: .asciz "lost"<cr><lf>
con.08: .asciz "detected"<cr><lf>
con.09: .asciz "Logfile is "
con.10: .asciz ", cur/max blk: "
con.11: .asciz "/"
con.12: .asciz "No LOGFILE is open"
hlptxt: .ascii <cr><lf>
.ascii "B Send a break"<cr><lf>
.ascii "C Connect back to the local Kermit-11"<cr><lf>
.ascii "I Drop DTR for 0.5sec (hang up) then restore it"<cr><lf>
.ascii "Q Suspend CONSOLE logging"<cr><lf>
.ascii "R Resume CONSOLE logging"<cr><lf>
.ascii "S CONSOLE logging status"<cr><lf>
.ascii "X Flow control reset"<cr><lf>
.ascii "Z Zap (100% hose & try to unhang) the handler"<cr><lf>
.ascii '^x Send control char "x" using A..Z[\]~? '
.ascii "prefixed with a carat"<cr><lf> ; /63/ added for clarity
.asciz "RUBOUT Send a break"<cr><lf><cr><lf>
lis.ct: .asciz "ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]~?"
.even
.psect $code
.sbttl Initialization
doconn::call opentt ; /63/ open the link device
tst r0 ; ok?
beq 10$ ; ya
return ; nope, bail out
10$: .scca #scca ,#scca+4 ; kill ^C, this is reset by setcc
.cmkt #cancel ,#40 ; then dump setcc's mark timer
calls t.ttyini,<#-1> ; init terminal (w/flag for ^W)
tst conmsg ; display sign-on text?
bne 40$ ; nope..
wrtall #con.01 ; /63/ "Connecting to "
wrtall #ttname ; spell out the device name
wrtall #con.02 ; /63/ " DTE speed: "
call ttspeed ; get speed
tst r0 ; wuz it gettable?
bne 20$ ; /62/ yup..
wrtall #con.03 ; /63/ "N/A"
br 30$ ; continue
20$: call L10266 ; write speed in r0 as dec num to TT
30$: wrtall #con.04 ; /63/ <cr><lf>"Type ^"
mov conesc ,r0 ; get esc char
dec r0 ; lis.ct here has no null entry
movb lis.ct(r0),r0 ; make it printable
call writ1ch ; write it to TT
wrtall #con.05 ; /63/ "C to return .."<cr><lf>
40$: clr conmsg ; reset sign-on bypass flag
mov sp ,logini ; /62/ force logerr msg into the clear
clr r4 ; init TT input buffer
tst milnet ; MILNET mode on?
beq 50$ ; no
mov #xon+<xon*400>,r4 ; ya, stuff a couple XONs for remote
50$: .spfun #rtwork,#xc.control,#stsdrv,#xcsts,#0,#1 ; /62/ get status
clr rt.v51 ; init version flag
tst tsxcl ; CL?
bne 70$ ; ya, skip this
tst km.lock ; /62/ if it's KM do it here which
bne 60$ ; /62/ keeps handler smaller..
cmpb xcsts+1 ,#$xlv51 ; does this ver of XL eat LF after CR?
bgt 70$ ; ya
60$: inc rt.v51 ; no, flag it has to be done here
70$: mov clkflg ,r0 ; /62/ get number of ticks/second
asr r0 ; /62/ number of ticks in 1/2 second
mov r0 ,ststime+2 ; /62/ stuff into status check timer
mov #tlist ,r0 ; init flags for each task
80$: tst (r0) ; end of the list?
beq 90$ ; ya
mov sp ,state(r0) ; no, run each task to init itself
add #hdsize ,r0 ; bump to head of next task
br 80$ ; and loop back for it
90$: clr crflag ; no CR received from TT yet
clr done ; definitely not done
mov #1 ,suspnd ; don't miss a .rsum in the init pass
mov sp ,xk.con ; direct data read from handler here
tstb @xkpoint ; anything unused in buffer?
bne 100$ ; ya
call readxk ; get data or set completion routine
.br 100$ ; /63/
.sbttl CONNECT main_loop
100$: mov #tlist ,r5 ; get top of the task list
110$: tst (r5) ; end of the table now?
beq 130$ ; ya, go away until something happens
tst state(r5) ; runnable task?
beq 120$ ; no
jsr pc ,@(r5) ; ya, do it
120$: add #hdsize ,r5 ; next task control block please
br 110$ ; loop back for it
130$: inc suspnd ; flag a .rsum is needed
.spnd ; suspend ourself
tst done ; time to go now?
beq 100$ ; no, loop again
.sbttl Shut_down and exit
clr xk.con ; send completed reads data to binread
.cmkt #cancel ,#0 ; kill all marktime requests
call clostt ; /63/ close the link device
.newline ; ensure exit is to a clean line
clr logini ; /62/ indicate cursor on a clean line
return
.sbttl Scheduler's mark time completion routines
stsdone:mov sp ,sthead+state ; /63/ make the status test runnable
br rerun ; /63/
xkredo: mov sp ,xkhead+state ; /63/ retry TT output, buff was full
br rerun ; /63/
ttdone: tst done ; finished?
bne S10$ ; ya, skip all this..
mov sp ,tthead+state ; /63/ no, poll TT for possible input
.br rerun ; /63/
rerun: tst suspnd ; need to resume? /62/ add rerun ept
beq S10$ ; nope..
dec suspnd ; ya, make sure no one else does it
.rsum ; get scheduler going
S10$: return
.sbttl Process TT input
ttproc: tst done ; finished?
bne 140$ ; ya, don't eat possible type ahead..
tst r4 ; previous input queued to send yet?
bne 140$ ; no, loop until it has been
10$: .ttinr ; check for input waiting for term
bcs 130$ ; nothing to do
tst con8bit ; SET CON 8?
bne 20$ ; ya
bic #^c<177>,r0 ; no, strip any parity present
20$: cmpb r0 ,conesc ; escape sequence?
bne 60$ ; no, dump character as is
mov #5 ,r1 ; ya, wait up to five seconds
mul clkflg ,r1 ; for the next char
30$: .ttinr ; try to get the next char
bcc 40$ ; got something valid
.twait #twait ,#short ; nothing, wait one tick
sob r1 ,30$ ; and try again
br 130$ ; exit as we did not get anything
40$: tst con8bit ; SET CON 8?
bne 50$ ; ya
bic #^c<177>,r0 ; strip junk from the character
50$: cmpb r0 ,conesc ; another escape character?
beq 60$ ; yes, dump that character as is
call concmd ; console command processor
br 130$ ; if n.g. concmd will beep
60$: bit #2 ,xcsts ; /62/ remote asserted flow control?
beq 70$ ; no
save <r0> ; /62/ ya, save the input byte
beep ; beep & continue, _OVERWRITING_ data
unsave <r0> ; /62/ by restoring input byte and
clr r4 ; /62/ ensuring it's bit settable here
70$: tst tsxsav ; running under TSX?
bne 90$ ; ya, skip LF processing..
tst rt.v51 ; is this OLD XL/XC from RT-11 V5.1?
beq 90$ ; no
asr crflag ; ya, see if a CR precedes a LF
bcc 80$ ; last char was not a CR
cmpb r0 ,#lf ; ignore LINE FEEDs please, but only
beq 10$ ; when they follow a CR, that is..
80$: cmpb r0 ,#cr ; is this a CR?
bne 90$ ; no
inc crflag ; yes, flag for next pass
90$: tst duplex ; need local echoing?
beq 110$ ; no
tst tsxsav ; TSX?
beq 100$ ; no
cmpb r0 ,m.tsxr ; is it TSX lead-in char?
beq 110$ ; ya, don't type this to TT
100$: .ttoutr ; echo the character
110$: setpar r0 ,r0 ; set parity if enabled
tstb r4 ; is this byte free?
bne 120$ ; no, use the hi byte for this char
bisb r0 ,r4 ; ya, stuff the char in
schedule #rmhead ; enable the send char via XL task
br 10$ ; and try for one more input byte
120$: swab r4 ; swap bytes to
bisb r0 ,r4 ; stuff second char into the hi one
swab r4 ; bytes back into proper positions
return ; waste no time, every inst counts..
130$: clr state(r5) ; don't come back right away
.mrkt #ttmark,#ttwait,#ttdone,#3 ; sched another try for TT input
140$: return
.sbttl Send data from XL to TT
xkproc: clr r0 ; avoid sign extension
bisb @xkpoint,r0 ; get next char
beq 60$ ; nothing left..
tst con8bit ; SET CON 7 or 8?
bne 10$ ; 8
bicb #200 ,r0 ; 7, strip high bit
10$: tst tsxsav ; TSX?
beq 20$ ; no
cmpb r0 ,m.tsxr ; lead-in char?
beq 30$ ; ya, don't type this to TT
20$: .ttoutr ; dump the char
bcs 50$ ; buffer full, go wait a bit
30$: bit #<log$co!log$on>,trace ; /63/ logging enabled?
beq 40$ ; no
mov #lun.lo ,r1 ; log file chan, char is still in r0
call putcr0 ; that's it folks
tst r0 ; /62/ did it work?
beq 40$ ; /62/ ya
save <r0> ; /62/ no, save error code
beep ; /62/ call attention to this!
unsave <r0> ; /62/ recover error code
call logerr ; /62/ handle the error
40$: inc xkpoint ; bump to next byte
br xkproc ; loop for it
50$: .mrkt #xkmark,#xktime,#xkredo,#13 ; output ring buffer is FULL
clr state(r5) ; wait for mark time to expire
return
60$: clr state(r5) ; no longer runnable
jmp readxk ; /63/ get more data from XL
.sbttl Write one word from TT input to XL
rmproc: tst iopending ; we still waiting for XL?
bne 10$ ; /62/ ya, don't wait too long..
mov r4 ,rmbuff ; copy the data
beq 20$ ; nothing to do
clr r4 ; make TT input buffer available again
mov sp ,iopending ; flag I/O is not yet completed
.writc #xkwork,#lun.xk,#rmbuff,#1,#30$,#1 ; queue the write
10$: jmp rerun ; /62/ check for more, rerun ttproc
20$: clr state(r5) ; done, no longer runnable
return
.sbttl XL write completion routine
30$: clr iopending ; I/O no longer pending
return
.sbttl Status_watcher
stproc: mov xcsts ,r2 ; /62/ save prior status
.spfun #rtwork,#xc.control,#stsdrv,#xcsts,#0,#1 ; /62/ present status
bcs 30$ ; failed
mov xcsts ,r1 ; /62/ copy of current status
tst tsxcl ; which handler is it?
bne 10$ ; CL uses bit 2
asr r1 ; KM, XC and XL use bit 3
asr r2 ; make it 2 here
10$: bic #^c<4> ,r2 ; recover the carrier
bic #^c<4> ,r1 ; detect bits
cmp r1 ,r2 ; any change?
beq 30$ ; no
beep ; ya, make a small noise
wrtall #con.06 ; /63/ "%KRTCON-W-Carrier "
tst r1 ; did we loose it?
bne 20$ ; no, must have just gotten it
wrtall #con.07 ; /63/ "lost"
call ttxon ; clear the driver just in case
br 30$
20$: wrtall #con.08 ; /63/ "detected"
30$: clr state(r5) ; no longer runnable
.mrkt #stsmark,#ststime,#stsdone,#7 ; reschedule us
return
.sbttl Internal command processor
concmd: call strip0 ; /62/ strip parity, upcase if alpha
scan r0 ,#C10$ ; look for a match
asl r0 ; word offsets
jmp @C20$(r0) ; /62/ dispatch to the correct routine
.save
.psect $pdata ; /62/ pull lower case stuff..
C10$: .byte '/ ,'? ,'B&137 ,'C&137 ,'H&137 ,'I&137
.byte 'Q&137 ,'R&137 ,'S&137 ,'X&137 ,'Z&137 ,'^ ,177
.byte 0
.even
C20$: .word con.$
.word con.hl ,con.hl ,con.br ,con.c ,con.hl ,con.i
.word con.q ,con.r ,con.s ,con.x ,con.z ,con.ctr,con.br
.restore
.sbttl CONCMD sub-routines
con.$: beep ; bad command, ring the bell
return
con.c: mov sp ,done ; set flag to exit the emulator
return
con.i: jmp ttyhang ; /62/ go toggle DTR
con.q: bit #log$op ,trace ; /62/ file open?
beq con.$ ; /62/ no, go make a beep
bic #log$co ,trace ; turn off console logging
return
con.r: bit #log$op ,trace ; file open?
beq con.$ ; /62/ no, go make a beep
bis #log$co ,trace ; yes, resume console logging
return
con.s: .newline ; /63/ added debug status
con.s0: bit #log$op ,trace ; is a file open?
beq 10$ ; no
wrtall #con.09 ; "Logfile is "
wrtall #logfil ; include file name
wrtall #con.10 ; ", cur/max blk: "
mov #lun.lo ,r1 ; logfile lun
asl r1 ; word indexing
mov blknum(r1),r0 ; recover current block number
call L10266 ; dump it to TT
wrtall #con.11 ; "/"
mov sizof(r1),r0 ; recover file size
call L10266 ; dump that to TT too
bit #log$co ,trace ; yes, resume console logging
br 20$
10$: wrtall #con.12 ; "No LOGFILE is open"
20$: .newline
.newline
return
con.z: call hose ; zap handler, then
con.x: jmp ttxon ; /62/ reset XOFF and send an XON
con.br: .spfun #rtwork,#xc.control,#brkdrv,#0,#1,#1 ; /62/ turn break on
.mrkt #brkwrk,#break,#20$,#20 ; /62/ queue this to turn it off
return
20$: save <r0> ; /62/ this is a completion routine
.spfun #rtwork,#xc.control,#brkdrv,#0,#0,#1 ; /62/ turn break off
unsave <r0>
return
con.hl: wrtall #hlptxt ; dump help text to terminal
jmp con.s0 ; /63/ sho debug status
.sbttl Send a control char ala VTCOM's ^x command
con.ctrl:mov #5 ,r1 ; wait five seconds
mul clkflg ,r1 ; for the next char
10$: .ttinr ; get possible ctrl character
bcc 20$ ; got something valid
.twait #twait ,#short ; nothing, wait one tick
sob r1 ,10$ ; next please
br 60$ ; exit as we did not get any data
20$: call strip0 ; /62/ strip parity, upcase if alpha
scan r0 ,#lis.ctrl ; a control char symbol?
tst r0
bne 30$ ; ya
beep ; no, beep for a n.g. char
br 60$
30$: setpar r0 ,r0 ; set parity if enabled
tstb r4 ; is this byte free?
bne 40$ ; no
bisb r0 ,r4 ; ya, stuff the char in
br 50$ ; and try for another one
40$: swab r4 ; swap bytes to
bisb r0 ,r4 ; stuff second char into the hi one
swab r4 ; bytes back into proper positions
50$: schedule #rmhead ; dump the data down the line
60$: return
.sbttl Strip parity and upcase ; /62/ moved this here, now shared..
strip0: bic #^c<177>,r0 ; strip parity
cmp r0 ,#'a!40 ; convert
blo 10$ ; char
cmp r0 ,#'z!40 ; to
bhi 10$ ; upper
bic #40 ,r0 ; case
10$: return
.end