!!This version of ECCE, derived from a paper copy believed to
!!date from 1975, removes PDP9/15 machine code, and other
!!IMP9/15 system dependencies, and I'm hopeful that as a result
!!it might well work if compiled with a generic Imp compiler.
!!RWT Feb 2002
begin; !edit15: ecce for pdp9/15
owninteger in=1; !current input stream
constinteger min=1; !main input stream
constinteger mout=1; !main output stream
constinteger sin=2; !secondary input stream
constinteger sextra=122; !extra buff for sin
constinteger size=30000; !of edit buffer (bytes)
owninteger mon=0; !monitor indic
owninteger print1=0,print2=0; !print indicators
constinteger stop=-5000; !loop stop (const)
integer i,j,k,pp1,sym
integer code; !command code letter
integer text; !text pointer
integer num; !repetition number
integername mainfp; ! == fp or mfp (for sin)
constinteger cbase=1,tbase=120
ownintegerarray c(cbase:tbase); !command -> <- text
! each command unit -- letter, parenthesis or comma -- is
! represented by a trio: code(+lim) text num
! in the case of parentheses and commas 'text' is a pointer
! to another command unit (not to a text string)
integer ci; !command index (ad)
integer ti; !text index (ad)
owninteger cmax=0; !command max (ad)
integerarray stored(1:192); !defs of x,y,z
owninteger pos1=0, pos2=0, pos3=0
byteintegerarray byte(1:size)
integer top; top = 2; !top of buff (index)
integer bot; bot = size-sextra; !bottom of buff (index)
integer lbeg; !line start (index)
integer pp; !previous pointer (index)
owninteger fp=0; !file pointer (index)
integer lend; !line end (index)
owninteger fend; !end of file in buff (index)
owninteger ms=0; !match start (index)
owninteger ml=0; !match limit (index)
! significance of file pointers:
! [nl] o n e nl t w . . . o nl n e x t nl . . nl l a s t nl [nl]
! ! ! ! ! ! !
! t l p f l f
! o b p p e e
! p e n n
! g d d
integer type,chain; !command input vars
owninteger pend=0; !ditto
switch t(0:12)
switch s('A':'¬')
on event 9 start
->eof
finish
routine load pp(integer k); !!!also increments pp
byte(pp) = k; pp = pp+1
end
routine load fp(integer k)
byte(fp) = k
end
routine left star
cycle
return if pp = lbeg
fp = fp-1; pp = pp-1
load fp(byte(pp))
repeat
end
routine right star
cycle
return if fp = lend
load pp(byte(fp))
fp = fp+1
repeat
end
ownintegerarray symtype(33:95) = c
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, 2,10,18, 5, 8,52,10, 2, 6,10,10,10,56, 2, 2,
10,50,10,22, 5, 5, 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 [ ¬ ] ^ _
routine read sym
if pend # 0 then sym=pend and pend=0 else start
while pos3 # 0 cycle
sym = stored(pos3); pos3 = pos3+1
return unless sym = nl
pos3 = pos2; pos2 = pos1; pos1 = 0
repeat
read ch(sym)
finish
end
routine read item
type = 1
cycle
read sym until sym # ' '
return if sym < 32; !nl
sym = sym-32 if sym >= 96; !ensure upper case
type = symtype(sym)
return unless type&15 = 0
exit unless type=32
pos1 = pos2; pos2 = pos3
pos3 = (sym-'X')<<6+1
repeat
if type = 0 start
num = sym-'0'
cycle
read ch(pend)
exit unless '0' <= pend <= '9'
num = (num<<2+num)<<1-'0'+pend
repeat
finish else start
type = 0
num = 0; return if sym = '*'
num = stop+1; return if sym = '?'
num = stop; ! '!'
finish
end
routine unchain
cycle
text = chain; return if text = 0
chain = c(text+1); c(text+1) = ci
repeat until c(text) = 'X'
end
routine stack(integer v)
c(ci) = v; ci = ci+1
end
routine make space
integer k,p1,p2
return if mainfp-pp-240 > 0
select output(mout)
p1 = top; p2 = (p1+lbeg)>>1; !ouptut about half
p2 = lbeg if code = 'C'; !but all if closing
monitor 20 if p2 = top; !!!logical error
cycle
k = byte(p1); print ch(k); p1 = p1+1
repeat until k = nl and p1-p2 >= 0
select output(0)
lbeg = top+lbeg-p1; p2 = pp; pp = top
cycle
return if p1 = p2
load pp(byte(p1)); p1 = p1+1
repeat
end
routine read line
integer k
on event 9 start
->eof
finish
if fp # fend start
lend = fp
lend = lend+1 while byte(lend) # nl
return
finish
ms = 0; print1 = 0; print2 = 0
select input(in)
fp = bot-sextra+1
cycle
if fp # bot then read ch(k) else k = nl
->eof if k<0
load fp(k); fp = fp+1
repeat until k = nl
fend = fp; lend = fend-1
fp = bot-sextra+1
select input(0)
return
eof:fp = bot; lend = fp; fend = lend
load fp(nl)
select input(0)
end
routine switch inputs
owninteger mfp,mlend,mend,sfp,send
if in = min start
left star
in = sin
mfp = fp; mlend = lend; mend = fend
mainfp == mfp
bot = bot+sextra; fp = sfp; fend = send
read line
finish else start
pp = lbeg
in = min
bot = bot-sextra; sfp = fp; send = fend
fp = mfp; lend = mlend; fend = mend
mainfp == fp
finish
end
routine print line
integer p
print1 = lend; print2 = fp+pp
p = lbeg
cycle
if p = pp start
print symbol('^') if p # lbeg and num = 0
p = fp
finish
exit if p = lend
print symbol(byte(p))
p = p+1
repeat
print string("**END**") if p = fend
newline
end
integerfn matched
integer i,j,k,l,t1,fp1,lim
lim = c(ci-3)&(¬127); t1 = c(text)
1: pp1 = pp; fp1 = fp
->3 unless fp = ms and (code='F' or code='U')
k = byte(fp)
2: load pp(k); fp = fp+1
3: ->10 if fp = lend
k = byte(fp)
->2 unless k = t1
i = fp; j = text
6: i = i+1; j = j-1
l = c(j)
->6 if byte(i) = l
->2 if l # 0
ms = fp; ml = i
result = 1
10: lim = lim-128
if lim # 0 and fp # fend start
if code # 'U' start
load pp(nl); lbeg = pp
finish else pp = pp1
fp = fp+1; make space; read line
->1
finish
pp = pp1; fp = fp1
result = 0
end
!initialise
pp = top-1; load pp(nl); !for bouncing off
lbeg = pp; mainfp == fp
stored(1) = nl; stored(65) = nl; stored(129) = nl
select output(0); print string("EDIT
")
read line
!read command line
1: prompt(">")
read item; ->eof if sym<0; ->1 if type = 1
ci = cbase; ti = tbase; chain = 0
if type = 0 and cmax # 0 start
c(cmax+2) = num
read item; ->er2 if type # 1
->go
finish
if sym = '%' start
read sym; sym = sym-32 if sym >= 96
code = sym; ->er5 if code<=32
read item
->t(symtype(code)>>4)
finish
2: i = type&15; ->er2 if i < 4
code = sym; text = 0; num = 1; !default values
read item
->t(i)
t(2): !%x, %y, %z
->er1 if sym # '='
i = (code-'X')<<6
cycle
read sym
i = i+1; stored(i) = sym
->1 if sym = nl
repeat
t(3): !%m, %f, %q
mon = 'M'-code
->1
t(4): !find
num = 0 unless type = 0
t(5): !+del,trav,uncover
code = num<<7+code; num = 1
read item if type = 0
t(6): !+insert,subst,verify
->er4 if type # 3
text = ti; i = sym
61: read sym
if sym # nl start
if sym # i start
->er6 if ti <= ci
c(ti) = sym; ti = ti-1
->61
finish
finish else start
pend = sym
->er4 unless code = 'S' or code = 'I'
finish
->er4 if ti = text and code # 'S'
c(ti) = 0; ti = ti-1
->81
t(8): !move,erase
->100 unless sym = '-'
code = code+10
81: read item
->101
t(9): !close bracket
unchain; ->er3 if text = 0
code = 'Z'; c(text+2) = num
text = text+3
t(10): !+get,kill,etc.
100:->er1 if type = 3
101:read item if type = 0
->put
t(11): !open bracket
code = 'X'
->121
t(12): !comma
code = 'Y'
read item if type = 1
121:text = chain; chain = ci
num = 0
put:stack(code); stack(text); stack(num)
->er6 if ci+4 >= ti
->2 unless type = 1
unchain; ->er3 if text # 0
cmax = ci
stack('Z'); stack(cbase); stack(1); !extra close b
stack(0)
->go
!command input error reports
er1:space; print symbol(code)
er2:code = sym
->er5
er3:print string(" ()")
->er7
er4:print string(" TEXT FOR")
t(0):
er5:space; print symbol(code&127)
->er7
er6:print string(" SIZE")
er7:print symbol('?')
newline; cmax = 0 if ci # cbase
10: ->1 if sym<32
read sym
->10
!execute command line
go: ci = cbase
get:code = c(ci)&127; ->99 if code = 0
text = c(ci+1)
num = c(ci+2)
ci = ci+3
rep:num = num-1
->s(code)
ok: ->rep unless num = 0 or num = stop
->get
s('¬'): !invert
no: ->get if num < 0
ci = ci+3 and ->get if c(ci) = '¬'
skp:i = c(ci); ci = c(ci+1) if i = 'X'
ci = ci+3
num = c(ci-1)-1 and ->no if i > 'X'
->skp if i # 0
!execution error report
print string("FAILURE: ")
if code='O' or code='W' start
print symbol(code-10); code = '-'
finish
print symbol(code)
if text # 0 start
print symbol('''')
while c(text) # 0 cycle
print symbol(c(text))
text = text-1
repeat
print symbol('''')
finish
newline
print1 = 0
!end of command line
99: ->1 if sym # nl
->1 unless (mon>=0 and print1#lend) or (mon>0 and print2#fp+pp)
num = 0; print line
->1
!individual commands
s('X'): !open bracket
c(text+2) = num+1
->get
s('Z'): !close bracket
->get if num = 0 or num = stop
c(ci-1) = num
s('Y'): !+comma
ci = text
->get
s('R'): !right shift
->no if fp = lend
load pp(byte(fp)); fp = fp+1
->ok
s('L'): !left shift
->no if in = sin or pp = lbeg
fp = fp-1; pp = pp-1; load fp(byte(pp))
ms = 0
->ok
s('E'): !erase
->no if fp = lend
fp = fp+1
->ok
s('O'): !erase back
->no if pp = lbeg
pp = pp-1
->ok
s('V'): !verify
i = fp-1; j = text+1
v1: i = i+1; j = j-1
k = c(j)
->v1 if byte(i) = k
->no if k # 0
ms = fp; ml = i
->ok
s('F'): !find
->no if matched = 0
->ok
s('U'): !uncover
->no if matched = 0; pp = pp1
->ok
s('D'): !delete
->no if matched = 0; fp = ml
->ok
s('T'): !traverse
->no if matched = 0
s('S'): !+substitute
fp = ml if fp = ms
s('I'): !+insert
make space
!! ->no %if pp-lbeg+lend-fp > 80
i = text
i1: ->ok if c(i) = 0
load pp(c(i)); i = i-1
->i1
s('G'): !get (line from tt)
prompt(":")
!! make space
read ch(i)
->no if i = ':'
left star
while i # nl cycle
load pp(i)
read ch(i)
repeat
s('B'): !+break (insert newline)
make space
load pp(nl); lbeg = pp
->ok
s('P'): !print
print line
->get if num = 0
s('M'): !+move
right star
->no if fp = fend
load pp(nl); lbeg = pp
m1: fp = fp+1; make space; read line
->ok
s('K'): !kill (line)
pp = lbeg; fp = lend
k1: ->no if fp = fend
->m1
s('J'): !join (delete newline)
right star
!! ->no %if pp-lbeg > 80
->k1
s('W'): !move back
->no if in = sin
make space
->no if lbeg = top
lend = fp-pp+lbeg-1
w1: k = byte(pp-1)
->w2 if k = nl and pp # lbeg
fp = fp-1; pp = pp-1; load fp(k)
->w1
w2: lbeg = pp; ms = 0
->ok
t(1): !%s, %c
->eof if code = 'C'
switch inputs
->99
eof:code = 'C'; !+eof on command stream
switch inputs if in = sin
cycle
right star
exit if fp = fend
load pp(nl); lbeg = pp
fp = fp+1; make space; read line
repeat
select output(mout)
while top # pp cycle
print ch(byte(top)); top = top+1
repeat
endofprogram