mirror of
https://github.com/PDP-10/its.git
synced 2026-02-16 04:43:01 +00:00
Added PHOTO.
This commit is contained in:
Eric Swenson
382
src/sysen2/photo.57
Normal file
382
src/sysen2/photo.57
Normal file
@@ -0,0 +1,382 @@
|
||||
;;;-*-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
|
||||
Reference in New Issue
Block a user