; PTY - Display STY -*-MIDAS-*- versio==.fnam2 TITLE PTY .insrt syseng;$call macro .insrt eak;macros > ; Define channel no.s ttyich==1 ; TTY input channel ttyoch==2 ; TTY output channel styich==3 ; STY input channel styoch==4 ; STY output channel dskoch==5 ; DSK output channel logoch==6 ; DSK output channel for debugging log file disb==a_6+3 ; push ACs A,B and C on interrupt %sinwt==10 ; STY input don't hang mode %sonwt==10 ; STY output don't hang mode var cmdchr ; command character var vpos ; current sty cursor position var hpos ; ... var logflg ;set non-zero if want a log file lpdl==40 var pdl(lpdl) ; room for our stack pty: move p,[-lpdl,,pdl-1] ; setup stack $call open,[#ttyich,[sixbit /tty/]],[#%tiint+%tinwt+%tiful+.uii] .lose %lsfil $call open,[#ttyoch,[sixbit /tty/]],[#%tjsio+.uio] .lose %lsfil $call open,[#styich,[sixbit /sty/]],[#%sinwt+.uii] .lose %lsfil $call open,[#styoch,[sixbit /sty/]],[#%sonwt+.uio] .lose %lsfil move t,[-4,,[ .roption ? tlo %opint+%opopc .rmsk2 ? movei 1_styich+1_ttyich ]] $call usrvar,[#%jself,t] ; new ints, enable STY and TTY input .lose %lssys $call cnsget,#ttyich,[a,b,c,d,e] ; get TTY vars .lose %lssys movei t,^^ ; control-^ tlne e,%tofci ; full keyboard? movei t,%txtop+"B ; [BREAK] movem t,cmdchr ; set command character trz e,%tptel+%tpcbs ; avoid lossage $call cnsset,[#styoch,a,b,#%tnsfw,d,e] ; set STY vars .lose %lssys move t,[-10,,[ sixbit /ispeed/ ? movem a sixbit /ospeed/ ? movem b sixbit /ttyrol/ ? movem c sixbit /smarts/ ? movem d ]] $call ttyvar,[#ttyich,t] ; get other TTY vars .lose %lssys move t,[-10,,[ sixbit /ispeed/ ? move a sixbit /ospeed/ ? move b sixbit /ttyrol/ ? move c sixbit /smarts/ ? move d ]] $call ttyvar,[#styoch,t] ; set other STY vars .lose %lsfil $call ttyset,[#ttyich,[030303,,030303],[030303,,030303],[%tssii,,0]] .lose %lsfil .iot styoch,[^Z] ; start a HACTRN on other end of STY jfcl ; hang forever .hang .value subttl Interrupt handlers ; TTY input interrupt tyiint: .suset [.rtty,,a] ; check to be sure we have the TTY jumpl a,dismis .iot ttyich,a ; get interrupt char jumpl a,dismis move t1,a trz t1,%txsft ; clear shift lock bit in character camn t1,cmdchr ; command character? jrst tyi2 tyi1: .iot styoch,a ; send to sty jrst tyiint tyi2: $call rcpos,[#styich][a] ; get cursor position .lose %lssys hlrzm a,vpos hrrzm a,hpos $call finish,#ttyoch ; wait for TTY output to complete .lose %lssys $call scpos,[#ttyoch,vpos,hpos,[-1]] ; set TTY's cursor position .lose %lssys sout #ttyoch,#%tjsio+%tjdis,"ZLCOMMAND -->L" ; prompt for command $call iot,[#ttyich,a][][#%tinwt] ; read char, waiting .lose %lssys sout #ttyoch,#%tjsio+%tjdis,"ZL" ; erase prompt camn a,cmdchr ; command character typed? jrst [ .iot ttyoch,[%tdmv0] .iot ttyoch,vpos .iot ttyoch,hpos jrst tyi1 ] andi a,377 ; ignore Meta & other wierd bits trne a,%txctl ; ASCIIfy Control bit andi a,37 cail a,"a ; convert to upper case caile a,"z caia subi a,40 caie a,"L ; L (LOGOUT)? cain a,"Q ; Q (QUIT)? jrst quit caie a,^Z ; CALL? cain a,"D ; D (DDT)? jrst [.suset [.sipirqc,,[%pic.z]] jrst tyidis ] cain a,"W ; send software codes to wallpaper file? jrst walbeg cain a,"E jrst walend cain a,"C jrst [ sout #ttyoch,#%tjsio+%tjdis,"ZChange PTY command character to -->" $call iot,[#ttyich,cmdchr][][#%tinwt] ;(was %tiint+%tinwt) .lose %lssys jrst tyidis ] cain a,^X ;control-X? (debug file) jrst dbgstr ; yes, go handle setting up or closing caie a,"H cain a,"? jrst [ sout #ttyoch,#%tjsio+%tjdis,"TLPTY control commands-- Q or L -- Kill this program. D or ^Z -- Escape temporarily to DDT. C -- Change PTY command character. W -- Send output to wallpaper file as well as to terminal E -- Undo a W command, end output to wallpaper file, closing file.  -- Write a debugging script of the session, showing %TD codes ? -- Type this documentation. -- send a real one on through. " jrst tyidis ] .iot ttyoch,[%tdbel] tyidis: .iot ttyoch,[%tdmv0] .iot ttyoch,vpos .iot ttyoch,hpos jrst dismis dbgstr: skipe logflg ;are we logging already? jrst dbgstp ; yes, stop logging $call open,[#logoch,[sixbit/dsk/],[sixbit/STYOUT/],[sixbit/DEBUG/]][][#.uao] .lose %lsfil sout #ttyoch,#%tjsio+%tjdis,"ZLogging started, output file is STYOUT DEBUG" setom logflg ;saw we want logging output jrst tyidis ;dismiss dbgstp: sout #ttyoch,#%tjsio+%tjdis,"ZLogging stopped." setzm logflg ;no more logging .close logoch, ;let go of the file jrst tyidis ;and on with the world lbuf==40 ; length of STY buffer var buf(lbuf) ; buffer for STY output var dskflg ; non-zero if output to go to disk ; STY input interrupt stiint: move a,[441000,,buf] ;get 8-bit byte pointer to temporary buffer movei b,lbuf*4 ;get buffer size in b $call siot,[#styich,a,b] ;read the input .lose %lsfil movn c,b addi c,lbuf*4 ;get number of chars read skipe dskflg ;wallpaper file open? pushj p,stydsk ; then write to it move a,[441000,,buf] ifn 1, push p,c $call siot,[#ttyoch,a,c] ; output to TTY .lose %lsfil ifn 1, pop p,c skipn logflg ;are we logging? jrst si9 ; no, don't write log file stuff ifn 1,{ push p,b move b,[441000,,buf] jumpe c,si4 si1: ildb a,b caige a,200 jrst si3 .iot logoch,["<] move a,tdnam-200(a) si2: ildb t1,a jumpe t1,si4 .iot logoch,t1 jrst si2 si3: .iot logoch,a si4: sojg c,si1 pop p,b } si9: jumpe b,stiint ; go do more if didn't read it all jrst dismis tdnam: 440700,,[asciz "%TDMOV>"] 440700,,[asciz "%TDMV1>"] 440700,,[asciz "%TDEOF>"] 440700,,[asciz "%TDEOL>"] 440700,,[asciz "%TDDLF>"] 440700,,[asciz "%TDMTF>"] 440700,,[asciz "%TDMTN>"] 440700,,[asciz "%TDCRL> "] 440700,,[asciz "%TDNOP>"] 440700,,[asciz "%TDBS>"] 440700,,[asciz "%TDLF>"] 440700,,[asciz "%TDRCR>"] 440700,,[asciz "%TDORS>"] 440700,,[asciz "%TDQOT>"] 440700,,[asciz "%TDFS>"] 440700,,[asciz "%TDMV0>"] 440700,,[asciz "%TDCLR> "] 440700,,[asciz "%TDBEL>"] 440700,,[asciz "%TDINI>"] 440700,,[asciz "%TDILP>"] 440700,,[asciz "%TDDLP>"] 440700,,[asciz "%TDICP>"] 440700,,[asciz "%TDDCP>"] 440700,,[asciz "%TDBOW>"] 440700,,[asciz "%TDRST>"] 440700,,[asciz "%TDGRF>"] 440700,,[asciz "%TDRSU>"] 440700,,[asciz "%TDRSD>"] 440700,,[asciz "%TD234>"] 440700,,[asciz "%TD235>"] 440700,,[asciz "%TD236>"] 440700,,[asciz "%TD237>"] 440700,,[asciz "%TDSYN>"] 440700,,[asciz "%TDECO>"] 440700,,[asciz "%TDEDF>"] 440700,,[asciz "%TDNLE>"] 440700,,[asciz "%TDTSP>"] 440700,,[asciz "%TDCTB>"] 440700,,[asciz "%TDCTE>"] 440700,,[asciz "%TDMLT>"] 440700,,[asciz "%TDSVL>"] 440700,,[asciz "%TDRSL>"] 440700,,[asciz "%TDSSR>"] 440700,,[asciz "%TDSLL>"] 440700,,[asciz "%TDMCI>"] subttl Wallpaper routines var bufbp ; B.P. to next byte in output buffer var buflen ; no. of bytes left in output buffer stydsk: jumpe c,cpopj ;if no chars return move a,[441000,,buf] ;get 8 bit byte pointer to temporary buffer push p,b ;save b push p,c styds1: ildb b,a ;get a byte idpb b,bufbp ;deposit it in dsk buf sosn buflen ; reached end of buffer yet? pushj p,dskfrc ;empty it sojn c,styds1 ;and go back for another byte pop p,c pop p,b ;and unsave b cpopj: popj p, var dskbuf(lbuf) dskfrc: push p,a ;save these push p,b move a,[444400,,dskbuf] ; 36 bit B.P. to buffer movei b,lbuf ; no. of words in buffer $call siot,[#dskoch,a,b] ; output to DSK .lose %lssys move a,[441000,,dskbuf] ; reset BUFBP movem a,bufbp movei b,lbuf*4 ; and BUFLEN movem b,buflen pop p,b ;restore pop p,a popj p, ;and return for more walbeg: skipe dskflg jrst [ sout #ttyoch,#%tjsio,"Wallpaper file already open!" jrst tyidis ] .call [ setz ? sixbit /open/ ; $CALL won't work with ">" 5000,,.uio 1000,,dskoch [sixbit /dsk/] [sixbit /styout/] setz [sixbit />/] ] .lose %lsfil move a,[441000,,dskbuf] move b,[%tdmv0] ; save cursor position in output file idpb b,a move b,vpos idpb b,a move b,hpos idpb b,a movem a,bufbp ; initialize buffer movei a,4*lbuf-3 movem a,buflen setom dskflg .iot ttyoch,[%tdmv0] ;set our cursor back .iot ttyoch,vpos .iot ttyoch,hpos jrst dismis walend: skipn dskflg jrst [ sout #ttyoch,#%tjsio,"No wallpaper file open!" jrst tyidis ] move t,buflen ; get no. of unused bytes in last word andi t,3 ; ... jumpe t,we2 ; if none then skip pad loop movei t1,%tdnop ; pad character we1: idpb t1,bufbp ; pad out last word with %TDNOP's sos buflen sojn t,we1 we2: movei b,lbuf*4 ; get no. of bytes in buffer sub b,buflen ; lsh b,-2 ; divide by 4 move a,[444400,,dskbuf] ; 36 bit B.P. to buffer $call siot,[#dskoch,a,b] ; output stuff left in buffer .lose %lssys .close dskoch, ; close the wallpaper file setzm dskflg ; zero disk flag jrst tyidis subttl End ; DISMIS - dismiss an interrupt dismis: $call dismis,p,,#disb .lose %lssys ; QUIT - Kill PTY quit: .break 16,160000 .value intblk: loc 42 -lintblk,,intblk loc intblk disb,,p 0 ? 1_ttyich ? 0 ? 1_ttyich+1_styich ? tyiint 0 ? 1_styich ? 0 ? 1_styich ? stiint lintblk==.-intblk constants variables pat: patch: block 100 end pty