program "ecce_" {Implementation of Edinburgh Compatible Context Editor in LC for Intel 8086 by Rainer Thonnes, December 1980 based on that in IMP for DEC PDP9/15 by Hamish Dewar, June 1970} const min=1 mout=1 sin=2 stop=-5000 word in=min word mon=0 word case=95 word print1=0 word print2=0 const sextra=122 word pp1 sym word code text num const cbase=1 tbase=120 word ci ti word cmax=0 word c(cbase:tbase) word stored(1:192)=0(192) word pos1=0 word pos2=0 word pos3=0 const bufmax=10000 word top=1 word bot=bufmax-sextra byte a(0:bufmax) word lbeg pp word fp=0 word lend=0 word fend=0 word ms=0 word ml=0 word type chain word pend=0 word mfp=0 word mlend=0 word mend=0 word sfp=0 word send=0 byte symtype(33:95)= 64 3 3 3 2 3 3 11 9 64 3 12 2 3 3 0 0 0 0 0 0 0 0 0 0 3 1 3 3 3 64 3 18 10 26 5 8 52 10 2 6 10 10 122 56 2 2 10 50 10 22 5 117 6 2 32 32 32 3 10 3 3 3 { ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ Special classes 0 Normal 1 %A,%C,%S 2 %X,%Y,%Z 3 %M,%F,%Q 4 ! * ? 5 unused 6 unused 7 %L,%U Normal classes 0 Digits 0:9 1 NL and ; 2 Illegals %,-,A,H,N,O,Q,W 3 delimiters "#$&'+./<>=@[]^_ 4 F 5 D,T,U 6 I,S,V 7 unused 8 E,M 9 ) 10 B,C,G,J,K,L,P,R,\ 11 ( 12 , 13 unused 14 unused 15 unused} spec psym "printsymbol" spec rsym "readsymbol" spec selin "selectinput" spec selout "selectoutput" spec rout "resetoutput" spec signal "signal" spec trap "trap" spec xprompt "XPrompt" spec phex "PHex" const nl=10 proc main "ecce." spec ecce "ecce" selout 0; psym 'E'; psym 'C'; psym 'C'; psym 'E' psym ' '; psym '0'; psym '6'; psym '/'; psym '0' psym '1'; psym '/'; psym '8'; psym '1'; psym nl ecce end proc mainfp return fp if in=min return mfp end proc readsym if pend#0 sym=pend; pend=0 else cycle if pos3=0 sym=rsym; return finish sym=stored(pos3); pos3=pos3+1 return if sym#0 pos3=pos2; pos2=pos1; pos1=0 repeat finish end proc readitem cycle type=1 cycle readsym repeat if sym=' ' return if sym<' ' sym=sym-32 if sym>=96 type=symtype(sym) return if type&15#0 if type=32 pos1=pos2; pos2=pos3; pos3=sym-'X'<<6+1 finish repeat if type=32 if type=0 num=sym-'0' cycle readsym; pend=sym return if sym<'0' return if sym>'9' pend=0; num=num*10-'0'+sym repeat else type=0; num=0; return if sym='*' num=stop+1; return if sym='?' num=stop {sym='!'} finish end proc unchain cycle text=chain; return if text=0 chain=c(text+1); c(text+1)=ci repeat if c(text)#'(' end proc stack v c(ci)=v; ci=ci+1 end proc readline word k if fp#fend lend=fp cycle return if a(lend)=nl lend=lend+1 repeat finish selin in if trap 1<<9#0 fp=bot; lend=fp; fend=lend; a(fp)=nl else fp=bot-121 cycle k=nl; k=rsym if fp#bot; a(fp)=k; fp=fp+1 repeat if k#nl fend=fp; lend=fend-1; fp=bot-121 finish selin 0 ms=0; print1=0; print2=0 end proc break a(pp)=nl; pp=pp+1; lbeg=pp end proc leftstar cycle return if pp=lbeg fp=fp-1; pp=pp-1; a(fp)=a(pp) repeat end proc rightstar cycle return if fp=lend a(pp)=a(fp); pp=pp+1; fp=fp+1 repeat end proc makespace word k p1 p2 return if mainfp-pp>240 selout mout p1=top; p2=p1+lbeg>>1; p2=lbeg if code='C' signal 15 p1 p2 if p2=top cycle k=a(p1); psym k; p1=p1+1 k=0 if p1'z' return ch&case end proc matched {used for F,U,T,D,V} word i j k l t1 fp1 lim lim=c(ci-3)>>7 t1=cased c(text) cycle pp1=pp; fp1=fp if fp#lend; cycle k=a(fp) if cased k=t1 if fp=ms jump no if code='F' jump no if code='U' finish i=fp; j=text cycle i=i+1; j=j-1; l=cased c(j) if l=0 ms=fp; ml=i; return 1 finish repeat if cased a(i)=l finish return 0 if code='V' no: a(pp)=k; pp=pp+1; fp=fp+1 repeat if fp#lend; finish return 0 if code='V' lim=lim-1; lim=0 if fp=fend if lim=0 pp=pp1; fp=fp1; return 0 finish if code='U' pp=pp1 else break finish refresh repeat end proc switchinputs if in=min leftstar; in=sin mfp=fp; mlend=lend; mend=fend bot=bot+sextra; fp=sfp; fend=send readline else pp=lbeg; in=min bot=bot-sextra; sfp=fp; send=fend; fp=mfp lend=mlend; fend=mend finish end proc showpointers phex top; psym ' '; psym ' ' phex lbeg; psym ' '; phex pp; psym ' ' phex fp; psym ' '; phex lend; psym ' ' psym ' '; phex fend; psym ' ' end proc ecce "ecce" word i j k jump eof if trap 1<<9#0 selout 0 pp=top-1; break; readline readco: xprompt 0; xprompt '>'; xprompt '>' if in=sin cycle ci=cbase; ti=tbase; chain=0 showpointers if mon>0 readitem repeat if type=1 if type=0; if cmax#0 c(cmax+2)=num; readitem jump er2 if type#1 jump execute finish; finish if sym='%' readsym; sym=sym-32 if sym>=96; code=sym jump er5 if code<'A'; readitem i=symtype(code)>>4 else nextunit: i=type&15; jump er2 if i<4 code=sym; text=0; num=1; readitem finish jump er5 if i=0 if i=1 {%c,s,a} if code='A' selout mout; rout; signal 0 0 0 finish if code='S' switchinputs; jump monitor finish eof:code='C' switchinputs if in=sin cycle rightstar if fp=fend selout mout cycle signal 0 0 0 if top=pp psym a(top); top=top+1 repeat finish break; refresh repeat finish if i=2 {%x,y,z} i=code-'X'<<6+1 if sym='=' cycle readsym if sym#nl stored(i)=sym jump er6 if i&63=0 i=i+1 finish repeat if sym#nl stored(i)=0 jump readco finish cycle sym=stored(i) if sym=0 psym nl; jump readco finish psym sym; i=i+1 repeat finish if i=3 {%m,f,q} mon='M'-code; jump readco finish if i=4 {f} num=0 if type#0 finish if i<=5 {+d,t,u} code=num<<7+code; num=1; readitem if type=0 finish if i<=6 {+i,s,v} jump er4 if type#3; text=ti; i=sym cycle readsym if sym=nl pend=sym; i=sym finish if sym=i if code#'I'; if code#'S' jump er4 if sym=nl jump er4 if ti=text finish; finish c(ti)=0; ti=ti-1; jump ri finish jump er6 if ti<=ci; c(ti)=sym; ti=ti-1 repeat finish if i=7 {%u,l} case=95; case=127 if code='L'; jump readco finish if i=8 {m,e} jump nq if sym#'-'; code=code+10 ri: readitem; jump rn finish if i=9 {)} unchain; jump er3 if text=0 c(text+2)=num; text=text+3 finish if i<=10 {+g,k,etc} nq: jump er1 if type=3 rn: readitem if type=0 jump put finish if i=12 {,} readitem if type=1 finish if i<=12 {+(} text=chain; chain=ci; num=0 finish signal 14 1 i if i>12 put: stack code; stack text; stack num jump er6 if ci+4>=ti jump nextunit if type#1 unchain; jump er3 if text#0 cmax=ci stack ')'; stack cbase; stack 1 stack 0; jump execute er1: psym ' '; psym code er2: code=sym; jump er5 er3: psym ' '; psym '('; psym ')'; jump er7 er4: psym ' '; psym 'T'; psym 'e'; psym 'x'; psym 't' psym ' '; psym 'f'; psym 'o'; psym 'r' er5: psym ' '; psym code&127; jump er7 er6: psym ' '; psym 'S'; psym 'i'; psym 'z'; psym 'e' er7: psym '?'; psym nl cmax=0 if ci#cbase cycle jump readco if sym=nl; readsym repeat execute: ci=cbase get: code=c(ci)&127; jump monitor if code=0 text=c(ci+1); num=c(ci+2); ci=ci+3 rep: num=num-1 jump xm if code='M' jump xw if code='W' jump xl if code='L' jump xr if code='R' jump xc if code='C' jump xlb if code='(' jump xcomma if code=',' jump xrb if code=')' jump no if code='\' jump xj if code='J' jump xk if code='K' jump xp if code='P' jump xb if code='B' jump xg if code='G' jump xi if code='I' jump xs if code='S' jump xt if code='T' jump xd if code='D' jump xu if code='U' jump xf if code='F' jump xv if code='V' jump xo if code='O' jump xe if code='E' signal 14 2 code ok: jump get if num=0 jump get if num=stop jump rep no: jump get if num<0 if c(ci)='\' ci=ci+3; jump get finish skp: i=c(ci); ci=c(ci+1) if i='('; ci=ci+3 if i#','; if i#')' jump skp if i#0; jump xer finish; finish num=c(ci-1)-1; jump no xer: psym 'F'; psym 'a'; psym 'i'; psym 'l'; psym 'e'; psym 'd' psym ' ' if code='O' psym 'E'; code='-' else if code='W' psym 'M'; code='-' finish psym code if text#0 psym '"' cycle i=c(text); psym i if i#0; text=text-1 repeat if i#0 psym '"' finish psym nl; print1=0 monitor: jump readco if sym#nl jump readco if mon<0 if print1=lend jump readco if mon=0 jump readco if print2=fp+pp finish num=0; printline jump readco xlb: c(text+2)=num+1; jump get xrb: jump get if num=0 jump get if num=stop c(ci-1)=num xcomma: ci=text; jump get xc: jump no if fp=lend; i=a(fp) if i&95>='A'; if i&95<='Z' a(fp)=i\32 finish; finish xr: jump no if fp=lend a(pp)=a(fp); pp=pp+1; fp=fp+1; jump ok xl: jump no if pp=lbeg jump no if in=sin fp=fp-1; pp=pp-1; a(fp)=a(pp) ms=0; jump ok xe: jump no if fp=lend; fp=fp+1; jump ok xo: jump no if pp=lbeg; pp=pp-1; jump ok xv:xu:xd:xf: jump no if matched=0 if code='U' pp=pp1 else if code='D' fp=ml finish jump ok xt: jump no if matched=0 cycle a(pp)=a(fp); pp=pp+1; fp=fp+1 repeat if fp#ml jump ok xs: jump no if fp#ms; fp=ml xi: makespace jump no if pp-lbeg+lend-fp>80 i=text cycle jump ok if c(i)=0 a(pp)=c(i); pp=pp+1; i=i-1 repeat xg: xprompt 0; xprompt ':' makespace; i=rsym; jump no if i=':'; leftstar if i#nl; cycle a(pp)=i; pp=pp+1; i=rsym repeat if i#nl; finish xb: break; jump ok xp: printline; jump get if num=0 xm: rightstar; jump no if fp=fend; break m1: refresh; jump ok xk: pp=lbeg; fp=lend k1: jump no if fp=fend; jump m1 xj: rightstar; jump no if pp-lbeg>80; jump k1 xw: jump no if in=sin makespace jump no if lbeg=top lend=fp-pp+lbeg-1 cycle k=a(pp-1) if k=nl; if pp#lbeg lbeg=pp; ms=0; jump ok finish; finish fp=fp-1; pp=pp-1; a(fp)=k repeat end {ecce} end {file}