mirror of
https://github.com/PDP-10/its.git
synced 2026-02-16 12:53:06 +00:00
Add SYSCHK.
This commit is contained in:
Lars Brinkhoff
committed by
Eric Swenson
Eric Swenson
parent
202c0f9118
commit
fb9d299939
226
src/sysen2/syschk.38
Executable file
226
src/sysen2/syschk.38
Executable file
@@ -0,0 +1,226 @@
|
||||
title SYSCHK Check up on system job
|
||||
subttl Variables and stuff
|
||||
|
||||
a=1
|
||||
b=2
|
||||
c=3
|
||||
d=4
|
||||
n=5
|
||||
obp=6
|
||||
p=17
|
||||
|
||||
clic=10
|
||||
|
||||
define utyi ac
|
||||
camn obp,@toop
|
||||
.hang
|
||||
camn obp,@tobep
|
||||
jrst [ move obp,@tobbp
|
||||
jrst .-3]
|
||||
ildb ac,obp
|
||||
andi ac,377
|
||||
termin
|
||||
|
||||
define syscal a,b
|
||||
.call [setz ? sixbit \a\ ? b ((setz)) ]
|
||||
termin
|
||||
|
||||
subttl Startup
|
||||
|
||||
loc 100
|
||||
go: move p,[-lpdl,,pdl-1]
|
||||
.suset [.runame,,winner] ; get name of winner using me
|
||||
skipe runflg
|
||||
jrst setdon
|
||||
setom runflg
|
||||
move a,[-nsyms,,syms]
|
||||
symlp: move b,(a)
|
||||
.eval b,
|
||||
.value
|
||||
movem b,(a)
|
||||
aobjn a,symlp
|
||||
move a,syscn
|
||||
movei b,1
|
||||
pushj p,makpag
|
||||
move a,toip ;make sure we have the pages the buffer pointers are in
|
||||
move b,nct
|
||||
pushj p,makpag
|
||||
move a,toop
|
||||
pushj p,makpag
|
||||
move a,tobep
|
||||
pushj p,makpag
|
||||
move a,tobbp
|
||||
pushj p,makpag
|
||||
.open [21,,'TTY]
|
||||
.lose
|
||||
setdon: syscal cnsget,[ 1000,, ? 2000,,vsz
|
||||
2000,,hsz ? 2000,,ltctyp]
|
||||
.lose
|
||||
.close
|
||||
setzm vpos
|
||||
setzm hpos
|
||||
skipge n,@syscn
|
||||
.value [asciz/:Cannot find the SYS consoleKILL
|
||||
/]
|
||||
andi n,77
|
||||
syscal cnsget,[1000,,400000(n)
|
||||
2000,,a ? 2000,,a ? 2000,,a]
|
||||
.value
|
||||
movem a,ftctyp
|
||||
cain a,%tntv
|
||||
.value [asciz/:The SYS console is a TV???KILL
|
||||
/]
|
||||
.value [asciz/:vk /]
|
||||
|
||||
subttl Main SPYing routine
|
||||
movsi a,n
|
||||
iorm a,toip ;set up index field for indirection
|
||||
iorm a,toop
|
||||
iorm a,tobep
|
||||
iorm a,tobbp
|
||||
move a,@tobbp
|
||||
move b,@tobep
|
||||
sub b,a
|
||||
pushj p,makpag ;make sure we have the page(s) the buffer itself is in
|
||||
move obp,@toop ;have to start somewhere
|
||||
camn obp,@tobep
|
||||
move obp,@tobbp
|
||||
ibp obp
|
||||
bfrstp: setzm bytcnt
|
||||
setzm msgbfr
|
||||
move d,[msgbfr,,msgbfr+1]
|
||||
blt d,msgbfr+37
|
||||
move d,[440700,,msgbfr]
|
||||
movei a,177 ;rubout means no "Message from ..." nonsense
|
||||
idpb a,d
|
||||
aos bytcnt
|
||||
|
||||
lpe: utyi a
|
||||
trze a,%txdis
|
||||
jrst typd ;display or cursor pos, dispatch
|
||||
caile a,173
|
||||
jrst lpe
|
||||
typit: aos hpos
|
||||
idpb a,d
|
||||
aos bytcnt
|
||||
jrst lpe
|
||||
|
||||
typd: cail a,typdmx
|
||||
jrst lpe
|
||||
jrst @typdtb(a)
|
||||
|
||||
typdtb: tymov ;move cursor
|
||||
tymov1 ;dummy for above
|
||||
LPE ;clear eof
|
||||
lpe ;clear eol
|
||||
LPE ;delete fwd
|
||||
lpe ;terminet motor on
|
||||
lpe ; " " off
|
||||
tyecrl ;crlf to datapoints & imlacs
|
||||
lpe ;"nop for superduper image mode"
|
||||
LPE ;bs
|
||||
LPE ;lf
|
||||
tyecrl ;cr
|
||||
lpe ;output reset
|
||||
lpe ;quote
|
||||
tyefs ;fwd space
|
||||
tymov1 ;move cursor new style
|
||||
LPE ;clear screen
|
||||
typdmx==.-typdtb
|
||||
|
||||
tymov: utyi c ;old vpos
|
||||
utyi b ;old hpos or 201
|
||||
utyi a ;new vpos
|
||||
utyi b ;new hpos
|
||||
skipe ftctyp
|
||||
jrst tymov0
|
||||
sub a,c
|
||||
exch a,b
|
||||
idiv b,vsz
|
||||
move b,c
|
||||
exch a,b
|
||||
tymov0: camn a,vpos
|
||||
jrst tymov2 ;no change in vertical position
|
||||
movem a,vpos
|
||||
jrst tyecrl
|
||||
tymov2: movei a,40
|
||||
camge b,hpos
|
||||
movem b,hpos ;oh gronk I don't know why this is
|
||||
camn b,hpos
|
||||
jrst lpe
|
||||
idpb a,d
|
||||
aos bytcnt
|
||||
aos hpos
|
||||
soja b,tymov2+1
|
||||
tymov1: utyi a ;new vpos
|
||||
utyi b ;new hpos
|
||||
skipe ftctyp
|
||||
jrst tymov0
|
||||
exch a,b
|
||||
idiv b,vsz
|
||||
move b,c
|
||||
exch a,b
|
||||
jrst tymov0
|
||||
|
||||
tyefs: movei a,40
|
||||
jrst typit
|
||||
|
||||
tyecrl: SETZM HPOS
|
||||
syscal open,[[.uao,,clic] ? ['CLI,,] ? winner ? ['HACTRN] ? 3000,,a]
|
||||
jrst [ movei a,30.*2.
|
||||
.sleep a, ;RMS says this will be fixed soon...
|
||||
jrst .-1]
|
||||
move a,[440700,,msgbfr]
|
||||
syscal siot,[movei clic ? a ? bytcnt]
|
||||
.LOSE
|
||||
.close clic,
|
||||
jrst bfrstp
|
||||
|
||||
;get the same page the sys job has in its page whose address is in a, # words in b
|
||||
makpag: andi a,-1
|
||||
push p,a
|
||||
ash a,-10.
|
||||
movem a,cblk1 ;get first page
|
||||
.call cblk
|
||||
.value
|
||||
pop p,a
|
||||
addi a,-1(b) ;address of last word
|
||||
ash a,-10.
|
||||
camn a,cblk1
|
||||
popj p,
|
||||
movem a,cblk1
|
||||
.call cblk ;crosses page boundary, get second page
|
||||
.value
|
||||
popj p,
|
||||
|
||||
subttl Data area
|
||||
|
||||
cblk: setz
|
||||
sixbit \CORBLK\
|
||||
1000,,210000 ;read access, fail if can't
|
||||
[-1] ;put page in self
|
||||
cblk1
|
||||
setzi 400000 ;get from sys job
|
||||
cblk1: 0 ;gets -#pages,,page # to start
|
||||
bytcnt: 0 ;count of bytes
|
||||
msgbfr: block 100 ;allow plenty of space for message
|
||||
ltctyp: 0 ;local tctyp
|
||||
ftctyp: 0 ;foreign tctyp
|
||||
vsz: 0 ;local vertical screen size
|
||||
hsz: 0 ; " horizontal " "
|
||||
vpos: 0 ;current (hopefully) local vertical cursor pos
|
||||
hpos: 0 ;current (hopefully) local horizontal cursor pos
|
||||
runflg: 0 ;nonzero if setup done already
|
||||
winner: 0 ;who is using me
|
||||
|
||||
syms:
|
||||
irps x,,[NCT TOBEP TOBBP TOIP TOOP SYSCN]
|
||||
x: squoze 0,x
|
||||
termin
|
||||
nsyms==.-syms
|
||||
consta ? variab
|
||||
lpdl==20
|
||||
pdl: block lpdl
|
||||
patch": block 100
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user