mirror of
https://github.com/PDP-10/its.git
synced 2026-02-15 20:36:13 +00:00
383 lines
6.9 KiB
Plaintext
383 lines
6.9 KiB
Plaintext
;;;-*-Midas-*-
|
||
|
||
title PHOTO - Capture the output of a terminal session.
|
||
|
||
a=:1
|
||
b=:2
|
||
c=:3
|
||
d=:4
|
||
e=:5
|
||
t=:6
|
||
tt=:7
|
||
|
||
bp1=:10 .see styint .see cmd.f
|
||
ct1=:11
|
||
bp2=:12
|
||
ct2=:13
|
||
|
||
p=:17
|
||
|
||
ttynwt==:1
|
||
ttyi==:2
|
||
ttyout==:3
|
||
ttyo==:4
|
||
styi==:5
|
||
styo==:6
|
||
dsko==:7
|
||
|
||
call=:pushj p,
|
||
return=:popj p,
|
||
save=:push p,
|
||
rest=:pop p,
|
||
slose=:.lose %lssys
|
||
flose=:.lose %lsfil
|
||
tyi=:.iot ttyi,
|
||
tyo=:.iot ttyo,
|
||
pause=:.break 16,100000
|
||
quit=:.logout 1,
|
||
|
||
define syscall name,args
|
||
.call [setz ? sixbit /name/ ? args(400000)]
|
||
termin
|
||
|
||
define princ &string&
|
||
move t,[440700,,[ascii string]]
|
||
movei tt,.length string
|
||
.call $princ
|
||
slose
|
||
termin
|
||
|
||
$princ: setz
|
||
sixbit /siot/
|
||
movei ttyo
|
||
move t
|
||
setz tt
|
||
|
||
open: setz
|
||
sixbit /open/
|
||
moves t
|
||
move a
|
||
move 0(b)
|
||
move 1(b)
|
||
move 2(b)
|
||
setz 3(b)
|
||
|
||
usrvar: sixbit /option/
|
||
tlo %opint\%opopc
|
||
sixbit /mask/
|
||
move [%pipdl]
|
||
sixbit /df2/
|
||
movei 1_styi\1_styo\1_ttyi
|
||
sixbit /msk2/
|
||
movei 1_styi\1_styo\1_ttyi\1_ttyout
|
||
sixbit /option/
|
||
movem a
|
||
lusrvar==:.-usrvar
|
||
|
||
ttyvar: sixbit /ttyopt/
|
||
tlo %toraw
|
||
sixbit /width/
|
||
movei 119.
|
||
lttyvar==:.-ttyvar
|
||
|
||
lpdl==:100.
|
||
.vector pdl(lpdl)
|
||
|
||
go: move p,[-lpdl,,pdl-1]
|
||
|
||
;;; Initialize TTY
|
||
|
||
.scalar eschar ;eschape caracter
|
||
|
||
move a,[.uao,,ttyout]
|
||
movei b,[sixbit /tty/ ? setz ? setz ? setz]
|
||
.call open
|
||
flose (t)
|
||
move a,[.uao+%tjdis+%tjmor,,ttyo]
|
||
.call open
|
||
flose (t)
|
||
move a,[.uai+%tiful+%tiint,,ttyi]
|
||
.call open
|
||
flose (t)
|
||
move a,[.uai+%tiful+%tiint+%tinwt,,ttynwt]
|
||
.call open
|
||
flose (t)
|
||
syscall ttyget,[movei ttyi ? movem t ? movem t ? movem t]
|
||
slose
|
||
debugp: tlo t,%tssii
|
||
syscall ttyset,[movei ttyi ? [030303030303] ? [030303030303] ? t]
|
||
slose
|
||
syscall ttyvar,[movei ttyi ? [sixbit /ttyopt/] ? movem t]
|
||
slose
|
||
movei tt,^^
|
||
tlne t,%tofci
|
||
movei tt,%txtop+"B
|
||
movem tt,eschar
|
||
syscall ttyvar,[movei ttyi ? [sixbit /height/] ? movem t]
|
||
slose
|
||
subi t,7
|
||
movem t,morlim
|
||
|
||
;;; Set variables, hack JCL
|
||
|
||
ljcl==:40. ; 200. characters, more or less.
|
||
.vector jcl(ljcl)
|
||
|
||
move tt,[-lusrvar,,usrvar]
|
||
syscall usrvar,[movei %jself ? tt]
|
||
slose
|
||
move b,[440700,,[asciz ".PHOTO"]]
|
||
tlnn a,%opcmd
|
||
jrst nojcl
|
||
setzm jcl
|
||
move tt,[jcl,,jcl+1]
|
||
blt tt,jcl+ljcl-2
|
||
move tt,[.byte 7 ? 3 ? 3 ? 3 ? 3 ? 3]
|
||
movem tt,jcl+ljcl-1
|
||
.break 12,[..rjcl,,jcl]
|
||
move b,[440700,,jcl]
|
||
jcloop: ildb c,b
|
||
caie c,^M
|
||
cain c,^C
|
||
jrst endjcl
|
||
cain c,^_
|
||
jrst endjcl
|
||
caie c,^Q
|
||
jrst jcloop
|
||
ildb c,b
|
||
jrst jcloop
|
||
|
||
endjcl: setzi c,
|
||
dpb c,b
|
||
move b,[440700,,jcl]
|
||
nojcl: syscall sopen,[moves t ? [.uao,,dsko] ? b]
|
||
flose (t)
|
||
setom outflg
|
||
|
||
;;; Initialize STY
|
||
|
||
move a,[.uao,,styo]
|
||
movei b,[sixbit /sty/ ? setz ? setz ? setz]
|
||
.call open
|
||
jrst [ cain t,%efldv
|
||
jrst nostys
|
||
syscall lose,[movei %lsfil(t) ? movei .-1]
|
||
slose ]
|
||
move a,[.uai+10,,styi] ; Don't hang on input.
|
||
.call open
|
||
flose (t)
|
||
move tt,[-lttyvar,,ttyvar]
|
||
syscall ttyvar,[movei styo ? tt]
|
||
slose
|
||
|
||
;;; Away we go!
|
||
|
||
.iot styo,[^Z]
|
||
setzb ct1,ct2
|
||
setzm inppos
|
||
.suset [.sdf2,,[0]]
|
||
cai
|
||
.hang
|
||
|
||
nostys: princ "ANo free stys."
|
||
quit
|
||
|
||
tsint:
|
||
loc 42
|
||
-ltsint,,tsint
|
||
loc tsint
|
||
p
|
||
0 ? 1_ttyi ? 0 ? 1_ttyi\1_styi\1_styo ? ttyint
|
||
0 ? 1_styi ? 0 ? 1_styi\1_styo ? styint
|
||
0 ? 1_styo ? 0 ? 1_styo ? inpint
|
||
0 ? 1_ttyout ? 0 ? 1_ttyi\1_styi\1_styo ? morint
|
||
ltsint==:.-tsint
|
||
|
||
dismis: setz ? sixbit /dismis/ ? setz p
|
||
|
||
.scalar inppos ; Position of last input wait
|
||
.scalar morlim ; Don't ++More++ below this line
|
||
.scalar morep ; in a ++More++ wait?
|
||
|
||
inpint: syscall rcpos,[movei ttyo ? movem inppos]
|
||
slose
|
||
.call dismis
|
||
slose
|
||
|
||
morint: hlrz t,inppos
|
||
setzm inppos
|
||
caml t,morlim
|
||
jrst disint
|
||
setom morep
|
||
remore: princ "++More++"
|
||
more: tyi a
|
||
caie a,40
|
||
jrst check
|
||
unmore: setzm morep
|
||
tyo [^P]
|
||
tyo ["A]
|
||
.call dismis
|
||
slose
|
||
|
||
ttyint: .iot ttynwt,a
|
||
jumpl a,disint
|
||
check: camn a,eschar
|
||
jrst cmd
|
||
.iot styo,a
|
||
skipe morep
|
||
jrst unmore
|
||
disint: .call dismis
|
||
slose
|
||
|
||
cmd: setzm inppos ; Don't let this interaction inhibit
|
||
; ++More++ breaks excessively.
|
||
syscall rcpos,[movei ttyo ? movem pos]
|
||
slose
|
||
princ "
|
||
CMND (PHOTO) -->"
|
||
tyi a
|
||
camn a,eschar
|
||
jrst cmdesc
|
||
cail a,"a
|
||
caile a,"z
|
||
caia
|
||
subi a,"a-"A
|
||
cain a,^Z
|
||
jrst cmd.cz
|
||
cain a,^_
|
||
jrst cmd.cu
|
||
cain a,"F
|
||
jrst cmd.f
|
||
cain a,"P
|
||
jrst cmd.p
|
||
cain a,"Q
|
||
jrst cmd.q
|
||
cain a,"L
|
||
jrst cmd.l
|
||
caie a,"?
|
||
cain a,%txtop+"H
|
||
jrst cmdhlp
|
||
cain a,"C
|
||
jrst cmd.c
|
||
tyo [^G]
|
||
cmdx: call setpos ; CMDX: Restore position
|
||
cmdxl: skipe morep ; CMDX1: Forget position
|
||
jrst more
|
||
.call dismis
|
||
slose
|
||
|
||
cmd.cz: pause
|
||
skipe morep
|
||
jrst remore
|
||
.call dismis
|
||
slose
|
||
|
||
cmd.p: skipe morep ; If in a ++More++,
|
||
jrst [ .value [asciz "1J"] ; then we -already- want the TTY!
|
||
jrst remore ]
|
||
.suset [.saifpir,,[1_ttyi]] ; Don't bother user about characters
|
||
.value [asciz ":PROCEED 1J"] ; already typed.
|
||
jrst disint
|
||
|
||
cmd.cu: call setpos
|
||
princ "^_"
|
||
syscall ttyesc,[movei ttyi]
|
||
slose
|
||
jrst cmdxl
|
||
|
||
cmdesc: .iot styo,a
|
||
jrst cmdx
|
||
|
||
cmd.c: princ "AChange escape character to -->"
|
||
tyi a
|
||
movem a,eschar
|
||
jrst cmdx
|
||
|
||
cmd.f: setcmb a,outflg
|
||
jumpn a,cmd.f1
|
||
caml ct1,ct2 .see styint ; If there is unprocessed output
|
||
jrst cmd.f2
|
||
sub ct2,ct1 ; File it away before disabling
|
||
syscall siot,[movei dsko ? bp2 ? ct2]
|
||
flose
|
||
move ct2,ct1
|
||
cmd.f2: princ "File output disabled."
|
||
jrst cmdx
|
||
|
||
cmd.f1: caml ct1,ct2 .see styint ; If there is unprocessed output
|
||
jrst cmd.f3
|
||
move bp2,bp1 ; Throw it away before enabling
|
||
move ct2,ct1
|
||
cmd.f3: princ "File output enabled."
|
||
jrst cmdx
|
||
|
||
cmd.q: syscall detach,[movei styo]
|
||
cai ; Might not be anything there to detach.
|
||
cmd.l: .logout 1,
|
||
|
||
cmdhlp: princ
|
||
PHOTO help message:
|
||
|
||
These commands are accepted after typing the PHOTO escape character, which
|
||
is initially Break on TV's (labeled "Suspend" on the Lisp Machine keyboard)
|
||
and Control-^ otherwise:
|
||
|
||
^Z - do a local control-Z - return to DDT.
|
||
^_ - do a local control-_ - begin terminal escape command.
|
||
F - stop or resume sending output to photo file.
|
||
P - return to DDT, :PROCEED the PHOTO (run it without the TTY).
|
||
Q - closes the STY and kills the PHOTO, detaching any foreign job-tree.
|
||
L - closes the STY and kills the PHOTO, logging out any foreign job-tree.
|
||
? - types this help message.
|
||
C - changes the PHOTO escape character. Follow by new escape char.
|
||
<PHOTO Escape Character> - sends the character through.
|
||
|
||
jrst cmdx
|
||
|
||
.scalar pos ; Saved cursor position
|
||
|
||
setpos: hrrz t,pos
|
||
movei t,8(t)
|
||
tyo [^P]
|
||
tyo ["H]
|
||
tyo t
|
||
hlrz t,pos
|
||
movei t,8(t)
|
||
tyo [^P]
|
||
tyo ["V]
|
||
tyo t
|
||
return
|
||
|
||
lbuffer==:100.
|
||
.vector buffer(lbuffer)
|
||
|
||
.scalar outflg ; Are we sending output to the file?
|
||
|
||
.see cmd.f ; When CT1 < CT2 there is unprocessed output
|
||
; that has been seen by the user.
|
||
; Initially 5*LBUFFER >= CT1 >= CT2
|
||
styint: movei ct1,5*lbuffer ; CT1 >= CT2
|
||
movei ct2,5*lbuffer ; CT1 = CT2
|
||
move bp2,[440700,,buffer]
|
||
syscall siot,[movei styi ? bp2 ? ct2] ; CT1 >= CT2
|
||
slose
|
||
subb ct1,ct2 ; CT1 = CT2
|
||
jumple ct1,disint
|
||
move bp1,[440700,,buffer]
|
||
move bp2,[440700,,buffer]
|
||
syscall siot,[movei ttyout ? bp1 ? ct1] ; CT1 <= CT2
|
||
slose
|
||
skipe ct1,ct2 ; CT1 = CT2
|
||
skipn outflg
|
||
jrst styint
|
||
syscall siot,[movei dsko ? bp2 ? ct2] ; CT1 > CT2
|
||
flose
|
||
jrst styint
|
||
|
||
cnstnts:
|
||
constants
|
||
|
||
variables
|
||
|
||
end go
|