; -*- 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,[,,+1] blt tt,+-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.== .loc.==. loc chtab+ .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==:_-12 end go