PDP-10.its/src/bawden/obs.21

; -*- Midas -*-

title OBS - Observe

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7
x=:10
y=:11
z=:12
;=:13
ch=:14
bp=:15
i=:16
p=:17

;ch==:0,,-1
chttyi==:1
chttyo==:2
chdump==:3
chusri==:4

%fr==:0,,525252
%frsym==:000001			; Non-digit seen in JCL
%fl==:1,,525252

call=:pushj p,
return=:popj p,
save==:push p,
rest==:pop p,
flose=:.lose %lsfil
slose=:.lose %lssys
pause=:.break 16,100000
tyi=:.iot chttyi,
tyo=:.iot chttyo,

quit=:call .
	skipe debug
	 .value
	.logout 1,

define bltdup org,len
	move tt,[<org>,,<org>+1]
	blt tt,<org>+<len>-1
termin

define syscall name,args
	.call [setz ? .1stwd sixbit /name/ ? args(400000)]
termin

define conc foo,bar
foo!bar!termin

; JSP T,LOSE is like .LOSE %LSSYS(TT) or SLOSE (TT)
lose:	syscall lose,[movei %lssys(tt) ? movei -2(t)]
	 slose

popj1:	aos (p)
cpopj:	return

format"$$pcode==:1
.insrt dsk:syseng;format >

outstr:	syscall siot,[movei chttyo ? a ? b]
	 slose
	return

