Added OBS.

Resolves #292.

src/bawden/obs.21

@@ -0,0 +1,344 @@
+; -*- 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