!VECCE for Win32 console mode, F. Culloch, 23/11/2013,
! Updated January 2026 to fix reverse-video (worked on legacy console, not new
! Windows Terminal) and switch from EMAS-style 2 blank lines + 2 command/
! message lines below text to VAX-style 2 command/message lines only.
! Based on...
!ECCExx: Implementation of ECCE for VAX, EMAS and MOUSES
! Revised specification (1981) including video support.
! Files addressed directly in virtual memory.
! Most of the main part of the program (routine EDI) is common
! to both VAX and EMAS versions. The procedures for opening
! and closing files are distinct. Upper-case is used for those
! sections of program text which are peculiar to one version.
!
! ECCE00 (09/02/81): initial test release
!
! ECCE01 (04/06/81): VT52/Bantam/hard-copy support
! ECCE02 (23/03/82): VT100 support added
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
OPTION "NOOPEN"
constinteger line insert = x'8000 0000',
inverse video = x'4000 0000'
constinteger Hard Copy = 0,
Bantam = 1, {P-E 550 old model}
VT52 = 2+line insert+inverse video,
VT100 = 3+line insert+inverse video,
VC404 = 4,
Win32Console= 5+line insert+inverse video
!
!%BEGIN; !MOUSES version (program not routine)
EXTERNAL ROUTINE VECCE ALIAS "__impmain" (INTEGER ARGC,
STRING(255) NAME ARRAY NAME ARGV); !*WIN32C*
EXTERNAL ROUTINE SPEC GET DIMENSIONS(INTEGER NAME ROWS, COLS)
EXTERNAL ROUTINE SPEC CURSOR TO(INTEGER ROW, COL)
EXTERNAL ROUTINE SPEC INVERT
constinteger rt=13, esc=27, dle=x'10'; !ISO control characters
CONSTINTEGER MAXNAME=255; !max file-name length
RECORDFORMAT FILE(STRING(MAXNAME) NAME, INTEGER TOP,LIM,VMTOP,VMLIM,FLAG)
!
ROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO); !bulk move
!
routinespec connect input(record(file)name f)
!%BYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER PSEUDO ADDR); !*MOUSES*
!!!!!!!!!!!!!!!!!!! Start of Editor proper !!!!!!!!!!!!!!!!!!!
!
routine edi(record(file)name old,sec,new, integer video,rows,cols)
! Only the TOP and LIM components of the file info records
! OLD, SEC and NEW are relevant for editing (except when
! referencing secondary input).
! In the EMAS version the original file is not copied into the
! working space (NEW) prior to entry, so that OLD_LIM is not
! equal to NEW_LIM: on VAX, OLD_LIM is equal to NEW_LIM (except
! when just 'showing' in which case NEW_TOP = NEW_LIM = 0).
! The parameter VIDEO defines terminal characteristics:
! sign-bit: can DELETE-LINE & INSERT-LINE
! 4000000: can reverse/reduce/underline arbitrary character
! 4: VC404
! 3: VT100
! 2: VT52
! 1: Bantam
! all zero: hard-copy
constinteger cbound=50; !command cell array bound
constinteger tbound=120; !quoted text array bound
constinteger stopper=-10000; !loop stop
constinteger casebit=32
integer cmax; !command cell max
integer ci; !command index
integer ti; !text index
integer code; !command code
integer ref; !text or bracket pointer
integer scope; !search limit
integer num; !repetition number
integer sym,sym1,pend
integer casemask; !¬0[¬CASEBIT] to respect[ignore] case
integer width; !line width (default 80)
integer dir; !current direction of movement
integer sin; !0[1] for main[secondary] input
integer macpos; !macro index values (3-byte nest)
!File pointers (byte addresses)
integer lbeg; !line start position
integer fp; !current file position
integer lend; !line end position
integer flim; !limit of current infile
integer gaptop; !start of gap
integer gaplim; !limit of gap
integer mstart,msize; !match start/size
integer sfp,slim; !saved FP & LIM for switching
integer newtop,newlim; !copies of NEW_TOP,NEW_LIM
! Video control variables
integer line; !line number of current line
integer winline; !line number of top line on screen
integer limline; !limit line number (if known)
integer breaks,joins; !count of lines added/removed
integer vrow,vcol; !video cursor position
owninteger zrow=0
owninteger mon=1
integer fprow
owninteger printline=0,printed=0
integer wintop,winbot; !first/last window row
!the variable size window extends
!from floating WINTOP to fixed WINBOT
integer winlim; != WINBOT+1
integer minwin; !minimum window size
integer changemin,changelbeg; !alteration positions
integer vp
integer endon
!
{ ^ stands for ESC in below }
conststring(11)array proms(0:7) = ">", {hardcopy}
"^X ^I >", {Bantam}
"^Y ^x>", {VT52}
"^[rrH^[2K>", {VT100}
"see below", {VC404}
">", {Win32 console}
""(*)
!%OWNSTRING(3)%ARRAY GPROM(0:3) = ":", "^A ", "^A", "^A"; !*VAX*
!%OWNSTRING(1)%ARRAY GPROM(0:3) = ":", " ", "", ""; !*EMAS*
constSTRING(3)ARRAY GPROMS(0:7) = ":", "^A ", "^A", "^M", " ", ""(*)
byteintegerarray macstore(0:255)
recordformat commandcell(byteinteger code,ref, SHORTinteger scope, integer count)
record(commandcell) array r(1:cbound)
byteintegerarray text(1:tbound); !text strings
!
! V i d e o c o n t r o l r o u t i n e s
{Pre-computed video control strings}
string(15) prom,
gprom
string(7) video invert,
video restore
!! Generate digit strings for VT100 control sequences: this should be
! machine coded ??
string(3)fn digits(integer N)
string(3) S
integer j
S = ""
if N >= 100 start
S = "1"; N = N-100 {Can't be >= 1000}
finish
if N >= 10 start
j = N // 10
S = S . to string(j+'0')
N = N - (j*4 + j)*2
finish
S = S . to string(N+'0')
result = S
end
routine VT100 cmd 1(integer p1, cmd symbol)
string(15) S = tostring(ESC) . "["
S = S . digits(p1) if p1 # 0
S = S . to string(cmd symbol)
print string(S)
end
routine VT100 cmd 2(integer p1, p2, cmd symbol)
string(15) S = to string(ESC)."["
S = S . digits(p1) if p1 # 0
S = S . ";" . digits(p2) if p2 # 0
S = S . tostring(cmd symbol)
print string(S)
end
routine Clear Screen
{Clear display screen on start up and termination}
if video = VT100 start
VT100 cmd 1(2,'J') {clear}
VT100 cmd 2(rows, 0, 'H') {set cursor}
finish
end
routine at(integer row,col)
! Set cursor to row ROW (0:ROWS-1) and column COL (0:COLS-1)
if video # 0 start
{Note that the fiddle used on the older displays where ' ' counts as }
{row/col 1 is not possible on VT100. Must send row+1/col+1 explicitly }
vrow = row; vcol = col
col = cols-1 if col >= cols
if video = VT100 start
VT100 cmd2(row+1,col+1,'H')
ELSE IF VIDEO = WIN32 CONSOLE
CURSOR TO(ROW, COL)
else if video = VT52; !VT52
print symbol (esc)
print symbol('Y'); print symbol(' '+row)
print symbol(' '+col)
finish else if video = VC404 start; !VC404
print symbol (dle); print symbol (' '+row)
print symbol(' '+col)
finish else start; !Bantam
print symbol (esc)
print symbol('X'); print symbol(' '+row)
print symbol(esc); print symbol('Y')
print symbol(' '+col)
finish
finish
end
!
routine clear line
! Clear rest of current row
EXTERNAL ROUTINE SPEC CLR LINE
if video # 0 and vcol < cols start
if video = VT100 start
VT100 cmd1(0,'K')
ELSE IF VIDEO = WIN32 CONSOLE
CLR LINE
else if video = VT52
print symbol(ESC)
print symbol ('x')
finish else if video = VC404 start; !VC404
print symbol(ESC)
print symbol (x'16')
finish else start; !Bantam
print symbol(ESC)
print symbol ('I'); print symbol (0)
finish
finish
end
!
routine vnewline
vrow = vrow+1; vcol = 0
newline
end
!
routine insert line(integer row)
EXTERNAL ROUTINE SPEC INS LINE
integer from
if video < 0 start
at(row,0) if vrow # row
vcol = 0
if video = VT100 start
print symbol(ESC); print symbol('7') {save cursor position}
VT100 cmd 2(row+1,0,'r') {restrict scrolling area}
print symbol(ESC); print symbol('8')
print symbol(ESC); print symbol('M') {force downward scroll}
print string( tostring(ESC) . "[;r" )
print symbol(ESC); print symbol('8') {restore cursor}
ELSE IF VIDEO = WIN32 CONSOLE
INS LINE
else
print symbol(esc); print symbol('L')
finish
finish
end
!
routine delete line(integer row)
external routine spec del line
if video < 0 start
at(row,0) if vrow # row
vcol = 0
if video = VT100 start
print symbol(ESC); print symbol('7') {save cursor}
VT100 cmd 2(row+1,0,'r')
VT100 cmd 2(rows,0,'H')
print symbol(ESC); print symbol('D')
print string( tostring(ESC) . "[;r" )
print symbol(ESC); print symbol('8')
ELSE IF VIDEO = WIN32 CONSOLE
DEL LINE
else
print symbol(esc); print symbol('M')
finish
finish
end
!
constinteger clear=1, inc=2
routine display line(integer mode)
integer k
if video<<1 > 0 and vcol = 0 start
print symbol(' '); vcol = 1
finish
cycle
vp = gaplim if vp = gaptop
if vp = flim start
if endon = 0 start
print string(" **END**")
limline = winline+vrow-wintop
finish
endon = 1
exit
finish
k = byteinteger(vp); vp = vp+1
exit if k = nl
print symbol(k) if vcol < cols
vcol = vcol+1
repeat
clear line if mode&clear # 0
vnewline if mode&inc # 0
end
!
routine update
! If a change has been made to the file
! update screen image, but only if current line is on screen
! CHANGEMIN identifies the earliest point in the file affected
! by alterations
integer l,d,j,nop
return if changemin = newlim; !no change =>
return if video = 0
joins = joins-breaks; l = line-winline+wintop-breaks
if l >= wintop and l < winlim start; !within window
vp = changemin; endon = 0
changemin = changemin-1 while changemin # newtop and byteinteger(changemin-1) # nl
if video < 0 then at(l,vp-changemin) else at(l,vp-changemin+1)
nop = 1
if changelbeg # lbeg or vp # changemin start
nop = 0
display line(clear+inc)
l = l+1
finish
-> done if l = winlim
if joins < 0 and video < 0 start; !net expansion
j = joins
cycle
if wintop > zrow start
delete line(zrow)
wintop = wintop-1; l = l-1
finish else start
delete line(winbot)
finish
j = j+1
repeat until j = 0
cycle
insert line(l)
joins = joins+1
repeat until joins = 0
finish
while vrow # winlim and (newtop<=vp<gaptop or (vp=gaptop and nop=0)) cycle
display line(clear+inc)
l = l+1
repeat
if joins # 0 start
d = winlim-l-joins
if d <= 0 or video > 0 start
display line(clear+inc) while vrow # winlim
finish else start
j = joins
cycle
delete line(vrow)
j = j-1
repeat until j = 0
cycle
cycle
vp = gaplim if vp = gaptop
endon = 1 and exit if vp = flim
vp = vp+1
repeat until byteinteger(vp-1) = nl
d = d-1
repeat until d = 0
at(winlim-joins,0)
cycle
insert line(vrow)
display line(clear+inc)
repeat until vrow = winlim
finish
finish
finish
done:
changemin = newlim; joins = 0; breaks = 0
end
!
routine display
! Update screen & ensure that current line is on screen
integer pre,k
!
routine scanback
while pre > 0 cycle
vp = gaptop if vp = gaplim
exit if vp = newtop
cycle
vp = vp-1
vp = gaptop if vp = gaplim
repeat until vp = newtop or byteinteger(vp-1) = nl
pre = pre-1
repeat
end
!
update
vp = lbeg; endon = 0
vp = vp-gaplim+gaptop if vp < gaplim <= fp
if video = 0 start
vcol = 0; printline = line; printed = gaptop+fp
if vp # fp and num = 1 start
cycle
print symbol(byteinteger(vp))
vp = vp+1
vp = gaplim if vp = gaptop
repeat until vp = fp
print symbol('^')
finish
display line(inc)
return
finish
pre = line-winline
if pre < 0 start; !before start of window
if pre > -minwin and (video<0 or wintop+pre>=zrow) start
!worth prefixing
wintop = wintop+pre; !decrease wintop (PRE neg)
while wintop < zrow cycle
delete line(winbot)
insert line(zrow)
wintop = wintop+1
repeat
if wintop > zrow start
at(wintop-1,0)
print symbol('='); clear line
finish
at(wintop,0)
cycle
display line(clear)
pre = pre+1
exit if pre >= 0
vnewline
repeat
winline = line
return
finish
finish else start
pre = pre+wintop-winlim
return if pre < 0; !within window =>
if pre < minwin start; !worth appending
k = pre
scanback
at(winlim,0) if video > 0
cycle
delete line(zrow)
if wintop > zrow then wintop = wintop-1 else winline = winline+1
insert line(winbot)
display line(clear+inc)
k = k-1
repeat until k < 0
NEWLINE IF VIDEO > 0; !*VAX* *WIN32C*
!*WIN32C* NEWLINE %AND NEWLINE %AND NEWLINE %IF VIDEO > 0; !*emas*
return
finish
finish
pre = minwin-1
pre = pre//2 if fp # flim
winline = line-pre
scanback
winline = winline+pre
wintop = winlim-minwin
if wintop > zrow start
at(wintop-1,0)
print symbol('='); clear line
vnewline
finish else start
at(zrow,0)
finish
cycle
display line(clear)
exit if vrow >= winbot
vnewline
repeat
end
!
! F i l e m o d i f y i n g r o u t i n e s
!
routine split
! Create gap in file if gap is not at FP
integer j,diff,unit
if newtop <= fp < gaptop start; !FP in upper half
if flim # newlim start; !lower half still in old
j = flim-gaplim; ! so must now copy across
->abdn if newlim-j < gaptop
move(j,gaplim,newlim-j)
gaplim = newlim-j
flim = newlim
finish
j = gaptop-fp; !amount to shift down
diff = gaplim-gaptop
cycle; !shift in units <= gapsize
unit = j; unit = diff if diff < unit
gaptop = gaptop-unit; gaplim = gaplim-unit
move(unit,gaptop,gaplim)
j = j-unit
repeat until j = 0
mstart = gaplim if mstart = fp
lbeg = lbeg+diff; lend = lend+diff
fp = gaplim
finish else start; !FP in lower half (old or new)
j = fp-gaplim
if j > 0 start
->abdn if gaptop+j >= newlim
move(j,gaplim,gaptop)
finish
gaptop = gaptop+j; gaplim = fp
finish
if gaptop < changemin start
changemin = gaptop; changelbeg = lbeg
finish
j = gaplim; j = newlim if flim # newlim
return if gaptop+256 < j
abdn:
print string(" ** File too big ")
stop
end
!
routine consolidate
! Ensure that the gap lies on a line boundary
! by copying up the remainder of a split line
integer diff
if gaptop # newtop and byteinteger(gaptop-1) # nl start
cycle
byteinteger(gaptop) = byteinteger(gaplim)
if gaplim = fp start
diff = gaplim-gaptop
lbeg = lbeg-diff; fp = fp-diff
lend = lend-diff; mstart = fp if mstart = gaplim
finish
gaptop = gaptop+1; gaplim = gaplim+1
repeat until byteinteger(gaptop-1) = nl
finish
end
!
routine join
! Erase from FP to end of line AND the line terminator
! (covers Kill, Join, Uncover)
! NB LEND not revised
split
lbeg = lbeg+(lend-fp+1); fp = lend+1
changelbeg = lbeg
gaplim = fp
if line >= winline then joins = joins+1 else winline = winline-1
limline = limline-1
end
!
routine switch
! Switch between main and secondary input
! Create false bottom if switching from main and lower half is in NEW
integer i
split
newlim = gaplim if flim = newlim; !create false bottom
i = sfp; sfp = fp; fp = i
i = slim; slim = flim; flim = i
sin = sin!!1
lbeg = lbeg-sfp+fp; gaplim = fp
newlim = flim if newlim = gaplim; !remove false bottom
lend = fp
lend = lend+1 while lend # flim and byteinteger(lend) # nl
joins = 999
limline = 99999
end
!
! C o m m a n d i n p u t routines
!
integer type,chain,hold,echo
!
routine print code(integer k)
! Print command letter (mapping 'minus' values)
print symbol(k-casebit) and k='-' if k >= 'a'
print symbol(k)
end
!
routine read sym
! Read next command symbol to SYM (maybe from macro def)
on event 9 start
finish
if pend # 0 start
sym = pend; pend = 0
finish else start
while macpos # 0 cycle; !expanding macro
sym = macstore(macpos&255)
macpos = macpos+1
return unless sym = nl; !(NL is definition terminator)
macpos = macpos>>8
repeat
read symbol(sym)
print symbol(sym) if echo # 0 and sym >= ' '
finish
end
!
routine ignore
echo = 0
read sym while sym # nl
end
!
!Symbol types:-
! 0:numeric 1:terminator 2:illegal 3:quote
! 4:DU 5:IS 6:E 7:KJBGC@$
! 8:F 9:TV 10:M 11:LR
! 12:( [ 13:, 14:) ] 15:? ¬
!High order bits relevant following percent
constbyteintegerarray symtype(32:95) =
16_03,16_03,16_03,16_03,16_07,16_02,16_03,16_03,
16_0C,16_0E,16_00,16_03,16_0D,16_02,16_03,16_03,
16_00,16_00,16_00,16_00,16_00,16_00,16_00,16_00,
16_00,16_00,16_03,16_01,16_02,16_02,16_02,16_0F,
16_07,16_07,16_07,16_17,16_54,16_06,16_08,16_07,
16_02,16_05,16_07,16_07,16_6B,16_4A,16_02,16_02,
16_0B,16_02,16_0B,16_25,16_09,16_34,16_49,16_70,
16_70,16_70,16_70,16_0C,16_0F,16_0E,16_03,16_03
! sp ! " # $ % & '
! ( ) * + , - . /
! 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 item
! Read symbol to SYM and codify in TYPE
! intercept macro letters ('W', 'X', 'Y', 'Z')
! assemble numeric items in NUM
cycle
type = 1; !for terminator
read sym until sym # ' '; !ignore spaces
return if sym < ' '; !terminator (any control) =>
sym = sym&95 if sym >= 96; !ensure upper case (and more)
type = symtype(sym)&15
return if type # 0; !not numeric or macro =>
exit if sym < 'W'
if macpos>>24 # 0 then macpos = 0 else macpos = (macpos<<2+(sym-'W'))<<6+1; !push down any existing calls
repeat
num = 0
return if sym = '*'
cycle
num = num*10+sym-'0'
read sym
repeat until not '0' <= sym <= '9'
pend = sym
end
!
routine minus
! Test for minus: map CODE if so
if sym = '-' start
code = code+casebit; !lower-case
read item
finish
end
!
routine unchain
! Insert forward references in left bracket and comma cells
cycle
ref = chain
return if ref = 0
chain = r(ref)_ref
r(ref)_ref = ci
repeat until r(ref)_code = '['
end
!
!
switch c(4:15), pc(0:7), s('$':'p')
integer i,j,p,fp1
!
! I n i t i a l i s a t i o n
!
mstart = 0; cmax = 0
r(cbound-1) = 0; !'immediate-action' cell
r(cbound-1)_count = 1
r(cbound) = 0; !'i-a' terminating cell
r(cbound)_code = ']'
r(cbound)_count = stopper+1
macpos = 0
macstore(1) = nl; macstore(65) = nl
macstore(129) = nl; macstore(192) = nl
casemask = ¬casebit; !ignore case distinctions (default)
width = 80; dir = 0
newtop = new_top; gaptop = newtop
newlim = new_lim
fp = old_top
gaplim = fp; lbeg = fp; lend = fp
flim = old_lim
lend = lend+1 while lend # flim and byteinteger(lend) # nl
sin = 0; sfp = sec_top; slim = sec_lim
changemin = newlim; changelbeg = 0
joins = 0; breaks = 0
line = 1; winline = 0; limline = 999999
GET DIMENSIONS(ROWS, COLS)
WINLIM = ROWS-4; !*EMAS*
COLS = COLS-1; !*WIN32C*
WINLIM = ROWS-2; !*VAX* *WIN32C*
winbot = winlim-1; wintop = winbot
!*MOUSES* MINWIN = 20{ 3?} %AND WINLINE = -99
MINWIN = ROWS-2 AND WINLINE = -999; !*WIN32C*
! vrow = 99
VROW = 999; !*WIN32C*
!*MOUSES* newlines(rows-winlim-1) %if video # 0
NEWLINES(ROWS-WINLIM-2) IF VIDEO # 0; !*WIN32C*
!!! %for i = 0,1,3 %cycle
!!! %for j = 1,1,length(prom(i)) %cycle
!!! charno(prom(i),j) = esc %if charno(prom(i),j) = '^'
!!! %repeat
!!! charno(prom(i),3) = ' '+winlim %if i > 0
!!! CHARNO(GPROM(I),1) = ESC %IF I > 0; !*VAX*
!!! %repeat
!!! charno(prom(1),4) = rt; charno(prom(1),7) = rt
begin {***** Initialise PROMPT strings *****}
string(15) S
p = video & 7
prom = proms(p)
gprom = gproms(p); charno(gprom,1) = ESC if charno(gprom,1) = '^'
for j = 1,1,length(prom) cycle
charno(prom,j) = ESC if charno(prom,j) = '^'
repeat
if video = VT52 or video = BANTAM start
charno(prom,3) = ' '+winlim
video invert = to string(ESC)."4" {reduced intensity}
video restore = to string(ESC)."3" {normal}
if video = BANTAM start
charno(prom,4) = rt; charno(prom,7) = rt
finish
else if video = win32 console
video invert = tostring(ESC)."[7m"
video restore = tostring(ESC)."[0m"
else if video = VT100
S = digits(winlim+2) {*** This must be TWO digits ***}
charno(prom,3) = charno(S,1)
charno(prom,4) = charno(S,2)
video invert = tostring(ESC)."[1;7m" {inverse video}
video restore = tostring(ESC)."[m" {normal}
else if video = VC404
prom = to string(DLE) . "4" . to string(' '+winlim) . to string(x'16') . ">"
finish
end {PROMPT initialisation}
clear screen
sym = nl
!
! R e a d n e w c o m m a n d l i n e
!
read:
if sin = 0 then prompt(prom) else prompt(prom.">")
pend = 0; sym1 = sym
if sym = nl start
if video = 0 start
num = 1
display if (mon=0 and printline#line) or (mon>0 and printed#gaptop+fp)
finish else start
display
! Show position of pointer
fprow = line-winline+wintop
at(fprow,fp-lbeg)
if video > 0 start
IF video = BANTAM THEN PRINT SYMBOL(ESC) AND PRINT SYMBOL(127) ELSE PRINT SYMBOL('^'); !ESC+127 IS BANTAM SPLODGE
sym1 = ' '
if fp # lbeg start
if fp # gaplim then sym1 = byteinteger(fp-1) else sym1 = byteinteger(gaptop-1)
finish
finish else start
print string(video invert) {change display mode for one char}
sym1 = ' '; sym = '|'
if fp # lend and byteinteger(fp) # ' ' start
sym1 = byteinteger(fp); sym = sym1
finish
print symbol(sym)
print string(video restore)
finish
NEWLINE; !*VAX* to flush
finish
AT(WINLIM,0) AND CLEAR LINE IF VIDEO = WIN32 CONSOLE; !*WIN32C*
finish else start
read sym
pend = sym if sym # nl; !NL not significant
finish
! Deal with special cases
ci = 0; ti = 0; chain = 0
echo = 0
cycle
read item
exit if sym # '-'
dir = dir!!casebit; !toggle direction
repeat
if type = 1 start; !plain RETURN
r(cbound-1)_code = 'M'+dir; !M/M-
ci = cbound-2
-> restore
finish
if type = 0 and cmax # 0 start; !repetition
r(cmax)_count = num
read item; -> er1 if type # 1
-> restore
finish
if sym = '%' start
read sym; -> erq if sym < 'A'
code = sym&95; !upper-case
read sym
-> pc(symtype(code)>>4&7)
finish
dir = 0
if video > 0 start
clear line; print symbol('=')
print symbol(sym)
echo = 1
finish
! C o m m a n d i n p u t: m a i n l o o p
more: !(command code has been read)
hold = type; -> er2 if hold < 4
-> er0 if hold < 8 and newtop = 0; !no changes when Showing
ci = ci+1; -> er6 if ci >= cbound-3
code = sym; !command letter
ref = 0; num = 1; scope = 1; !default values
read item
-> c(hold)
c(8): !Find
minus
scope = 0
c(4): !+ Delete, Uncover
c(9): !+ Traverse, Verify
if type = 0 start; !followed by number
scope = num
read item
finish
num = 0; !as indicator (not I,S)
c(5): !+ Insert, Substitute
hold = sym; -> er4 if type # 3; !not valid quote mark ->
ti = ti+1; ref = ti; !REF indexes first quoted symbol
cycle
read sym
if sym = nl start; !closing quote omitted
-> er4 if num = 0; !allowed only for I,S
pend = sym; sym = hold
finish
exit if sym = hold
-> er6 if ti > tbound-2
sym = sym&casemask if 'a' <= sym <= 'z' and num = 0
text(ti) = sym; ti = ti+1
repeat
-> er4 if ti = ref and num = 0; !null allowed only for I,S
text(ti) = 0; !end-marker
num = 1; !restore default
read item
-> nput
c(6): !Erase
c(10): !+ Move, Print
minus
c(7): !+ Get, Kill, etc
c(11): !+ Left, Right, etc
-> er1 if type = 3; !(redundant, but better report)
-> nput
c(12): !open bracket
code = '['
-> comma
c(13): !comma
code = '^'
! read item %if type = 1; !permit line break (better not?)
comma:
ref = chain; chain = ci
-> put
c(14): !close bracket
unchain; -> er3 if ref = 0
code = ']'; r(ref)_count = num
nput:
read item if type = 0; !get next item if number
c(15): !invert, query
put:
r(ci)_code = code; r(ci)_ref = ref
r(ci)_scope = scope; r(ci)_count = num
-> more unless type = 1
ci = ci+1; cmax = ci
unchain; -> er3 if ref # 0
r(ci)_code = ']'; r(ci)_ref = 0
r(ci)_count = 1
ci = 0
AT(WINLIM,0) IF VIDEO=WIN32 CONSOLE; !*WIN32C* neccessary, but why?!
insert line(winlim); !preserve command line
restore:
if sym1 # nl start
at(fprow,fp-lbeg)
print symbol(sym1)
finish
-> next
!
er0:print symbol(' '); print code(sym)
print string(" when Showing")
-> erq
er1:print symbol(' '); print symbol(code)
er2:code = sym
-> er5
er3:printstring(" Brackets")
-> erq
er4:printstring(" Text for")
pc(0):
er5:print symbol(' '); print code(code)
-> erq
er6:printstring(" Size")
erq:print symbol('?')
if video # 0 then clear line else newline
cmax = 0 if ci > 1
ignore
-> read
!
! Percent commands
pc(1): !%C: close
switch if sin # 0
new_flag = 1 if changelbeg # 0
new_lim = gaptop
old_top = gaplim; old_lim = flim
clear screen
return
pc(2): !%S: secondary input
switch if sin # 0
if sym = '=' start
i = 0
cycle
read sym
exit if sym = ';' or sym = nl
-> er6 if i = maxname
i = i+1; charno(sec_name,i) = sym
repeat
length(sec_name) = i
connect input(sec)
finish
sfp = sec_top; slim = sec_lim
-> erq if sec_top = sec_lim
switch
-> read
pc(3): !%U: ignore/respect case
casemask = ¬casebit
casemask = ¬0 and read sym if sym = '-'
-> read
pc(4): !%M (%V)
if code = 'M' start
mon = 0
mon = 1 and read sym if sym = '+'
mon = -1 and read sym if sym = '-'
finish else start
read item
-> erq if type # 0
video = (num&x'C')<<28+num&7
winline = -99
finish
-> read
pc(5): !%D: define window size
if sym = '=' start
read item
-> erq if type # 0
-> er6 unless num <= winlim
minwin = num
video = 0 if num <= 0
finish
winline = -99
-> read
pc(6): !%L: define line width
-> erq if sym # '='
read item
-> erq if type # 0
-> er6 unless 5 <= num <= 256
width = num
-> read
pc(7): !%W, %X, %Y, %Z
i = (code-'W')<<6+1; !64-byte increments
if sym = '=' start; !definition
cycle
read sym
macstore(i) = sym
exit if sym = nl
i = i+1 if i # 255
repeat
finish else start; !enquiry
-> er1 if sym # nl
print symbol(code); print symbol('=')
cycle
sym = macstore(i)
exit if sym = nl
print symbol(sym)
i = i+1
repeat
if video # 0 then clear line else newline
finish
-> read
!
! C o m m a n d e x e c u t i o n
!
integerfn matched
integer i,j,k
i = fp-1; j = ref-1
cycle
i = i+1; j = j+1
k = byteinteger(i)
k = k&casemask if 'a' <= k <= 'z'
repeat until k # text(j)
result = 0 if text(j) # 0
mstart = fp; msize = i-fp
result = 1
end
!
! Extract next command
!
next: s('?'):
ci = ci+1
code = r(ci)_code; ref = r(ci)_ref
num = r(ci)_count
-> s(code)
!
! Successful return after Move etc
! FP has been advanced into next line, new LEND to be determined
lok:
lend = fp
if lend # flim start
lend = lend+1 while byteinteger(lend) # nl
finish
! Successful return from execution
ok:
num = num-1
-> next if num = 0
-> s(code)
fail:
num = 1
! Failure return
no: s('¬'):
cycle
-> next if num <= 0; !indefinite repetition ->
ci = ci+1; !check following cell:-
-> next if r(ci)_code = '¬'; !invert ->
-> next if r(ci)_code = '?'; !query ->
while r(ci)_code # ']' cycle
-> next if r(ci)_code = '^'; !comma ->
ci = r(ci)_ref if r(ci)_code = '['
ci = ci+1
repeat
num = r(ci)_count
repeat until ci >= cmax
-> read if num <= 0
!
!E x e c u t i o n e r r o r
!
at(winlim+1,40)
printstring(" Failure: ")
print code(code)
if ref # 0 start
print symbol('''')
while text(ref) # 0 cycle
print symbol(text(ref))
ref = ref+1
repeat
print symbol('''')
finish
if video # 0 then clear line else newline
ignore
-> read
!
!I n d i v i d u a l c o m m a n d s
!
s('['): !open bracket
r(ref)_count = num; !restore count on ']'
-> next
!
s(']'): !close bracket
num = num-1
if num # 0 and num # stopper start
r(ci)_count = num; !update
ci = ref; !position of '['
finish else start
-> read if ci >= cmax
finish
-> next
!
s('^'): !comma
ci = ref-1; !position of ']' - 1
-> next
!
s('P'):
display
-> ok if num = 1
s('M'): !Move
-> no if fp = flim
update
fp = lend+1
fp = gaplim if fp = gaptop
line = line+1
fp = flim and line = limline if num = 0 and code = 'M'
lbeg = fp
-> lok
!
s('m'): !Move back
-> no if lbeg = newtop or sin # 0
update
consolidate
mstart = 0
if num = 0 start; !M-*
lbeg = newtop
lbeg = gaplim if lbeg = gaptop
fp = lbeg
line = 1; num = 1
-> lok
finish
if lbeg = gaplim start
-> no if gaptop = newtop
lbeg = gaptop
finish
line = line-1; !there is a line there
lend = lbeg-1
lbeg = lbeg-1 until lbeg=gaplim or lbeg=newtop or byteinteger(lbeg-1)=nl
fp = lbeg
-> ok
!
s('C'): !Case-change with right-shift
-> no if fp = lend
if 'A' <= byteinteger(fp)&95 <= 'Z' start
split
byteinteger(gaptop) = byteinteger(fp)!!casebit
gaptop = gaptop+1; gaplim = gaplim+1
finish
!
s('R'): !Right-shift
-> no if fp = lend
fp = fp+1
-> ok
!
s('L'): !Left-shift
-> no if fp = lbeg or sin # 0
consolidate if fp = gaplim
mstart = 0
fp = fp-1
-> ok
!
s('E'): !Erase
-> no if fp = lend
split
lbeg = lbeg+1; fp = fp+1
gaplim = fp
-> ok
!
s('e'): !Erase back
-> no if fp = lbeg
split
lbeg = lbeg+1; gaptop = gaptop-1
changemin = gaptop if gaptop < changemin
-> ok
!
s('V'): !Verify
-> no if fp = lend
-> no if (byteinteger(fp)!!text(ref))&casemask # 0; !quick check
-> no if matched = 0
-> next
!
s('D'): !Delete
s('T'): !+ Traverse
fp1 = fp
-> find
!
s('F'): !Find
s('U'): !+ Uncover
fp1 = fp
fp = fp+1 if fp = mstart
find:
scope = r(ci)_scope; !number of lines to search
sym1 = text(ref); !first symbol of quoted text
while fp # flim cycle
while byteinteger(fp) # nl cycle
if (byteinteger(fp)!!sym1)&casemask = 0 start
-> found if matched # 0
finish
fp = fp+1
repeat
lend = fp
scope = scope-1
exit if scope = 0
if code # 'U' start
update
fp = fp+1
fp = gaplim if fp = gaptop
lbeg = fp
line = line+1
finish else start
fp = fp1; join
finish
fp1 = fp
repeat
lend = fp; fp = fp1
-> no
found:
if code = 'D' start
split
lbeg = lbeg+msize; fp = fp+msize
gaplim = fp
finish
fp = fp+msize if code = 'T'
if code = 'U' start
i = fp-fp1; fp = fp1
split
lbeg = lbeg+i; fp = fp+i
gaplim = fp
finish
-> lok
!
s('f'): !Find back
scope = r(ci)_scope
update
consolidate
cycle
while fp # lbeg cycle
fp = fp-1
-> ok if matched # 0
repeat
scope = scope-1
-> no if scope = 0 or fp = newtop
if fp = gaplim start
-> no if gaptop = newtop
fp = gaptop
finish
lbeg = fp
fp = fp-1; lend = fp
line = line-1
lbeg = lbeg-1 until lbeg=gaplim or lbeg=newtop or byteinteger(lbeg-1)=nl
repeat
!
s('S'): !Substitute
-> no if fp # mstart
split
lbeg = lbeg+msize; fp = fp+msize
gaplim = fp
!
s('I'): !+Insert
-> ok if text(ref) = 0
-> no if fp-lbeg > width or fp = flim
split
j = ref
cycle
byteinteger(gaptop) = text(j)
gaptop = gaptop+1; j = j+1
repeat until text(j) = 0
lbeg = lbeg-(j-ref)
-> ok
!
s('G'): !Get (line from terminal)
-> no if sin # 0 and fp # lbeg
consolidate
fp = lbeg
split
if video # 0 start
if video < 0 start
display
fprow = line-winline+wintop
delete line(winlim)
insert line(fprow)
finish else start
byteinteger(gaptop) = nl; gaptop = gaptop+1
breaks = breaks+1
line = line+1; limline = limline+1
update
fp = gaptop-1; lbeg = fp
line = line-1
display
fprow = line-winline+wintop
gaptop = gaptop-1
fp = gaplim; lbeg = fp
limline = limline-1
at(fprow,0)
finish
!*WIN32C* NEWLINE; !*VAX*
finish
prompt(gprom)
read sym
vrow = 999
if sym = ':' start
read sym until sym = nl
if video # 0 start
if video < 0 start
delete line(fprow)
insert line(winlim)
finish else start
changemin = gaptop; changelbeg = lbeg
joins = joins+1
finish
finish
-> no
finish
line = line+1; limline = limline+1
cycle
byteinteger(gaptop) = sym; gaptop = gaptop+1
exit if sym = nl
read sym
repeat
if video < 0 and fprow = winbot start; !bring back
delete line(zrow)
if wintop > zrow then wintop = wintop-1 else winline = winline+1
insert line(winlim)
finish
-> ok
!
s('B'): !Break
num = 66 if num = 0 or num > 66
split
break:
byteinteger(gaptop) = nl; gaptop = gaptop+1
breaks = breaks+1
line = line+1; limline = limline+1
lbeg = fp
-> ok
!
s('K'): !Kill
-> no if fp = flim
fp = lbeg
join
-> lok
!
s('J'): !Join
fp = lend
-> no if fp = flim or fp-lbeg > width
join
-> lok
!
s('A'): !Adjust
-> s('M') if lend = lbeg
consolidate
while lend-lbeg <= width cycle
fp = lend+1
if fp = gaptop start
fp = gaplim; lbeg = lbeg+(gaplim-gaptop)
finish
lend = fp
lend = lend+1 while lend # flim and byteinteger(lend) # nl
if fp = lend or byteinteger(fp) = ' ' start
update
lbeg = fp; line = line+1
->no
finish
split
byteinteger(gaptop-1) = ' '
changemin = gaptop-1 if changemin >= gaptop
joins = joins+1; limline = limline-1
repeat
consolidate
fp = lbeg+width+1
cycle
fp = fp-1
-> no if fp = lbeg
repeat until byteinteger(fp) = ' '
split
fp = fp+1
gaplim = fp
-> break
!
!
s('@'): !'at' Column NUM
-> fail if lend = flim
i = width-(lend-fp)
num = i if i < num
i = fp-lbeg-num
-> next if i = 0
split
cycle
if i < 0 start; !left of it
byteinteger(gaptop) = ' '; gaptop = gaptop+1
lbeg = lbeg-1; i = i+1
finish else start
-> fail if fp = lbeg or byteinteger(gaptop-1) # ' '
gaptop = gaptop-1; lbeg = lbeg+1
changemin = gaptop if gaptop < changemin
i = i-1
finish
repeat until i = 0
-> next
s('$'): !switch inputs
switch
-> next
end; !END OF EDI
!*MOUSES* !System-specific stuff
!*MOUSES* %include "sysinc:command.inc" {to access user command line}
!*MOUSES*
!*MOUSES* %RECORD %FORMAT PARM FM (%SHORT DSNO,DACT,SSNO,SACT,
!*MOUSES* %INTEGER P1,P2,P3,P4,P5,P6)
!*MOUSES* %RECORD(PARM FM) P
!*MOUSES* %CONST %INTEGER TT NO WIDTH = X'80'; !INHIBIT LINE BREAK PATTERN
!*MOUSES* %CONST %INTEGER TT NO PAGE = X'40'; !INHIBIT PAGE WAIT PATTERN
!*MOUSES* %CONST %INTEGER TT ERASE = X'20'; !VIDEO DELETE ENABLED?
!*MOUSES* %CONST %INTEGER TT TABS = X'40000'; !TAB STOPS OR 3-SPACES?
!*MOUSES* %INTEGER OLD TT; !HOLD CONSOLE STATE BITS DURING EDIT
!*MOUSES* %CONST %INTEGER CACHE SIZE = 12; !BLOCKS
!*MOUSES* %CONST %INTEGER PAGING FILE = 1; !DA CHANNEL
!*MOUSES* %OWN %STRING(31) PAGE FILE NAME
!*MOUSES* %STRING(3) %FN UNIQUE EXTENSION
!*MOUSES* %RECORD(PARMFM) P
!*MOUSES* %STRING(31)%NAME SN
!*MOUSES* P_DACT = 25; SVC (20,P); !PACKED UNIQUE FILENAME
!*MOUSES* P_P4 = P_P4&X'FFFF'; !LEAVE EXTENSION
!*MOUSES* SVC (18,P); !UNPACK
!*MOUSES* SN == STRING(ADDR(P_SACT)); ! => STRING RESULT
!*MOUSES* %RESULT = SUBSTRING(SN,2,LENGTH(SN)); !KILL "."
!*MOUSES* %END
!*MOUSES* PAGE FILE NAME = "$ECCE.".UNIQUE EXTENSION
!*MOUSES* %OWN %INTEGER MAX BLOCK = 400; !DEFAULT SIZE OF DA FILE
!*MOUSES*
!*MOUSES* %RECORD %FORMAT BLOCKFM(%BYTE %ARRAY B(0:511))
!*MOUSES* %EXTERNAL %PREDICATE %SPEC EXISTS (%STRING(31) FILENAME)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC OPEN DA (%INTEGER CHAN,PROT,%STRING(31) FILENAME)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC RENAME FILE (%STRING(31) OLDNAME, NEWNAME)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC CREATE FILE (%STRING(31) FILENAME, %INTEGER BLOCKS,
!*MOUSES* %INTEGERNAME ACTUAL); !RETURN ALLOC
!*MOUSES* %EXTERNAL %ROUTINE %SPEC DELETE FILE (%STRING(31) FILENAME)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC READ DA(%INTEGER CHAN,BLOCK, %NAME BUFFER)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC WRITE DA(%INTEGER CHAN,BLOCK, %NAME BUFFER)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC EXTENDDA(%INTEGER CHAN,BLOCKS,%INTEGERNAME NEW SIZE)
!*MOUSES* %EXTERNAL %ROUTINE %SPEC CLOSE DA(%INTEGER CHAN)
!*MOUSES*
!*MOUSES*
!*MOUSES* %RECORD %FORMAT BUF FM (%INTEGER BLOCK,
!*MOUSES* %RECORD(BUF FM)%NAME LINK,
!*MOUSES* %RECORD(BLOCK FM) BLK)
!*MOUSES*
!*MOUSES* %RECORD(BUF FM) %ARRAY BUFFER(1:CACHE SIZE)
!*MOUSES* %RECORD(BUF FM) %NAME BUF
!*MOUSES*
!*MOUSES* %ROUTINE FLUSH BUFFERS
!*MOUSES* %RECORD(BUFFM)%NAME B
!*MOUSES* %INTEGER J
!*MOUSES* %FOR J = 1,1,CACHE SIZE %CYCLE
!*MOUSES* B == BUFFER(J)
!*MOUSES* %IF B_BLOCK >= 0 %START; !VALID?
!*MOUSES* WRITE DA (PAGING FILE,B_BLOCK,B_BLK)
!*MOUSES* B_BLOCK = -1; !INVALIDATE
!*MOUSES* %FINISH
!*MOUSES* %REPEAT
!*MOUSES* %END
!*MOUSES*
!*MOUSES* !INITIALISATION
!*MOUSES*
!*MOUSES* DELETE FILE(PAGE FILE NAME) %IF EXISTS(PAGE FILE NAME)
!*MOUSES* CREATE FILE(PAGE FILE NAME,MAX BLOCK,MAX BLOCK)
!*MOUSES* OPEN DA (PAGING FILE,1,PAGE FILE NAME)
SELECT INPUT (0); SELECT OUTPUT (0)
!*MOUSES*
!*MOUSES* %INTEGER WHICH
!*MOUSES* %FOR WHICH = 1,1,CACHE SIZE %CYCLE; !INITIALISE CACHE LIST
!*MOUSES* BUF == BUFFER(WHICH)
!*MOUSES* BUF_BLOCK = -1; !MARK AS NOT IN USE
!*MOUSES* %IF WHICH # 1 %THEN BUF_LINK == BUFFER(WHICH-1) %C
!*MOUSES* %ELSE BUF_LINK == BUFFER(CACHE SIZE); !SET UP CIRCULAR LIST
!*MOUSES* %REPEAT
!*MOUSES*
!*MOUSES* %OWN %INTEGER FREE = 1; !FIRST USABLE PSEUDO-ADDRESS
!*MOUSES*
!*MOUSES* %INTEGERFN TERMTYPE { *** configuration dependent ***}
!*MOUSES* %CONST %INTEGER CONSOLES = 15
!*MOUSES* %CONST %INTEGER %ARRAY TT TYPE(0:CONSOLES) =
!*MOUSES* HARDCOPY(9),; !0..8
!*MOUSES* VC404,; !9 (In machine room)
!*MOUSES* VC404,; !10 (John's VC404)
!*MOUSES* VT100 {PE550},; !11 (Chris's Bantam)
!*MOUSES* HARDCOPY(*)
!*MOUSES* %RECORD(PARM FM) P
!*MOUSES* %INTEGER TT
!*MOUSES* P_P1 = 0; !ME
!*MOUSES* SVC (14,P); !GET PROCESS INFO
!*MOUSES* TT = TT TYPE(P_P6)
!*MOUSES* !! P_P2 = 0; !MY TTY
!*MOUSES* !! P_P1 = 10
!*MOUSES* !! P_P3 = TT NO PAGE + TT ERASE + TT NO WIDTH + TT TABS
!*MOUSES* !! SVC (29,P)
!*MOUSES* !! OLD TT = P_P4; !REMEMBER WHAT IT WAS BEFORE
!*MOUSES* %RESULT = TT
!*MOUSES* %END
!*MOUSES*
!*MOUSES* %BYTEINTEGERMAP BYTEINTEGER(%INTEGER PSADDR); !PSEUDO ADDRESS
!*MOUSES* ! Map pseudo address into a <block,byte> pair. (Block
!*MOUSES* ! may be in a DA file or in an LRU cache list).
!*MOUSES* PSADDR = PSADDR-1; !SO THAT FIRST BYTE IN FILE IS USED
!*MOUSES* %INTEGER BLOCK = PSADDR>>9, OFFSET = PSADDR&511
!*MOUSES* %RECORD(BUFFM)%NAME PREV,P
!*MOUSES* P == BUF_LINK; !HEAD OF CACHE LIST
!*MOUSES* %CYCLE
!*MOUSES* %IF P_BLOCK = BLOCK %START; !REQUIRED BYTE MAPPED IN THIS BLOCK?
!*MOUSES* !YES: PROMOTE THIS BUFFER TO HEAD OF THE LIST
!*MOUSES* %IF P == BUF %START; !TAIL BECOMES HEAD (CIRCULAR LIST)
!*MOUSES* BUF == PREV
!*MOUSES* %ELSE %IF P ## BUF_LINK; !ALREADY HEAD?
!*MOUSES* PREV_LINK == P_LINK
!*MOUSES* P_LINK == BUF_LINK
!*MOUSES* BUF_LINK == P
!*MOUSES* %FINISH
!*MOUSES* %RESULT == P_BLK_B(OFFSET)
!*MOUSES* %FINISH
!*MOUSES* %EXIT %IF P == BUF
!*MOUSES* PREV == P
!*MOUSES* P == P_LINK
!*MOUSES* %REPEAT
!*MOUSES* !BLOCK NOT IN THE CACHE - REPLACE LRU BLOCK (TAIL OF LIST)
!*MOUSES* %IF BUF_BLOCK >= 0 %START; !LAST BUFFER IN USE ALREADY?
!*MOUSES* WRITE DA (PAGING FILE, BUF_BLOCK, BUF_BLK); !WRITE OUT TO DISC
!*MOUSES* %FINISH
!*MOUSES* !PROMOTE LAST BUFFER (NOW MRU).
!*MOUSES* BUF == PREV
!*MOUSES* P_BLOCK = BLOCK
!*MOUSES* READ DA (PAGING FILE, BLOCK, P_BLK)
!*MOUSES* %RESULT == P_BLK_B(OFFSET)
!*MOUSES* %END
ROUTINE MOVE(INTEGER LENGTH,FROM,TO)
RETURN IF FROM = TO
IF TO <= FROM START
WHILE LENGTH > 0 CYCLE
BYTEINTEGER(TO) = BYTEINTEGER(FROM)
FROM = FROM+1
TO = TO+1
LENGTH = LENGTH-1
REPEAT
ELSE; !MOVE FROM BACK TO FRONT
FROM = FROM+LENGTH
TO = TO+LENGTH
WHILE LENGTH > 0 CYCLE
FROM = FROM-1
TO = TO-1
BYTEINTEGER(TO) = BYTEINTEGER(FROM)
LENGTH = LENGTH-1
REPEAT
FINISH
END
ROUTINE CONNECT INPUT(RECORD(FILE)NAME F)
EXTERNAL ROUTINE SPEC FREE(INTEGER A)
EXTERNAL INTEGER FN SPEC READIN(INTEGER FNAME ADDR, EXTRA,
INTEGER NAME BASE, TOP, FEND, LIMIT)
STRING(MAXNAME) FNAME
FREE(F_VMTOP) IF F_VMTOP # 0; !RE-USE SECONDARY FILE SPACE
FNAME = F_NAME.TOSTRING(0); !APPEND C STRING TERMINATOR
F_FLAG = READIN(ADDR(FNAME)+1, F_FLAG, F_VMTOP, F_TOP, F_LIM, F_VMLIM)
!D! PRINTSTRING("READIN returned "); WRITE(F_FLAG, 0); NEWLINE
IF F_FLAG # 0 START
F_VMTOP = 0; F_TOP = 0; F_LIM = 0
FINISH
! Ensure that file does not end with partial line
F_LIM = F_LIM-1 WHILE F_LIM # F_TOP AND BYTEINTEGER(F_LIM-1)#NL
END
!*MOUSES* %ROUTINE CONNECT INPUT(%RECORD(FILE)%NAME F)
!*MOUSES* %RECORD(BLOCKFM) BLOCK
!*MOUSES* %INTEGER BUFFER = ADDR(BLOCK), SYM, J, KEY
!*MOUSES* %RECORD(PARMFM) P
!*MOUSES* %ON 9 %START
!*MOUSES* ->EOF
!*MOUSES* %FINISH
!*MOUSES* FREE = F_VMTOP %IF F_VMTOP # 0; !REUSE SECONDARY FILE SPACE
!*MOUSES* FREE = FREE-1; !PSADDR => BYTE ADDR IN FILE
!*MOUSES* FREE = FREE+1 %WHILE FREE&511 # 0; !=> BLOCK BOUNDARY
!*MOUSES* J = FREE>>9; !REMEMBER BLOCK NO
!*MOUSES* FREE = FREE+1; !FILE BYTE ADDR (0-N) => PSADDR
!*MOUSES* F_VMTOP = FREE
!*MOUSES* FREE = FREE+512*F_FLAG; J = J + F_FLAG
!*MOUSES* F_TOP = FREE
!*MOUSES* F_FLAG = 0; !OK
!*MOUSES* -> EOF %IF F_NAME = ""
!*MOUSES* %IF EXISTS(F_NAME) %START; !QUICK LOAD FROM DISC
!*MOUSES* FLUSH BUFFERS; !MAKE CHANGES TO FILE VALID
!*MOUSES* STRING(ADDR(P_SACT)) = F_NAME
!*MOUSES* SVC (17,P); !PACK
!*MOUSES* P_DACT = 4; SVC (20,P); !OPEN SEQUENTIAL INPUT
!*MOUSES* KEY = P_P5
!*MOUSES* %CYCLE
!*MOUSES* P_P5 = KEY; P_P4 = BUFFER
!*MOUSES* P_DACT = 7; SVC(20,P); !READ SEQUENTIAL BLOCK
!*MOUSES* WRITE DA (PAGING FILE,J,RECORD(BUFFER))
!*MOUSES* FREE = FREE+512; J = J + 1
!*MOUSES* %REPEAT %UNTIL P_P6 # 0; !LAST BLOCK?
!*MOUSES* P_P5 = KEY; P_DACT = 11; !CLOSE FILE
!*MOUSES* SVC (20,P)
!*MOUSES* %ELSE
!*MOUSES* %IF EXISTS(F_NAME) %START
!*MOUSES* OPEN INPUT(3,F_NAME)
!*MOUSES* %ELSE
!*MOUSES* F_FLAG = -1
!*MOUSES* F_TOP = 0; F_LIM = 0
!*MOUSES* %RETURN
!*MOUSES* %FINISH
!*MOUSES* SELECT INPUT(3)
!*MOUSES* %CYCLE; !READ FILE INTO PSEUDO-VM
!*MOUSES* READ SYMBOL (SYM)
!*MOUSES* BYTEINTEGER(FREE) = SYM
!*MOUSES* FREE = FREE+1
!*MOUSES* %REPEAT
!*MOUSES* CLOSE INPUT
!*MOUSES* %FINISH
!*MOUSES* EOF:
!*MOUSES* F_LIM = FREE
!*MOUSES* F_LIM = F_LIM-1 %WHILE F_LIM # F_TOP %AND BYTEINTEGER(F_LIM-1) # NL
!*MOUSES* FREE = FREE+40; !CAUTIOUS
!*MOUSES* F_VMLIM = FREE-1
!*MOUSES* CLOSE INPUT
!*MOUSES* SELECT INPUT(0)
!*MOUSES* %END
!*VAX* !system-specific stuff
!*VAX* !
!*VAX* ! External system routines
!*VAX* !
!*VAX* %EXTERNALINTEGERFNSPEC CHECKQUOTA(%STRING(127) FILENAME)
!*VAX* %EXTERNALSTRING(72)%FNSPEC SYSMESS(%INTEGER I)
!*VAX* %EXTERNALSTRING(255)%FNSPEC CLIPARAM
!*VAX* !
!*VAX* ! Special routines from PMM to handle file referencing and i/o
!*VAX* !
!*VAX* %EXTERNALINTEGERFNSPEC READIN(%STRING(MAXNAME)%NAME FILE,
!*VAX* %INTEGER EXTRA, %INTEGERNAME BASE,TOP,FEND,LIMIT)
!*VAX* %EXTERNALINTEGERFNSPEC WRITEOUT(%STRING(MAXNAME)%NAME FILE,
!*VAX* %INTEGER BASE,TOP,FEND,LIMIT)
!*VAX* %EXTERNALROUTINESPEC DELETEVM(%INTEGER BASE,LIMIT)
!*VAX* !
!*VAX* %ROUTINE CONNECT INPUT(%RECORD(FILE)%NAME F)
!*VAX* ! Reference file specified by F_NAME
!*VAX* ! allocate store to hold it + extra blocks specified by F_FLAG
!*VAX* ! place the file in store (as near the end as possible)
!*VAX* ! Return store addresses in F_VMTOP/F_VMLIM
!*VAX* ! file addresses in F_TOP/F_LIM
!*VAX* ! ( VMTOP <= TOP <= LIM <= VMLIM )
!*VAX* ! (The area from LIM to VMLIM is not used; it exists only because
!*VAX* ! it is not possible to predict precisely how much space the file
!*VAX* ! will occupy when converted from VAX/VMS record format to a
!*VAX* ! sanitary form, viz. straight ASCII with NLs at end of lines)
!*VAX* !
!*VAX* !Discard any previous secondary input file
!*VAX* DELETEVM(F_VMTOP,F_VMLIM) %IF F_VMTOP # 0
!*VAX* !Read the file in
!*VAX* F_FLAG = READIN(F_NAME,F_FLAG,F_VMTOP,F_TOP,F_LIM,F_VMLIM)
!*VAX* %IF F_FLAG # 0 %START
!*VAX* PRINT STRING(" *".SYSMESS(F_FLAG).": ".F_NAME)
!*VAX* F_VMTOP = 0; F_TOP = 0; F_LIM = 0
!*VAX* %FINISH
!*VAX* ! Ensure that file does not end with partial line
!*VAX* F_LIM = F_LIM-1 %WHILE F_LIM # F_TOP %AND BYTEINTEGER(F_LIM-1)#NL
!*VAX* %END
!*VAX* !
!*VAX* %INTEGERFN TERMTYPE
!*VAX* %CONSTINTEGER VT52=16_40
!*VAX* %RECORDFORMAT DEVINFO(%INTEGER GEN, %BYTE CLASS,TYPE, %SHORT WIDTH,
!*VAX* %BYTE A,B,C,COLS,D,E,F,G,H,I,J,K)
!*VAX* %RECORDFORMAT DESC(%INTEGER L,A)
!*VAX* %SYSTEMINTEGERFNSPEC GETDEV(%RECORD(DESC)%NAME DEV, %INTEGERNAME Z,
!*VAX* %RECORD(DESC)%NAME RES, %INTEGERNAME X, %INTEGER Y)
!*VAX*
!*VAX* %INTEGER F,X
!*VAX* %RECORD(DEVINFO) TT
!*VAX* %RECORD(DESC) DEV,RES
!*VAX* %OWNSTRING(2) DEVNAME="TT"
!*VAX*
!*VAX* DEV_L = 2; DEV_A = ADDR(DEVNAME)+1
!*VAX* RES_L = 20; RES_A = ADDR(TT)
!*VAX* X = 0
!*VAX* F = GETDEV(DEV,X,RES,X,0)
!*VAX* %IF F&1 = 0 %START
!*VAX* PRINTSTRING(SYSMESS(F))
!*VAX* NEWLINE
!*VAX* %STOP
!*VAX* %FINISH
!*VAX* %RESULT = 16_C0000002 %IF TT_TYPE = VT52
!*VAX* %RESULT = 0
!*VAX* %END
!*VAX*
INTEGER I,F,L,SYM,DEFAULT
RECORD(FILE) IN,SEC,OUT
!*VAX* %STRING(255) PARM=CLIPARAM
!*VAX* %routine getname(%string(maxname)%name s)
!*VAX* ! Extract next name from PARM, leaving terminator in SYM
!*VAX* %integer j
!*VAX* j = 0
!*VAX* %cycle
!*VAX* sym = nl
!*VAX* l = l+1 %and sym = charno(parm,l) %if l < length(parm)
!*VAX* %exit %if sym = ',' %or sym = '/' %or sym < ' '
!*VAX* %if sym = ' ' %start
!*VAX* %exit %if j # 0
!*VAX* %finish %else %start
!*VAX* sym = sym-32 %if sym >= 96
!*VAX* j = j+1 %if j # maxname; charno(s,j) = sym
!*VAX* %finish
!*VAX* %repeat
!*VAX* length(s) = j
!*VAX* s = ".N" %if s = ".NULL"
!*VAX* %end
!*VAX* !
in = 0; sec = 0; out = 0
!*VAX* %if parm = "" %start
!*VAX* prompt("File: ")
!*VAX* l = 0
!*VAX* %cycle
!*VAX* read symbol(sym)
!*VAX* %exit %if sym = nl
!*VAX* l = l+1; charno(parm,l) = sym
!*VAX* %repeat
!*VAX* length(parm) = l
!*VAX* %finish
l = 0
!*MOUSES* %STRING(31)%NAME IN1 == COMMAND_IN1,
!*MOUSES* IN2 == COMMAND_IN2,
!*MOUSES* OUT1 == COMMAND_OUT1
!*MOUSES* IN_NAME = IN1
!*MOUSES* IN_NAME = "" %IF IN_NAME = "N:" %OR IN_NAME = "NULL:"
!*MOUSES* SEC_NAME = IN2
!*MOUSES* OUT_NAME = OUT1
!*MOUSES* %IF OUT_NAME = "" %THEN OUT_NAME = IN_NAME %AND DEFAULT = 1 %C
!*MOUSES* %ELSE DEFAULT = 0
!*MOUSES* OUT_NAME = "" %IF OUT_NAME = "N:" %OR OUT_NAME = "NULL:"
!*VAX* getname(in_name)
!*VAX* GETNAME(SEC_NAME) %IF SYM = ','
!*VAX* in_name = "" %if in_name = ".N"
!*VAX* out_name = in_name; default = 1
!*VAX* %if sym = ' ' %or sym = '/' %start
!*VAX* getname(out_name); default = 0
!*VAX* OUT_NAME = "" %IF OUT_NAME = ".N"
!*VAX* %finish
!*VAX* %if sym # nl %start
!*VAX* print string(" Faulty parameters: ".parm)
!*VAX* newline
!*VAX* spaces(19+l); print symbol('^'); newline
!*VAX* %STOP
!*VAX* %finish
PREDICATE NULL(STRING(MAXNAME) FNAME)
TOUPPER(FNAME)
TRUE IF FNAME="NUL" OR FNAME="NUL:" OR FNAME="NULL:"
FALSE
END
INTEGER FN TERMTYPE
EXTERNAL ROUTINE SPEC INIT CONSOLE
INIT CONSOLE
RESULT = WIN32 CONSOLE
END
IF ARGC <= 1 OR ARGC > 3 OR
(ARGC = 2 AND ARGV(1)="/?") START
PRINTSTRING("Visual version of Edinburgh Compatible Context Editor (ECCE):
VECCE infile [outfile]
")
PRINTSTRING("
VECCE nul newfile to create newfile
VECCE oldfile nul view existing oldfile, don't modify
VECCE oldfile to modify existing oldfile
VECCE oldfile newfile read oldfile, edit into newfile
")
PRINTSTRING("
You can use NUL: or NULL: in place of nul (case not significant).
")
STOP
FINISH
IN_NAME = ARGV(1)
!*WIN32C* IN_NAME = "" %IF NULL(IN_NAME)
!*WIN32C* Can't have null string as file name
IF ARGC = 3 START
DEFAULT = 0
OUT_NAME = ARGV(2)
!*WIN32C* OUT_NAME = "" %IF NULL(OUT_NAME)
ELSE
DEFAULT = 1
OUT_NAME = IN_NAME
FINISH
!*WIN32C* %IF OUT_NAME = "" %START
{*WIN32C*} IF NULL(OUT_NAME) START
CONNECT INPUT(IN); !without extra
STOP IF IN_FLAG # 0
NEWLINES(2*25); !*WIN32C* CLEAR SCREEN
PRINT STRING("= Showing ".IN_NAME)
FINISH ELSE START
!*VAX* F = CHECKQUOTA(OUT_NAME)
!*VAX* -> ER %IF F&1 = 0
!*MOUSES* IN_FLAG = 20; !extra blocks
!*MOUSES* IN_FLAG = 100 %IF command_modifier = '!';
!*MOUSES* !*MOUSES* USE E <FILE>! FOR BIG BUFFER
IN_FLAG = 100
CONNECT INPUT(IN)
STOP IF IN_FLAG # 0
IF SEC_NAME # "" START
CONNECT INPUT(SEC)
STOP IF SEC_FLAG # 0
FINISH
OUT_TOP = IN_VMTOP; OUT_LIM = IN_LIM
NEWLINES(2*25); !*WIN32C* CLEAR SCREEN
!*WIN32C* %if in_name # "" %start
if not null(in_name) start {*WIN32C*}
print string("= Editing ".in_name)
if default = 0 start
print string(" to ")
print string(out_name)
finish
finish else start
print string("= Creating ".out_name)
finish
finish
!*WIN32C* newline
! edi(in,sec,out,termtype,24,80)
EDI(IN,SEC,OUT,TERMTYPE,25,79)
if default # 0 and out_flag = 0 start
print string(" File unchanged"); SPACES(79-15) {*WIN32C*}
newline
out_top = 0
!*MOUSES* DELETE FILE (PAGE FILE NAME)
finish
if out_top # 0 start
i = in_lim-in_top; move(i,in_top,out_lim)
out_lim = out_lim+i
!*MOUSES* STRING(ADDR(P_SACT)) = OUT_NAME
!*MOUSES* SVC (17,P); !PACK FILENAME
!*MOUSES*! %IF P_P2 = 0 %START; !FILE IN OWN DIR (NOT DEVICE)
!*MOUSES*! %WHILE OUT_LIM&511 # 0 %CYCLE;!SUBSYS STANDARD: LAST BLOCK EOT PADDED
!*MOUSES*! BYTEINTEGER(OUT_LIM) = 4; !ASCII EOT
!*MOUSES*! OUT_LIM = OUT_LIM+1
!*MOUSES*! %REPEAT
!*MOUSES*! !JUST TRUNCATE THE WORKFILE
!*MOUSES*! FLUSH BUFFERS; !MAKE DISC CONSISTENT
!*MOUSES*! EXTEND DA (PAGING FILE, (OUT_LIM-OUT_TOP)>>9 - P_P2, I)
!*MOUSES*! CLOSE DA (PAGING FILE)
!*MOUSES*! DELETE FILE (OUT_NAME)
!*MOUSES*! RENAME FILE (PAGE FILE NAME,OUT_NAME)
!*MOUSES*! %ELSE; !QUEUE (LP:) OR DEVICE (OUT:)
OPEN OUTPUT (3,OUT_NAME)
SELECT OUTPUT (3)
PRINT SYMBOL (BYTEINTEGER(I)) FOR I = OUT_TOP, 1, OUT_LIM-1
CLOSE OUTPUT
FINISH
!*MOUSES* CLOSE DA (PAGING FILE)
!*MOUSES* DELETE FILE (PAGE FILE NAME)
!*VAX* F = WRITEOUT(OUT_NAME,OUT_TOP,OUT_TOP,OUT_LIM,IN_VMLIM)
!*VAX* %IF F # 0 %START
!*VAX* ER: PRINT STRING(" *".SYSMESS(F).": ".OUT_NAME)
!*VAX* %FINISH
!*VAX* %FINISH %ELSE %START
!*VAX* DELETEVM(IN_VMTOP,IN_VMLIM)
!*MOUSES*! %FINISH
!*MOUSES* %FINISH %ELSE %START; !SHOWING
!*MOUSES* DELETE FILE (PAGE FILE NAME)
!*MOUSES* %FINISH
!*VAX* DELETEVM(SEC_VMTOP,SEC_VMLIM) %IF SEC_VMTOP # 0
!*MOUSES*!! P_P1 = 2; P_P2 = 10; P_P3 = OLD TT; !RESTORE TTY STATE FROM BEFORE EDIT
!*MOUSES*!! SVC (29,P)
ENDOFPROGRAM