define format &string&,args
	call [
	call $format
.zzz.==-1
irp arg,,[args]
	save arg
.zzz.==.irpcnt
termin
	hrroi a,[ascii string]
	movei b,.length string
	movni c,.zzz.+1
	jrst format"format]
termin

$forma:	save a
	save b
	save c
	call @-3(p)
	rest c
	rest b
	rest a
	rest (p)
	return

.vector pdl(lpdl==:100.)
.vector jcl(ljcl==:21.)

usrvar:	sixbit /OPTION/	? tlo %opint\%opopc
	sixbit /MASK/	? move [%pipdl]
	sixbit /OPTION/	? movem a
lusrvar==:.-usrvar

go:	move p,[-lpdl,,pdl-1]
	setzi 0,		; Clear flags
	syscall sstatu,[repeat 6,[ movem a ? ] movem b]
	 slose
	camn a,sysnam
	 came b,sysvrs
	  call newsys
	.open chttyi,[.uai,,'tty ? setz ? setz]
	 slose
	.open chttyo,[.uao\%tjdis,,'tty ? setz ? setz]
	 slose
	move t,[-lusrvar,,usrvar]
	syscall usrvar,[movei %jself ? t]	; A: %OP bits
	 slose

	setzi i,		; I: TTY number
	tlnn a,%opcmd
	 jrst gotnum
	setzm jcl
	bltdup jcl,ljcl-1
	movsi t,(.byte 7 ? ^M ? ^M)
	movem t,jcl+ljcl-1
	.break 12,[..rjcl,,jcl]
	move a,[440700,,jcl]
	move b,[440600,,c]	; C: User name
	setzi c,
jclwss:	call jclch
	 jrst gotnum
	 jrst jclwss
jcloop:	lsh i,3
	addi i,-"0(t)
	trzn t,100		; 6 bits
	 trca t,40
	  tro t,40
	tlne b,770000		; 6 chars
	 idpb t,b
	call jclch
	 jrst jclend
	 jrst jclmor
	jrst jcloop

jclmor:	call jclch
	 jrst jclend
	 jrst jclmor
	format "~&Huh?"
	quit

jclch:	ildb t,a
	caie t,^M		; .+1:  End of command
	 cain t,^C
	  return
	caie t,^_
	 cain t,^@
	  return
	aos (p)
	caie t,40		; .+2:  Whitespace
	 cain t,^I
	  return
	aos (p)			; .+3:  Otherwise
	cail t,"0
	 caile t,"9
	  tro %frsym		; Set %FRSYM if non-digit seen
	return

jclend:	trnn %frsym
	 jrst gotnum
	syscall open,[movsi 10\.bii ? movei chusri
			[sixbit /USR/] ? move c ? [sixbit /HACTRN/]]
	 jrst [	format "~&~S not logged in.",c
		quit ]
	.uset chusri,[.rcnsl,,i]
	.close chusri,
	jumpl i,[	format "~&~S is detached?",c
			quit ]
gotnum:	cail i,0
	 caml i,nct
	  jrst [	format "~&There is no TTY ~O.",i
			quit ]
	move bp,@toip
	camn bp,@tobep
	 move bp,@tobbp
	ildb ch,bp
	jrst gogo

next0:	move bp,@tobbp
next:	camn bp,@toip
	 .hang
	camn bp,@tobep
	 jrst next0
	ildb ch,bp
	return

chprnt:	tyo ch
chnext:	call next
gogo:	jrst @chtab(ch)

chtab:	repeat 40, chsail
	repeat 140, chprnt
	repeat 200, chcode

chcode:	format "~&?~O~&",ch
	jrst chnext

chsail:	format "~&#~O~&",ch
	jrst chnext

define defch ch,val=[.]
.val.==<val>
.loc.==.
loc chtab+<ch>
	.val.
loc .loc.
termin

defch 177, chsail

defch %tdmov
	call next
	move a,ch
	call next
	move b,ch
	call next
	move c,ch
	call next
	format "~&(~D, ~D) -> (~D, ~D)~&",[a,b,c,ch]
	jrst chnext

defch %tdmv0
defch %tdmv1
	call next
	move a,ch
	call next
	format "~&(?, ?) -> (~D, ~D)~&",[a,ch]
	jrst chnext

defch %tdilp
	call next
	format "~&Insert ~D line~P.~&",ch
	jrst chnext

defch %tddlp
	call next
	format "~&Delete ~D line~P.~&",ch
	jrst chnext

defch %tdicp
	call next
	format "~&Insert ~D character~P.~&",ch
	jrst chnext

defch %tddcp
	call next
	format "~&Delete ~D character~P.~&",ch
	jrst chnext

defch %tdrsu
	call next
	move a,ch
	call next
	format "~&Scroll ~D line~P ~D time~P upwards.~&",[a,ch]
	jrst chnext

defch %tdrsd
	call next
	move a,ch
	call next
	format "~&Scroll ~D line~P ~D time~P downwards.~&",[a,ch]
	jrst chnext

defch %tdqot
	call next
	format "~&Quoted: ~O~&",ch
	jrst chnext

irps fun,,[EOF EOL DLF MTF MTN CRL NOP BS LF RCR ORS FS
	CLR BEL INI BOW RST GRF]
defch %td!fun
	format "~&! fun~&"
	jrst chnext
termin

.scalar sysnam
.scalar sysvrs

newsys:	move t,[ffpage-200,,ffpage]
	movei tt,ffpage
	syscall corblk,[movei %cbndr
			movei %jself ? move t
			movei %jsabs ? move tt]
	 slose
irps sym,kind,[
	toip: tobbp: tobep:
	nct= 
	]
	move t,[squoze 0,sym]
	.eval t,
	 .lose
ifse kind,:, hrli t,i
.scalar sym
	movem t,sym
termin
	movem a,sysnam
	movem b,sysvrs
	skipe debug
	 return
	syscall open,[movsi .bio ? movei chdump ? [sixbit /DSK/]
			[sixbit /_OBS_/] ? [sixbit /OUTPUT/] ? [sixbit /SYS/]]
	 flose
	setzi t,
	syscall pdump,[movei %jself ? movei chdump ? move t]
	 slose
	move t,[-2,,[jrst go ? jrst go]]
	.iot chdump,t
	syscall renmwo,[movei chdump ? [sixbit /TS/] ? [sixbit /OBS/]]
	 flose
	.close chdump,
	return

tsint:
loc 42
	-ltsint,,tsint
loc tsint
	400000,,p
ltsint==:.-tsint

dismis:	setz ? sixbit /DISMIS/ ? movsi 400000 ? setz p

cnstnts:
constants
variables

debug:	-1

patch::
pat:	block 100.
epatch:	-1			; Make memory exist, end of patch area

ffaddr:
ffpage==:<ffaddr+1777>_-12

end go