; -*- MIDAS -*- title DDT init file hack to read a line from the TTY. ; this program with some extra comments for instructional purposes. tyic==2 tyoc==3 a=1 b=2 c=3 d=4 count=5 sp=17 call=pushj sp, ret=popj sp, pdlen=10 ;short pdl .insrt rwk;syscal > inline: move sp,[-pdlen,,pdl] .break 12,[5,,jclbuf] syscal open,[cnti .uai argi tyic [sixbit /TTY/]] .lose 1400 syscal open,[cnti .uao+%TJDIS ;open in display mode argi tyoc [sixbit /TTY/]] .lose 1400 syscal ttyset,[argi tyic ;set the TTY paramaters [020202,,020202] ;no echoing, we do our own [020202,,020202] [%TSSII+%TSCLE,,0]] ;get ^Z, ^_, and don't clear on ^L .lose 1400 syscal cnsget,[argi tyic ;get info on this TTY to rubout correctly val vsize val hsize val 0 val 0 val ttyopt] ;this has %TOERS which says if we can erase .lose 1400 move c,[350700,,buffer+1] ;byte pointer into buffer after our initial ;:KILL move a,[440700,,jclbuf] ;and to our JCL jclscn: ildb b,a ;get a char caie b,^M ;(caie = skip if equal to effective address) cain b,^C ;if end (cain is same but skip if not equal) jrst gtchrs idpb b,c jrst jclscn ;loop till end (jrst = go to) gtchrs: setzm count ;we start here movem c,bpsav ;for later typeout from this point cain b,177 ;did it end with a rubout? jrst backup ;yep, flush it, and don't add a space movei b,40 ;nope, add in a space after the command idpb b,c ;put it there movem c,bpsav ;and remember THIS as the start instead. inloop: .iot tyic,b ;read the character cain b,177 ;is it a rubout? jrst rubout ;go rub it out. cain b,^L ;is it a ^L? jrst displa ; yes, re-display cain b,^Z ;is it a ^Z? jrst byebye ;yes, quit cain b,^D ;is it a ^D jrst flush ;go flush it. cain b,^W ;kill word? jrst kword ; yes, go kill it. aos count ;it's not a command, cain b,^Q ;is it ^Q ? jrst [.iot tyoc,b ; yes, echo the ^Q .iot tyoc,[":] ; prompt .iot tyic,b ; get another character movei d,3 ; 3 positions to wipe out call wipe ; wipe out that may characters jrst dput] dput: idpb b,c ;it's data, write it into the buffer skipe lfflag ;do we need to LF because of rubouts? jrst [.iot tyoc,[^J] ;LF setzm lfflag ;note that we've done it jrst echo] ;and continue echo: .iot tyoc,b ;echo it caie b,^C ;skip to do the .VALUE if it's ^C cain b,^M ;if not, skip if it's not a CR, to not do it .value buffer ; do it jrst inloop ;get another character rubout: cain count, ;don't delete past beginning jrst [.iot tyoc,[7] ;beep at him jrst inloop] ;and don't do it! sos count ldb b,c ;get the character being rubbed out movei d,1 ;most chars are 1 char wide cail b,40 ;if control cain b,177 ;or rubout movei d,2 ;it's two instead call wipe ;wipe out that many characters backup: decbp c ;decrement the byte pointer (macro) jrst inloop ;go get another char displa: setzm lfflag ;don't need to LF after rubout if displayed move b,ttyopt tlnn b,%toers ;is it erasible? jrst [.iot tyoc,[^M] ;terpri rather than ^PA, want it to do .iot tyoc,[^J] ;something visible on empty line. jrst displ1] ;and continue .iot tyoc,[^P] ;clear the screen .iot tyoc,["C] ;since that's what people expect when they ;type ^L displ1: move b,count ;need a copy of the count move d,bpsav ;start it at where he started inputing syscal siot,[argi tyoc ;type it out d ? b] .lose 1400 jrst inloop ;and continue reading. flush: setzm lfflag ;don't need to LF after rubout if flushed movei b,.length /^D XXX? / move d,[440700,,[ascii /^D XXX? /]] syscal siot,[argi tyoc ? d ? b] ;type the ^D XXX? .lose 1400 setz count, ;back to the start move c,bpsav jrst inloop kword: skipn count ;if count is zero jrst [.iot tyoc,[7] ; beep jrst inloop] ; and don't do anything setz d, ;zero d, which is count of positions to wipe kword1: ldb b,c ;get the character caie b,177 ;rubout cail b,40 ;or control aos d ; it takes two chars to rub out decbp c ;decrement the bp sosg count ;back up the count jrst kword3 ; oops, back to the begining upper b ;uppercase b. cail b,"A ;if not alphabetic caile b,"Z jrst kword1 ;then get another character kword2: ldb b,c ;get another upper b cail b,"A ;if not before a word caile b,"Z jrst kword3 ;keep going back caie b,177 ;rubout cail b,40 ;or control aos d ; it takes two chars to rub out decbp c ;get the previous byte sose count ;back up the count jrst kword2 ; it's ok, we've got more chars kword3: call wipe ;clear the screen jrst inloop ;backed over a word, ok. wipe: movni d,(d) ; d <- - hrlzi d,(d) ; D <- ,,0 push sp,b ;we use B locally wipe1: move b,ttyopt tlne b,%TOERS ;skip if can't erase jrst [.iot tyoc,[^P] ;type the erase character ^P code (^PX) .iot tyoc,["X] jrst gobk] ;and return tlnn b,%tomvb ;if this TTY can't backspace directly jrst [ldb b,c ;we can't erase, so, we .iot tyoc,b ; echo deleted char (crude, but effective) jrst gobk] ;and return .iot tyoc,[^H] ;backspace .iot tyoc,["/] ;wipe it out .iot tyoc,[^H] ;and back over it setom lfflag ;and note to LF when we get real char. gobk: aobjn d,wipe1 ;loop for each character. pop sp,b ;restore b ret ;return to caller byebye: movei a,.length /Flushed / move b,[440700,,[ascii /Flushed /]] skipe lfflag ;do we need to LF because of rubouts? .iot tyoc,[^J] ; yes. Don't bother zeroing flag, we die skipn lfflag ;otherwise we need to space .iot tyoc,[40] syscal siot,[argi tyoc ? b ? a] ;type it out jfcl .logout 1, ;bye-bye bpsav: 0 ;saved byte pointer to start of user text vsize: 0 hsize: 0 ttyopt: 0 lfflag: 0 ;set non-zero if we have just rubbed out ;means to LF when get a real char. ocount: 0 ;count before killing word buffer: ascii /:KILL / ;buffer to write our DDT command in block 150 jclbuf: block 100 pdl: block pdlen end inline