mirror of
https://github.com/PDP-10/its.git
synced 2026-02-07 08:57:06 +00:00
221 lines
6.2 KiB
Plaintext
221 lines
6.2 KiB
Plaintext
; -*- MIDAS -*-
|
|
|
|
title DDT init file hack to read a line from the TTY.
|
|
|
|
; this program with some extra comments for instructional purposes.
|
|
|
|
tyic==2
|
|
tyoc==3
|
|
|
|
a=1
|
|
b=2
|
|
c=3
|
|
d=4
|
|
count=5
|
|
sp=17
|
|
|
|
call=pushj sp,
|
|
ret=popj sp,
|
|
|
|
pdlen=10 ;short pdl
|
|
|
|
.insrt rwk;syscal >
|
|
|
|
inline: move sp,[-pdlen,,pdl]
|
|
.break 12,[5,,jclbuf]
|
|
syscal open,[cnti .uai
|
|
argi tyic
|
|
[sixbit /TTY/]]
|
|
.lose 1400
|
|
|
|
syscal open,[cnti .uao+%TJDIS ;open in display mode
|
|
argi tyoc
|
|
[sixbit /TTY/]]
|
|
.lose 1400
|
|
|
|
syscal ttyset,[argi tyic ;set the TTY paramaters
|
|
[020202,,020202] ;no echoing, we do our own
|
|
[020202,,020202]
|
|
[%TSSII+%TSCLE,,0]] ;get ^Z, ^_, and don't clear on ^L
|
|
.lose 1400
|
|
|
|
syscal cnsget,[argi tyic ;get info on this TTY to rubout correctly
|
|
val vsize
|
|
val hsize
|
|
val 0
|
|
val 0
|
|
val ttyopt] ;this has %TOERS which says if we can erase
|
|
.lose 1400
|
|
|
|
move c,[350700,,buffer+1] ;byte pointer into buffer after our initial
|
|
;:KILL<sp>
|
|
move a,[440700,,jclbuf] ;and to our JCL
|
|
jclscn: ildb b,a ;get a char
|
|
caie b,^M ;(caie = skip if equal to effective address)
|
|
cain b,^C ;if end (cain is same but skip if not equal)
|
|
jrst gtchrs
|
|
idpb b,c
|
|
jrst jclscn ;loop till end (jrst = go to)
|
|
|
|
gtchrs: setzm count ;we start here
|
|
movem c,bpsav ;for later typeout from this point
|
|
cain b,177 ;did it end with a rubout?
|
|
jrst backup ;yep, flush it, and don't add a space
|
|
movei b,40 ;nope, add in a space after the command
|
|
idpb b,c ;put it there
|
|
movem c,bpsav ;and remember THIS as the start instead.
|
|
|
|
inloop: .iot tyic,b ;read the character
|
|
cain b,177 ;is it a rubout?
|
|
jrst rubout ;go rub it out.
|
|
cain b,^L ;is it a ^L?
|
|
jrst displa ; yes, re-display
|
|
cain b,^Z ;is it a ^Z?
|
|
jrst byebye ;yes, quit
|
|
cain b,^D ;is it a ^D
|
|
jrst flush ;go flush it.
|
|
cain b,^W ;kill word?
|
|
jrst kword ; yes, go kill it.
|
|
aos count ;it's not a command,
|
|
cain b,^Q ;is it ^Q ?
|
|
jrst [.iot tyoc,b ; yes, echo the ^Q
|
|
.iot tyoc,[":] ; prompt
|
|
.iot tyic,b ; get another character
|
|
movei d,3 ; 3 positions to wipe out
|
|
call wipe ; wipe out that may characters
|
|
jrst dput]
|
|
dput: idpb b,c ;it's data, write it into the buffer
|
|
skipe lfflag ;do we need to LF because of rubouts?
|
|
jrst [.iot tyoc,[^J] ;LF
|
|
setzm lfflag ;note that we've done it
|
|
jrst echo] ;and continue
|
|
echo: .iot tyoc,b ;echo it
|
|
caie b,^C ;skip to do the .VALUE if it's ^C
|
|
cain b,^M ;if not, skip if it's not a CR, to not do it
|
|
.value buffer ; do it
|
|
jrst inloop ;get another character
|
|
|
|
rubout: cain count, ;don't delete past beginning
|
|
jrst [.iot tyoc,[7] ;beep at him
|
|
jrst inloop] ;and don't do it!
|
|
sos count
|
|
ldb b,c ;get the character being rubbed out
|
|
movei d,1 ;most chars are 1 char wide
|
|
cail b,40 ;if control
|
|
cain b,177 ;or rubout
|
|
movei d,2 ;it's two instead
|
|
call wipe ;wipe out that many characters
|
|
|
|
backup: decbp c ;decrement the byte pointer (macro)
|
|
jrst inloop ;go get another char
|
|
|
|
displa: setzm lfflag ;don't need to LF after rubout if displayed
|
|
move b,ttyopt
|
|
tlnn b,%toers ;is it erasible?
|
|
jrst [.iot tyoc,[^M] ;terpri rather than ^PA, want it to do
|
|
.iot tyoc,[^J] ;something visible on empty line.
|
|
jrst displ1] ;and continue
|
|
|
|
.iot tyoc,[^P] ;clear the screen
|
|
.iot tyoc,["C] ;since that's what people expect when they
|
|
;type ^L
|
|
|
|
displ1: move b,count ;need a copy of the count
|
|
move d,bpsav ;start it at where he started inputing
|
|
syscal siot,[argi tyoc ;type it out
|
|
d ? b]
|
|
.lose 1400
|
|
jrst inloop ;and continue reading.
|
|
|
|
flush: setzm lfflag ;don't need to LF after rubout if flushed
|
|
movei b,.length /^D XXX?
|
|
/
|
|
move d,[440700,,[ascii /^D XXX?
|
|
/]]
|
|
syscal siot,[argi tyoc ? d ? b] ;type the ^D XXX?
|
|
.lose 1400
|
|
setz count, ;back to the start
|
|
move c,bpsav
|
|
|
|
jrst inloop
|
|
|
|
kword: skipn count ;if count is zero
|
|
jrst [.iot tyoc,[7] ; beep
|
|
jrst inloop] ; and don't do anything
|
|
setz d, ;zero d, which is count of positions to wipe
|
|
kword1: ldb b,c ;get the character
|
|
caie b,177 ;rubout
|
|
cail b,40 ;or control
|
|
aos d ; it takes two chars to rub out
|
|
decbp c ;decrement the bp
|
|
sosg count ;back up the count
|
|
jrst kword3 ; oops, back to the begining
|
|
upper b ;uppercase b.
|
|
cail b,"A ;if not alphabetic
|
|
caile b,"Z
|
|
jrst kword1 ;then get another character
|
|
kword2: ldb b,c ;get another
|
|
upper b
|
|
cail b,"A ;if not before a word
|
|
caile b,"Z
|
|
jrst kword3 ;keep going back
|
|
caie b,177 ;rubout
|
|
cail b,40 ;or control
|
|
aos d ; it takes two chars to rub out
|
|
decbp c ;get the previous byte
|
|
sose count ;back up the count
|
|
jrst kword2 ; it's ok, we've got more chars
|
|
|
|
kword3: call wipe ;clear the screen
|
|
jrst inloop ;backed over a word, ok.
|
|
|
|
wipe: movni d,(d) ; d <- -<d>
|
|
hrlzi d,(d) ; D <- <d>,,0
|
|
push sp,b ;we use B locally
|
|
wipe1: move b,ttyopt
|
|
tlne b,%TOERS ;skip if can't erase
|
|
jrst [.iot tyoc,[^P] ;type the erase character ^P code (^PX)
|
|
.iot tyoc,["X]
|
|
jrst gobk] ;and return
|
|
|
|
tlnn b,%tomvb ;if this TTY can't backspace directly
|
|
jrst [ldb b,c ;we can't erase, so, we
|
|
.iot tyoc,b ; echo deleted char (crude, but effective)
|
|
jrst gobk] ;and return
|
|
|
|
.iot tyoc,[^H] ;backspace
|
|
.iot tyoc,["/] ;wipe it out
|
|
.iot tyoc,[^H] ;and back over it
|
|
setom lfflag ;and note to LF when we get real char.
|
|
gobk: aobjn d,wipe1 ;loop for each character.
|
|
pop sp,b ;restore b
|
|
ret ;return to caller
|
|
|
|
byebye: movei a,.length /Flushed
|
|
/
|
|
move b,[440700,,[ascii /Flushed
|
|
/]]
|
|
skipe lfflag ;do we need to LF because of rubouts?
|
|
.iot tyoc,[^J] ; yes. Don't bother zeroing flag, we die
|
|
skipn lfflag ;otherwise we need to space
|
|
.iot tyoc,[40]
|
|
syscal siot,[argi tyoc ? b ? a] ;type it out
|
|
jfcl
|
|
.logout 1, ;bye-bye
|
|
|
|
bpsav: 0 ;saved byte pointer to start of user text
|
|
vsize: 0
|
|
hsize: 0
|
|
ttyopt: 0
|
|
lfflag: 0 ;set non-zero if we have just rubbed out
|
|
;means to LF when get a real char.
|
|
ocount: 0 ;count before killing word
|
|
|
|
buffer: ascii /:KILL / ;buffer to write our DDT command in
|
|
block 150
|
|
|
|
jclbuf: block 100
|
|
pdl: block pdlen
|
|
|
|
end inline
|