; - - - - - - - - - - - - - - - - - - - - - - - $MACRO print ** p%%t <#@*(1"Z)> $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - $MACRO p%%t printf "#@1=(%d)(%o)" <#@1> <#@1> $ENDM ; - - - - - - - - - - - - - - - - - - - - - - - / yes=1 no=0 debug=no cntl==140 ;add this to a control char to get ascii control==-1 ;type of all control chars program jpl .mcall gprt$,dir$ gprt: gprt$ psdev,tbuf ;get partition info on `psdev' its only on a machine tbuf: .blkw 3 speed:: .word 9600. ;speed of terminal if this is small, assume no crt cret: .byte 15,0 ech: .asciz '=x' fact: .asciz 'reserved letters=(f,g,i,m,o,q,r,s,u,z)' prm: .asciz <15>'a>' btab: .asciz /abcdehjklnptvwxy/ .even mcr: .byte 127.,41. ;get mcr cmd line dpb struct input member term member string[82.] end-struct input .mcall exit$s start: jsr pc,main ;we want this prog as small as possible exit$s ;so don't use std main stuff auto s[84.],t,len,lh[8.],p,star,ch auto t1,pt,t2 function main cur=r3 trm=r4 dir$ #gprt ;we do a get partition on psdev to tell which ;machine we are on. Then adjust prompt to a/b. if cs movb #'b,prm+1 ;if no picture system, then its the b system. fi .if eq debug-yes movb #76,prm+1 ;an >> prompt so's we can tell who we is .endc r2 := &s ;do a get mcr into array s (r2) := mcr dir$ r2 if 6(r2) = #<"SL> ;slow terminal= sl on cmd line mov #300.,speed fi .lh[#3] := #0 ;clear data cell of list head ilist[&lh] ;init list stuff[lh,#con.a,""] ;initially two buffers, control-a,-b, both null stuff[lh,#con.b,""] ; cur := next[lh] ;start at first buffer in list do forever do forever t := line[&s,speed,#prm] ;read a line, t=line terminator break if t ne #-1 ;until there was no timeout r0 := " Time out at:" ;in which case just spawn call outstr ;a time command so we know the call creturn ;terminal has been inactive system["tim"] ;and up for grabs od len := strlen[&s] ;get length of input line trm := ctype[t] ;find type of the terminator if len = #0 ;a command begin select terminator-type trm for case #cr ;edit mode if editm[lh,cur,&s] ne #0 call creturn system[] fi break case #esc ;rotate buffers cur := next[cur] if cur = lh cur := next[cur] fi call creturn p := cur ;shift to next buffer and call prnt ;print it break case #control ;get from buffer t r2 := find[lh,t] if (r2) = t r0 := r2 + #string call outstr call creturn system[] else call creturn printf "undefined string `%c'" fi break case #con.z ;clear current buffer #string[cur] := #0 break case #con.f ;display facts if speed gt #600. mov #fact,r0 call outstr fi call creturn for call prnt rof break case #con.qq ;control ? = help message call creturn system["h jplconq"] ;spawn a help command break case #0 ;control null debug call creturn ldump[lh] printf "&s=%o t=%o cur=%o" &s,t,cur printf "editm=(%o) change=(%o) find=(%o)" #editm #change #find break default jmp none esac end else ;not a zero length line select terminator-type trm for case #con.qq ;^? find 1st avail buffer call conqq break case #control ;stuff buffer t conques: stuff[lh,t,&s] outterm[t] break case #cr ;execute line and save cpy[cur,&s] ;in current buffer call creturn system[&s] break default none: call creturn printf "I can't do that" esac fi od done: ret conqq: pt := #btab for if p ne cur t1 := #term[p] t2 := #0[pt,b] if t1 ne or strlen[

] = #0 qq1: t := t2 - #cntl jmp conques fi fi inc pt(r5) rof t2 := #0[pt,b] if t2 ne #0 br qq1 else call creturn printf "No more buffers" fi rts pc prnt: ;prints buf at p if p = cur star := #'* else star := #space fi printf "%c%c=(%s)" star <@p(r5) + #cntl>

rts pc creturn:: ;output a cr push r0 mov #cret,r0 call outstr pop r0 rts pc auto ch function outterm[t] ;outputs =x for terminator x ch := t + #cntl movb ch(r5),ech+1 mov #ech,r0 call outstr ret function stuff[lh,t,s] ;stuff s into buf t in list lh (extend if nec) found=r4 new.cell=r2 found := find[lh,t] if term(found) = t cpy[found,s] else new.cell := insert[prev[found],new[#input]] term(new.cell) := t cpy[new.cell,s] fi ret function cpy[into,s] ;copy string s into buffer r2 := into + #string clrb (r2) cat[r2,s,#0] ret function find[lh,t] ;returns node with term=t or ret ins loc this=r4 this := lh do forever this := next[this] if term(this) ge t or this = lh ret this fi od function ctype[term] ;returns type of the terminator ; ; returns are: ; ^z ^f ^? others ; cr esc con.z con.f con.qq control ; ; where control means any undefined control char ; i.e. used for buffers ; r4 := term select case r4 of case #cr ret #cr case #esc ret #esc case #con.z ret #con.z case #con.f ret #con.f case #con.qq ret #con.qq case #0 ret #0 default ret #control esac .end start