!Version E6 introduces an 'unwind' facility. As the edit session proceeds, a
! note is taken of changes to the file, in as cryptic a manner as possible, in
! byte integer array un.
! The user can now give a command line in the format '->n', where n is a number
! (default 1. 0 and * have their usual meanings). The un array is then used
! to unwind (or 'undo') the editing by that number of command lines. The
! settings of other items by use of '%' commands are not saved and thus remain
! as they were when the '-' command was used. This includes the macros
! and the secondary input & output files.
! If the command is given as '-n', then the last n command lines which changed
! the file are unwound.
! Simple text formatting has been added, using basic command 'A' ('Adjust') in
! primary input mode, and %A to define parameters. 'A' in secondary input mode
! ('Abstract') is not affected.
! 'A' formats paragraphs. A paragraph is delimited by blank lines, or the
! start or end of the file. If the current position is within a paragraph when
! 'A' is obeyed, that paragraph is Adjusted. The current position is then
! moved to the next non-blank line, i.e. it traverses at least one blank line
! (the paragraph terminator), and possibly more. If the current position is on
! a blank line when 'A' is obeyed, it merely causes a move to the next
! non-blank line.
! What does 'A' do? If the first line of the paragraph starts in column one,
! then 'A' will line-fill the paragraph, using the third %A parameter ('line
! length'). If the first line of the paragraph starts with a space character,
! then the paragraph is line-filled as before, but with the first line indented
! by the second %A parameter ('paragraph indent'), and the WHOLE paragraph
! given a left margin of 'margin' spaces (the first %A parameter). Multiple
! spaces are preserved, except at the start of lines where any spaces are
! ignored (apart form the first line, where a space character has a special
! significance as described above).
! If a line FINISHES with a space then that line is not reformatted, except
! that initial spaces are replaced by 'margin' spaces, if applicable. This
! also applies to the first line of a paragraph, but it will not have
! 'paragraph indent' applied in this case. This facility is provided as a
! simple way of preventing tables etc. from being line-filled.
! The %A parameters are reported by >%A , and can be set by a command of the
! form >%A=a,b,c where a, b and c are integers. If any is omitted then the
! corresponding parameter retains its previous value. Thus the following
! inputs are all valid:
! Like the macros etc., the %A values can be saved in the
! profile by use of %P. Their default values are 0,0,80 .
! Note that the second parameter, 'paragraph indent', can be negative - this is
! useful for numbered or lettered lists where the first line sticks out to the
! left. The other values are set to 0 if given as negative.
! Some tidying up of the source has also been carried out: fp becomes cp (for
! 'current position') and tfp becomes fp. All comments are now in lower case.
! (August 1982)
!Version E5 causes Int: W, X and Y (and w, x and y) to be noted and the editing
! to be saved in file ECCE#BACKUP (see %B in version E4). These can occur when
! the System is still running but has become inaccessible due to a communicat-
! ions failure. In addition, a warning message is output if ECCE#BACKUP is
! found to exist at the start of the edit session.
! It is also now possible to call other commands while editing. The format
! is '! command parameters'. The parameters are deemed to start after
! the first '(' in the line, or after the first space if there is no '(' in
! the line. Spaces between '!' and the command verb are discarded.
! I have withdrawn the meaning of '!' on its own ('repeat indefinitely the
! previous command line') because it was never documented and now might be
! given inadvertently. Various checks are made on return from the command that
! none of the files used by ECCE has been tampered with. The edit is aborted
! if the work file has been changed, but this is unlikely to occur. Note that
! ECCE can be called. Appropriate warning messages are output if the other
! files have been altered.
! (August 1982)
!Version E4 introduces %B to copy the current state of the file to ECCE#BACKUP,
! F- to search backwards, %W (e.g.) to print out the current value of the
! W macro, and a message whenever a file is written to.
! (July 1982)
!Version E3 makes use of the profile facility, in which each user has his
! own profile (held in SS#PROFILE), which for ECCE specifies the initial
! values of %U/%L and %Q/%M/%F and the macros %W %X %Y %Z. The first time
! that a user calls version E3 of the program, he gets a message summarising
! the facility. The user can set up his profile at any time by using the new
! command %P. This stores the prevailing values of the above items.
! By this means it will be possible to combine the service version of ECCE, the
! E series (my own developments) and IMPMOD (a version of ECCE with predefined
! macros to assist in the translation of programs from IMP to IMP80).
! Edinner is a routine again. The rather elaborate noting of the earliest
! change has been discarded. The file is written back unless there have been
! no changes at all.
! (May 1982)
!Version E2 improves the file handling: the input file is not immediately
! copied to the workfile. Instead the pointers after the hole point at the
! input file. It cannot of course be changed, but if the user never
! changes the file, the hole never moves from the start and so the input
! file is never moved to the workfile. This represents quite a saving
! in page write-outs.
! In addition, edinner has been made a function. It returns the displacement
! from the start of the file of the first change to the file. This value
! can then be used in deciding how to produce the output file. If the
! output file is the input file, then (given certain conditions to ensure
! that the move is correct) it is possible to copy only the changed part,
! having connected the output file in write mode.
! (April 1982)
!Version E1 introduces W as a macro and predefines W, X, Y and Z (see code).
! The entry points are E, S, R.
! (April 1981)
! The following notes refer to service versions of ECCE (held in source form
! as ERCC63.PDECCE_HDEDITnS). The 'E' series (above) is derived from the
! versions below. The 'E' versions are held in ERCC63.PDE_EnS.
!Version 24 introduces ^....^ for text marking, and @ to reference last text
! marked. Thus i@ inserts last text marked, at current position.
!Version 23 corrects an error in d. Also enables '`' to be used as a delimiter.
!Version 22 corrects some errors in the moving of the hole.
!Version 21 has l and r in sin. Also the hole can be left behind - it is
! brought up to fp only when text is to be added or removed. tfp
! always points to the first character after the hole.
!Version 17 has c,%l,%u + %s=file,%o=file +pd members output + l,r in sin.
!Version 9 has %check removed.
!Version 7 includes recap.
!Version 6 allows invert in sin mode + %check.
!This version includes l (look).
!File based heavily on version 2.1 of EMAS 4/75 version of Hamish
!Dewar's compatible text editor.
! ECCE for EMAS: V 2.1 08/03/77
!!
systemroutinespec changefilesize(string (31) file,
integer newsize, integername flag)
externalroutinespec prompt(string (15) s)
systemroutinespec move(integer bytes, from, to)
conststring (1) snl="
"
systemroutinespec trim(string (31) s, integername flag)
systemroutinespec psysmes(integer root, flag)
recordformat finf(integer conad, filetype, datastart, dataend)
systemroutinespec connect(string (31) s integer a,m,p,
record (finf)name r integername f)
systemroutinespec outfile(string (31) s integer l,m,p,
integername c,f)
systemroutinespec newgen(string (31) s,t integername f)
systemroutinespec rename(string (31) s,t integername f)
systemroutinespec destroy(string (31) s, integername f)
systemintegermapspec comreg(integer i)
systemroutinespec setfname(string (40) name)
systemroutinespec sendfile(string (31) file,
string (16) dev, string (11) name,
integer copies, forms, integername flag)
systemroutinespec modpdfile(integer ep,
string (31) pdfile, string (11) memb,
string (31) infile, integername flag)
externalstringfnspec uinfs(integer type)
externalintegerfnspec uinfi(integer type)
externalintegerfnspec exist(string (31) filename)
externalroutinespec read profile(string (11) key,
name info,
integername version, flag)
externalroutinespec write profile(string (11) key,
name info,
integername version, flag)
routinespec connect input(string (255) file,
integername head, start, size, f)
routinespec makeupper(stringname s)
routinespec sendoutput(string (31) file, out, integername flag)
integerfnspec checkoutputfile(string (31) s)
integerfnspec check distinct(string (31) s, t)
endoflist
constbyteintegerarray upper(0 : 255) = c
0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,123,124,125,126,127,
128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,
144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,
160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,
208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
constbyteintegerarray lower(0 : 255) = c
0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,
112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,
128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,
144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,
160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,
208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,
224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,
240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
list
routine edinner(integername whead, wtop, wend, shead, stop, send, string (31) work, secinput)
! [wtop, wend) give the address range of the work file
! [stop, send] give the address range of the input file (by default the secondary file)
! On return, the edited file is given by [wtop,wend)+[stop,send].
constinteger p version=4; ! Version of profiling.
constinteger stopper=-5000; !Loop stop
constinteger hole min=256; !Minimum permissible hole size.
integer in disp; !Input file displacement (wrt workfile).
integername mon; !Monitor indic
integer print1, print2; !Print indics
integer cmax; !Command cell max
string (2) prom; !Command prompt
integer ci; !Command index
integer ti; !Text index
integer code; !Command code
integer snum; !Search limit number
integer codesnum; !Snum/code
integer text; !Text string pointer
integer num; !Repetition number
integer lenx; !Text length
integer len; !Text length (-1)
integer lend; !Line end (ad)
integer sin; !Secondary input ind
integername top, end, lbeg, pp, fp, cp; ! Pointer variables to current file.
integer mtop, mend, mlbeg, mpp, mfp, mcp; !Variables relating to main file.
integer slbeg, spp, sfp, scp; !Variables relating to secondary file.
integer ms; !Match start (ad)
integer ml; !Match limit (ad)
integer seconad; !Addr of secondary output
string (31) secoutput; !Secondary output file
string (9) outwork; !Secondary output workfile
record (finf) r
string (31) tempname
integer marker; !For note
integer cbase; !Command base (const ad)
integer tbase; !Text base (const ad)
integerarray cc(1 : 404); !Command sequence (4*101)
byteintegerarray tt(1 : 255); !Text strings
byteintegerarray attt(1:255); !For @ string.
integer atlend, ataddr, atlen, atbase
integer type, ctype, pend, chain; !Command input vars
integer i, j, cp0, cp1, sym, k, lim, flag, margin, cline, npp
integer showflag; ! = 192 if called from show
integername mask; !Case bit mask for %l and %u
integer range; !End pointer for text location
byteintegerarray copytext(1 : 80); !For case converted locate text
integer adcopytext; !Address of array
byteintegerarrayformat bform(0 : 255)
byteintegerarrayname convert
byteintegerarrayname stored; !Defs of w,x,y,z (4 * 128 bytes)
integer pos1, pos2, pos3, pos4; !Def pointers
integer stype, btype, mynl, dr0, dr1; !Assembler variables
integer accdr0, accdr1, assvar; !More assembler variables
integername amargin, apgap, aline
integer oldpp, oldfp, un0, up0, up1, up; ! Unwinding variables.
byteintegerarray un(0:4095); ! Unwind storage array.
string (50) command, parms
integer pvsn; !For profile handling
recordformat prof f(integer mon, mask, byteintegerarray stored(0:512),
integerarray adparm(1:3))
record (prof f) prof
systemroutinespec reroute contingency(integer ep, class, longinteger mask,
routine close(integer a,b), integername flag)
systemroutinespec signal(integer ep, class, subclass, integername flag)
!Symbol types:- 0:num, 1:termin, 2:illegal, 3:quote,
! 4:f, 5: d,t,u, 6: i,s,v, 8:m,e, 10: g,k
!Bits 2**7,6=11 indicates command valid only in sin mode
!Bits 2**7,6=01 indicates command valid in both modes
!Bits 2**7,6=00 indicates command valid only in primary input mode
!Bits 2**5,4 gives % command sub-codes
constbyteintegerarray symtype(33 : 95) = c
64, 3, 3, 3, 2, 3, 3,75,73,64, 3,76, 2, 3, 3,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 3, 3, 3,64,
3, 90,26,24, 5, 8,116,10, 2, 6,10,10,90,120,202,18,
90,50,74,22,69,21,70, 32,32,32,32, 3,74, 3, 78, 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 [ ¬ ] ^ _
! Workfile:
! |.............| (hole) |............................|
! ! ! ! ! !
! top pp fp cp (>=fp) end
routine readsym
!READ COMMAND SYMBOL
if pend # 0 then sym = pend and pend = 0 else start
while pos4 # 0 cycle ; !Macro expansion
sym = stored(pos4)
pos4 = pos4+1
if sym # nl then return
pos4 = pos3; pos3 = pos2; pos2 = pos1; pos1 = 0
repeat
readch(sym)
finish
end
routine read item
cycle
type = 1
read sym until sym # ' '
if sym < ' ' then return ; !Treat any control as nl
sym = upper(sym); !Ensure upper case
if sym>=96 then type = symtype(sym-32) c
else type = symtype(sym)
if type&15 # 0 then return ; !Return unless numeric or w,x,y,z
if type # 32 then exit ; !W,x,y,z macro calls
pos1 = pos2; pos2 = pos3; pos3 = pos4
pos4 = (sym-'W')<<7+1
repeat
if type=0 start ; !Decimal digit
num = sym-'0'
cycle
read sym
exit unless '0' <= sym <= '9'
num = 10*num+sym-'0'
repeat
pend = sym
finish else start
type = 0; num = 0
num = stopper+1 if sym = '?'
num = stopper if sym = '!'
finish
end
routine iwrite(integer a)
if a<0 then printch('-') and a = -a
iwrite(a//10) if a>=10
printch('0'+a-a//10*10)
end ; ! iwrite.
routine print line
constinteger marker = '^'
integer p
print1 = lend; print2 = pp+cp
p = lbeg
p = fp if p = pp
while p # lend cycle
printch(byteinteger(p))
p = p+1
p = fp if p = pp
printch(marker) if num = 1 and p = cp
repeat
printstring("**end**") if p > end
printch(nl)
end
routine find lbeg
lbeg = cp+1
lbeg = lbeg-1 until lbeg=fp or byteinteger(lbeg-1)=nl
if lbeg=fp start
lbeg = pp+1
lbeg = lbeg-1 until lbeg=top or byteinteger(lbeg-1)=nl
finish
end ; ! Of %routine find lbeg.
routine find lend(integername err)
integer j
! lend = fp
! -> ok %if fp > fend %or byteinteger(fp) = nl
! %until byteinteger(lend) = nl %cycle
! lend = lend+1
! %repeat
!*m* mcode locate line end
!Increase lend until it points to nl
err = 0
lend = cp
return if cp > end or byteinteger(cp) = nl
j = end-lend+1
*ldtb_stype
*ldb_j
*lda_lend; !Search from lend
*lb_mynl; !Load B reg with nl
*put_x'A300'; !SWNE
*jcc_8,<abdn>; !Not found ->
*std_dr0; !Store descriptor
lend = dr1; !Set result
!*e* locate
return
abdn:
err = 1
end ; ! Of %routine find lend.
routine unchain
l1: text = chain
if text # 0 start
chain = integer(text+4)
integer(text+4) = ci
-> l1 if integer(text) # 'X'
finish
end
routine switch to secondary file
top == stop; end == send
lbeg == slbeg
pp == spp; fp == sfp; cp == scp
end ; ! of switch to secondary file.
routine switch to main file
top == mtop; end == mend
lbeg == mlbeg
pp == mpp; fp == mfp; cp == mcp
end ; ! of switch to main file.
routine switch modes
if sin = 0 start ; ! Switch to secondary mode
switch to secondary file
sin = -1; prom = ">>"
finish else start
switch to main file
sin = 0; prom = ">"
finish
end ; ! Of %routine switch modes.
! The following routines are used in the storage of the editing, and in
! 'unwinding' the editing when the user requests it.
routine un val(integer value, byteinteger type)
! Stores a value and a type of change in the un array. Also updates
! the pointer up.
! Format in array un is [ [text] [padding] value type ] ...
! The padding is to ensure that value (a 4-byte integer) is always
! word aligned. It follows that type (a byte integer) is also word
! aligned, and that text, if present, starts one byte after a word
! boundary.
integer p
return if byteinteger(un0+up&4095)=type#255; ! Same as last one - ignore.
up = up+8
integer(un0+(up-4)&4095) = value
byteinteger(un0+up&4095) = type
return unless type=255; ! Start of command line.
! See if record of command line just completed has overwritten itself or
! overwritten the start of the editing record. We have:
! up0 < up1 <= up
! where up0&4095 points to the start of the editing record
! up1&4095 points to the start of the command line record
! up0&4095 points to the last type stored
if up-up1>4096-8 start
! Command line has overwritten itself.
! Correct pointers (none of the editing can be saved)
up0 = up-8
integer(un0+(up0-4)&4095) = 0
byteinteger(un0+up0&4095) = 0
finish else if up-up0>4096-8 start
! Start of editing record overwritten. Throw away early command lines.
cycle
p = up0+12
p = p+4 while 247#byteinteger(un0+p&4095)#255
! Here we are scanning for a "start of command line" code.
! In so doing we are scanning what could be stored text, but
! the byte patterns being sought do not correspond to printable
! symbols, so should not prove a problem. This might not be
! true if the technique were applied to non-printable material.
up0 = p-8; ! New record start position (possibly).
repeat until up-up0<=4096-8
integer(un0+(up0-4)&4095) = 0
byteinteger(un0+up0&4095) = 0
finish
up0 = up0&4095; up = up&4095
up = up+4096 if up<up0
up1 = up; ! Points to start of new command line
! Now look for previous command line in array. If no
! changes have occurred to the file between the two then mark
! the earlier one as not a stopping point.
p = up-8
p = p-8 while byteinteger(un0+p&4095)=6; ! Hole movement - does not change file.
byteinteger(un0+p&4095) = 247 if byteinteger(un0+p&4095)=255
end ; ! Of %routine un val.
routine un text(integer from, to, save, byteinteger type)
integer textp, size, i
size = to-from
textp = up+1; ! Pointer to text position.
up = ((textp+size+3)>>2)<<2+4
textp = textp&4095
while size#0 cycle
i = 4096-textp; ! Space to end of un array.
i = size if i>size
move(i, from, un0+textp)
textp = (textp+i)&4095
size = size-i
from = from+i
repeat
integer(un0+(up-4)&4095) = save
byteinteger(un0+up&4095) = type
end ; ! Of %routine untext.
routine update un pointers
! Note: only called when in primary mode.
if pp#oldpp start
if pp<oldpp then un text(pp, oldpp, oldpp, 2) else un val(oldpp, 3)
oldpp = pp
finish
if fp#oldfp+in disp start
if fp>oldfp+in disp then un text(oldfp+in disp, fp, oldfp, 4) c
else un val(oldfp, 5)
oldfp = fp-in disp
finish
end ; ! Of %routine update un pointers.
routine mark command line
update un pointers
unval(cp-in disp, 255)
end ; ! Of %routine mark command line.
routine reval(integer change)
! Restores stored file changes (held in array un).
! If change=0, then reaching the start of any command line causes reval to terminate.
! If change#0, then only file-changing command lines cause termination.
! Type settings:
! 0 - start of recording (should not occur here)
! 1 - unused
! 2 - pp change with text between two positions
! 3 - pp change
! 4 - fp change with text between two positions
! 5 - fp change
! 6 - pp (for hole movement)
! 247 - cp change (does not terminate reval)
! 255 - cp change (terminates reval)
byteinteger type
integer val, to, size, textp, i
switch sw(0:7)
cycle
type = byteinteger(un0+up)
up = (up-4)&4095
val = integer(un0+up)
->sw(type&7)
sw(7):
cp = val+in disp
up = (up-4)&4095
exit if change=0 or type=255
continue
sw(3):
pp = val
up = (up-4)&4095
continue
sw(5):
fp = val+in disp
up = (up-4)&4095
continue
sw(2): ! pp with text (pp<val)
size = val-pp; to = pp; pp = val
->copy text
sw(4): ! fp with text (val<fp)
val = val+in disp
size = fp-val; to = val; fp = val
copy text:
up = (((up-size-1)>>2)<<2)&4095
textp = up+1
while size#0 cycle
i = 4096-textp
i = size if i>size
move(i,un0+textp,to) if wtop<=to<=wend+1
textp = (textp+i)&4095
to = to+i
size = size-i
repeat
continue
sw(6): ! move the hole so that pp becomes val.
if val<pp start
size = pp-val
fp = fp-size; pp = pp-size
move(size, pp, fp+in disp) if wtop<=fp+in disp<=wend+1
finishelsestart
size = val-pp
move(size, fp+in disp, pp)
fp = fp+size; pp = pp+size
finish
up = (up-4)&4095
continue
sw(1): ! Unused.
printstring("**unwinding record corrupt - edit abandoned.".snl)
monitor ; stop
sw(0): ! Start of editing record.
up = (up+4)&4095
exit
repeat
end ; ! Of %routine rval.
routine unwind editing(integer change)
! num (global variable) is the number of command lines to be unwound,
! if possible. This corresponds to the number of cp settings to be
! obeyed in array un.
! If change=0, then reaching the start of any command line causes rval to terminate.
! If change#0, then only file-changing command lines cause termination of rval.
mark command line; up = (up-8)&4095
print1 = 0; ! So that current line will be printed out.
cycle
reval(change); ! Rewinds editing back to the start of a command line.
if byteinteger(un0+up)=0 start ; ! Start of recording.
printstring("**start of editing record**".snl)
exit
finish
num = num-1
repeat until num=0
oldpp = pp
oldfp = fp-in disp
find lbeg
end ; ! Of %routine unwind editing.
! End of routines relating to unwinding of editing.
routine move hole
integer j
update un pointers
atlend=0; print2 = 0
j = cp-fp
returnif j=0
lbeg = lbeg-(fp-pp) if fp<=lbeg<=cp; !Assumes that hole is moving to current line
move(j,fp,pp)
un val(pp, 6); ! Note movement of hole.
pp = pp+j
fp = cp
oldpp = pp; oldfp = fp-in disp
end ; !Move hole.
routine transfer input
! Transfers remainder of input file to work file.
integer i, j
j = mend+1-fp; ! Amount to move.
i = wend-(mend-fp); ! Destination.
move(j,fp,i)
j = cp-fp
fp = i
in disp = 0; ! Used by unwinding code.
print2 = -1 if print2=pp+cp
cp = fp+j unless wtop<=cp<=wend+1
print2 = pp+cp if print2=-1
lbeg = lbeg+wend-mend unless wtop<=lbeg<=wend+1
! i.e. unless already referring to work file.
print1 = -1 if print1=lend
lend = lend+wend-mend unless wtop<=lend<=wend+1
print1 = lend if print1=-1
mend = wend
end ; ! Of %routine transfer input.
routine fail save(integer class, subclass)
! Called after W, X or Y interrupt (uc or lc). Writes editing to ECCE#BACKUP.
integer conad, flag, i
reroute contingency(0, 0, 0, failsave, flag)
! Now write to file.
i = mpp-mtop + mend-mfp+1 + 32; ! 32 for file header.
destroy("ECCE#BACKUP", flag)
outfile("ECCE#BACKUP", -i, i, 0, conad, flag)
if flag=0 start ; ! OK
integer(conad) = i; ! Set file size in header.
integer(conad+12) = 3; ! Character file.
i = conad+32
move(mpp-mtop,mtop,i); ! Part before hole.
i = i+mpp-mtop
move(mend-mfp+1,mfp,i); ! Part after hole.
finish
signal(3, class, subclass, flag)
end ; ! Of %routine fail save.
integerfn verify file(string (31) file, integer conad)
record (finf) r
integer flag
result = 0 if file="" or conad=0
connect(file, 0, 0, 0, r, flag)
result = 0 if flag=0 and r_conad=conad
result = 1
end ; ! Of %integerfn verify file.
routine call(string (31) command, string (255) param, integer name flag)
system routine spec enter(integer mode,dr0,dr1, string (255) param)
system routine spec findentry(string (31) entry, integer type,dad,
string name file, integer name dr0,dr1,flag)
system routine spec load(string (31) name, integer type, integer name flag)
system routine spec unload(integer curgla)
system long integer fn spec loadep(string (31) entry, integername type,
flag, integer load level)
system integer fn spec currentll
system routine spec unload2(integer ll, failstate)
integer savecomreg44,dr0,dr1,type,ll,status
longinteger desc
string (1) dummys
savecomreg44 = comreg(44)
if uinfi(26)=0 start ; ! Old loader.
load(command,0,flag)
->err if flag#0
findentry(command,0,0,dummys,dr0,dr1,flag)
->err if flag#0
enter(2,dr0,dr1,param)
unload(savecomreg44)
finishelsestart ; ! New loader.
ll = currentll
type = 2; ! Code type being sought.
desc = loadep(command, type, flag, ll)
if flag=0 start ; ! Successfully loaded.
! desc contains descriptor.
dr0 = desc>>32
dr1 = desc&x'000ffffffff'
enter(2,dr0,dr1,param)
status = 0
finishelse status=1
unload2(ll,status)
finish
err:
psysmes(73+showflag//192,flag) if flag#0
end ; ! of call
switch vsn(0:p version)
switch c(0 : 14)
switch s('@' : '¬')
switch pc('A' : 'U'); !For independent % commands
comreg(24) = 0; !Set return code
stype = x'58000000'; !String descriptor
btype = x'18000000'; !Byte descriptor
mynl = 10; !Newline
amargin == prof_adparm(1)
apgap == prof_adparm(2)
aline == prof_adparm(3)
mon == prof_mon
mask == prof_mask
stored == prof_stored
! Now read profile info for this user.
read profile("ECCE", prof, pvsn, i)
pvsn = p version if pvsn>p version
-> vsn(pvsn)
vsn(0): ! No profile info stored. Set it up with basic defaults.
vsn(1):
vsn(2):
mon = 0
mask = 32
string(addr(stored(0))) = snl
string(addr(stored(128))) = snl
string(addr(stored(256))) = snl
string(addr(stored(384))) = snl
if i>4 start
printstring("Profile file cannot be accessed. Default options assumed.".snl)
finish
vsn(3):
printstring("**Additional facilities in this version of ECCE. Please
VIEW(SUBSYS.NEWECCE) for details.".snl)
amargin = 0
apgap = 0
aline = 80
vsn(4):
pvsn = pversion and write profile("ECCE",prof,pvsn,i) if pvsn#p version
! End of profile reading and analysis.
if mask = 0 then convert == array(addr(lower(0)), bform) else c
convert == array(addr(upper(0)), bform)
print1 = 0; print2 = 0
cmax = 0; ms = 0; ml = 0
pos1 = 0; pos2 = 0; pos3 = 0; pos4 = 0
tempname = ""
marker = 0
secoutput = ""; outwork = ""
num = 0
adcopytext = addr(copytext(1))
seconad = 0
tbase = addr(tt(1)); cbase = addr(cc(1))
atbase = addr(attt(1))
attt(1) = 0; atlen = -1
atlend = 0
! On entry stop and send point to the primary input file. Thus, a) the
! primary input file is by default the secondary input file also, and
! b) we use stop and send when assigning 'm' variables to the right of the hole.
mtop = wtop; ! mtop never changes from this value (separate vars strictly unnecessary).
mend = send; ! Initially, "main" pointers to right of hole refer to input.
mlbeg = mtop
mpp = mtop
mfp = stop
mcp = mfp
slbeg = stop
spp = stop
sfp = stop
scp = sfp
! The 'm' variables refer to the main input - initially a combination of
! the work file and the input file.
! The 's' variables refer to the secondary input - by default the input
! file.
switch to main file; ! This points top, lbeg, pp, etc at the 'm' variables.
! 'Unwinding' variables.
un0 = addr(un(0)); integer(un0) = 0
up0 = 4; un(up0) = 0; up1 = up0; up = up0
in disp = send-wend; ! Displacement of input file wrt work file. Used in unwinding.
oldpp = pp
oldfp = fp-in disp; ! oldfp is the last value fp would have had in the workfile.
if mtop=stop then sin = -1 and showflag = 192 else start
! When edinner is called from show, the 'main' variables and the 'secondary'
! variables have the same values - the input file is the 'main' file and
! the 'secondary' file.
sin = 0
showflag = 0
if exist("ECCE#BACKUP")#0 start
printstring(c
"**Warning: When you last used ECCE, a copy of your edited file was made, either
when you gave the command %B to ECCE or when the System went down.
This is called ECCE#BACKUP. It will be destroyed if you leave ECCE".snl)
printstring(c
" by typing %C. If you want to keep it either leave ECCE now by
using Int:A, and rename it before using ECCE again, or rename it
without leaving ECCE by typing:".snl.snl)
printstring(c
" >!RENAME ECCE#BACKUP,newname
where newname is not the name of one of your current files.".snl)
finish
reroute contingency(3, 65, X'700000007'<<('W'-64), failsave, i)
! This causes Int: W, X or Y (or w, x or y) to be trapped.
finish
sym = nextch; ! Force out initial prompt.
skipsymbol if sym=nl
prom = ">"
!Find end of current line
set:
lend = cp
lend = lend+1 while lend < end and byteinteger(lend) # nl
! lend now either points to nl at end of current line, or to eof.
!Monitor current line
c0:
-> c1 if sym # nl
-> c1 unless (mon >= 0 and print1 # lend) or (mon > 0 c
and print2 # pp+cp)
num = 1; print line
!Read command line
c1:
prompt(prom)
ci = cbase; ti = tbase; pend = 0; chain = 0
read item until type # 1; !(ignore nls)
if type = 0 start ; ! Repetition or ! command.
if sym='!' start ; ! Subsystem command (probably).
parms = uinfs(1); ->erq if charno(parms,4)='U'; ! No students!!
! First read command line
command = ""
readsym until sym#' '
for i = 1,1,50 cycle
exit if sym=nl
command = command.tostring(sym)
readsym
repeat
->c1 if command=""; ! Ignore.
unless command -> ("(") start
command = command."(".parms if command -> command.(" ").parms
finish
command = command.parms while command -> command.(" ").parms
! Now command contains a '(' character before the parameters, if any.
parms = ")" unless command -> command.("(").parms
length(parms) = length(parms)-1 if charno(parms,length(parms))=')'
make upper(command); make upper(parms)
for i = 1,1,length(command) cycle
j = charno(command, i)
->erq unless 'A'<=j<='Z' or (i>1 and '0'<=j<='9')
repeat
if showflag=0 start
if sin=-1 then j = 1 and switch modes else j = 0
transfer input unless wtop<=fp<=wend+1; ! To avoid problems with input file.
switch modes and find lend(j) if j=1
finish
i = integer(whead+20); ! Date last connected in write mode.
call(command,parms,flag)
->c1 if flag#0; ! Failure, so no problem with files.
flag = verify file(work, whead); ! Workfile.
if flag#0 or integer(whead+20)#i start
printstring("**ECCE workfile changed or destroyed - edit abandoned.".snl) if showflag#192
printstring("**File ".work." changed or destroyed - show abandoned.".snl) if showflag=192
stop
finish
flag = verify file(secinput, shead) unless stop=0
if flag#0 start
printstring("**Warning: %S undefined - redefine if wanted.".snl)
stop = 0; send = -1
scp = stop; slbeg = stop
spp = stop; sfp = stop
flag = 0
finish
flag = verify file(outwork, seconad)
if flag#0 start
printstring("**Warning: %O workfile corrupted. Redefine %O before use.".snl)
seconad = 0
finish
->c1
finish ; ! End of !Command code.
->er2 if cmax=0
integer(cmax+8) = num
read item; -> er1 if type # 1
-> go
finish
if sym = '%' start
read sym
sym = upper(sym)
code = sym
-> er5 if code < 'A'
ctype = symtype(code)>>4&3
-> c(ctype)
finish
if sym='-' start ; ! Undo some editing.
->er2 if sin#0; ! Only allowed in primary input mode.
read item
if sym='>' then i = 0 and read item else i = 1
if type=0 then read item else num = 1; ! Number read (assigned to num).
->er2 unless type=1; ! Should be a separator.
! Thus ->3 causes last 3 command lines to be unwound,
! and -3 causes last 3 'changing' command lines to be unwound.
unwind editing(i)
->set
finish
c2:
ctype = type&15; -> er2 if ctype < 4
-> er0 if (¬sin!!type)&192 = 0
! 192= 2**6 + 2**7. SEE COMMENTS ABOVE SYMTYPE DECLARATION.
! SIN= 0 IF IN PRIMARY INPUT
! =-1 IF IN SECONDARY INPUT
code = sym; !Command letter
text = 0; num = 1; len = 0; !Default values
read item; ! next item known
-> c(ctype)
c(4): !find
if sym='-' start ; ! F-
code = 'Q'
read item
finish
num = 0 unless type = 0; ! Default search range for f or f- is whole file.
c(5): !+del,trav,uncover
code = num<<7+code; num = 1
read item if type = 0
c(6): !+insert,subst,verify
-> er4 if type # 3
if sym='@' start
text = atbase
len = atlen
-> c81
finish
text = ti
i = sym
cycle
read sym
exit if sym = i
if sym = nl then pend = nl and exit
-> er6 if ti-tbase = 255
byteinteger(ti) = sym; ti = ti+1
repeat
len = ti-text-1; !length - 1
-> c81
c(8): !move, erase, case
-> c90 unless sym = '-'
if code = 'C' then code = 'H' else code = code+10
! 'c' to 'h', 'e' to 'o', 'm' to 'w'.
c81:
read item
-> c91
c(9): !Close bracket
unchain; -> er3 if text = 0
! unchain makes text point at the corresponding open bracket
! and gives ',' and '(' the address of this ')' instruction.
code = 'Z'; integer(text+8) = num
c(10): !get, kill, n, a, etc.
c90:
-> er1 if type = 3; ! No text string permitted.
c91:
read item if type = 0
-> put
c(14): ! ^ (@ string marker).
code = '@'
-> put; ! no repetition allowed.
c(11): !open bracket
code = 'X'
-> c95
c(12): !comma
code = 'Y'
read item if type = 1; !Ignore following nl
c95:
! Chain set to current command address and later integer(ci+4) set to text -
! the previous chain value. (ci+4) is set to the corresponding ')' instruction
! address (by unchain).
text = chain; chain = ci
num = 0
put:
integer(ci) = code; integer(ci+4) = text
integer(ci+8) = num; integer(ci+12) = len
ci = ci+16; -> er6 if ci-cbase > 1600
-> c2 unless type = 1
unchain; -> er3 if text # 0
cmax = ci
integer(ci) = 'Z'; integer(ci+4) = cbase-16; ! "Global" brackets.
integer(ci+8) = 1; integer(ci+12) = 0
-> go
er0:
if showflag = 0 then printstring("Secondary input") c
else printstring("Show")
-> er2
er1:
printch(' ')
printch(code)
er2:
code = sym
-> er5
er3:
printstring("Brackets")
-> erq
er4:
printstring("Text for")
c(0):
er5:
printch(' ')
printch('F') and code = '-' if code&127='Q'
printch(code&127)
-> erq
er6:
printstring("Size")
erq:
printch('?')
printch(nl)
er7:
cmax = 0 if ci # cbase
sym = pend if pend # 0
skp:
-> c1 if sym = nl; read sym
-> skp
!Execute command line
go:
mark command line if sin=0; ! For unwinding
ci = cbase-16
get:
ci = ci+16
codesnum = integer(ci); text = integer(ci+4)
num = integer(ci+8); len = integer(ci+12)
code = codesnum&127
-> s(code)
lok:
find lend(i)
-> abdn if i#0
ok:
num = num-1
-> get if num = 0 or num = stopper
-> s(code)
s(92): !invert
no:
-> get if num <= 0
ci = ci+16
-> get if integer(ci) = 92; ! I.e. if next code is inversion.
while integer(ci)&127 <= 'X' cycle ;! Skipping for ',' ')' or '¬'
ci = integer(ci+4) if integer(ci) = 'X'; ! Skip past corresponding ')' if a '('
ci = ci+16
repeat
num = integer(ci+8)
-> no unless ci = cmax; ! Test for inversion or keep skipping if not the end of the command string
-> c0 if num <= 0
! Failure does not matter in this case. Or could be alternative execution (comma).
!Execution error
printstring("Failure: ")
if code='O' or code='W' or code='H' or code='Q' start
if code='H' then code = 'C' else if code='Q' then c
code = 'F' else code = code-10
printch(code); code = '-'
finish
printch(code)
if text # 0 start
printch('''')
while len >= 0 cycle
printch(byteinteger(text))
text = text+1; len = len-1
repeat
printch('''')
finish
printch(nl)
print1 = 0
read ch(sym) while sym # nl; ! Throw away other command strings on current line
-> c0
!Individual commands
s('X'): !open bracket
integer(text+8) = num; ! Sets the repetition count at the corresponding close bracket
-> get
s('Z'): !Close bracket
num = num-1
if num = 0 or num = stopper start
-> get unless ci = cmax
-> c0
finish
integer(ci+8) = num
ci = text
-> get
s('Y'): !comma
ci = text-16
-> get
s('R'): !right-shift
if num<=0 then cp = lend else cp = cp+num
cp = lend and ->no if cp>lend
-> get
s('L'): !left-shift
-> no if lbeg=cp or (fp=cp and lbeg=pp)
if cp = fp start
transfer input unless wtop<=fp<=wend+1 and sin=0
fp = fp-1; pp = pp-1
byteinteger(fp) = byteinteger(pp)
finishelsestart
cp = lbeg+1 and num = 1 if num=0 and fp<=lbeg<cp
finish
cp = cp-1
ms = 0
-> ok
s('@'): ! @ string marker.
if atlend # lend start ; !New string being marked.
ataddr=cp
atlend=lend
finishelsestart ; !Second marker - string now defined.
atlend=0
i=cp-ataddr
if i>0 then j=ataddr else j=cp and i=-i
code='^' and -> no if i>255; ! String too long.
atlen=i-1
k=j+i
i=0
while j<k cycle
byteinteger(atbase+i) = byteinteger(j)
i=i+1; j=j+1
repeat
! Now scan command string array for @ references.
j = cbase
while j<cmax cycle
integer(j+12)=atlen if integer(j+4)=atbase
j=j+16
repeat
finish
-> ok
s('E'): !erase
move hole
if num<=0 then cp = lend elsestart
cp = cp+num
cp = lend and fp = cp and ->no if cp>lend
finish
fp = cp
-> get
s('O'): !erase back
move hole
pp = lbeg and -> get if num<=0
pp = pp-num
-> get if pp>=lbeg
pp = lbeg; -> no
s('C'): !case invert
move hole
cycle
exit if cp=lend
if 'A'<=byteinteger(cp)&x'DF'<='Z' then c
byteinteger(pp) = byteinteger(cp)!!32 else c
byteinteger(pp) = byteinteger(cp)
pp = pp+1; fp = fp+1; cp = cp+1
num = num-1
repeat until num=0 or num=stopper
->no
s('H'): !case invert backwards
transfer input unless wtop<=fp<=wend+1
move hole
cycle
exit if pp=lbeg
cp = cp-1; fp = fp-1; pp = pp-1
if 'A' <= byteinteger(pp)&x'DF' <= 'Z' then c
byteinteger(cp) = byteinteger(pp)!!32 else c
byteinteger(cp) = byteinteger(pp)
num = num-1
repeat until num=0 or num=stopper
ms = 0
-> no
s('V'): !verify
!*i* verify
i = cp; k = cp+len+1
j = text
while i<k and convert(byteinteger(i))=convert(byteinteger(j)) cycle
i = i+1; j = j+1
repeat
->no if i<k
ms = cp
ml = i
-> get; !No repetition count on v
s('D'): !delete
s('T'): !traverse
j = 0
-> f0
s('U'): !uncover
move hole
s('F'): !find
j = ms
!* TEXT LOCATION
!* NOTES:
!* ms: address of string just located
!* ml: address of byte after located string
!* j: saved value of ms, or 0 to show that ms does not apply
!* cp0: saved value of cp
!* cp1: cp0, or last nl before current cp
f0: !Save values, and find range of search
ms = cp and ml = cp and -> ok if len<0
snum = codesnum>>7; !Line range count
k = mask<<8!byteinteger(text); !First char case masked
cp1 = cp; !Last nl before cp
cp0 = cp; !Save cp
cp = cp+1 if cp = j; !Dont find same twice
dr1 = end+1; !In case of unlimited search
i = cp
while snum > 0 and i <= end cycle ; !Count nls to get range of search
j = end-i+1; !Limit of search for nls
*ldtb_stype
*ldb_j; !Length
*lda_i; !Start
*lb_mynl; !Find nl
*swne_l =dr
*jcc_8,<abdn>; !Fatal error
*std_dr0
i = dr1+1; !nl found
snum = snum-1; !Decrement count
repeat
range = dr1-1
!* Convert text to upper case?
lenx = len+1; !Text length
if mask > 0 then start ; !Convert required
*ldtb_btype; !First move it
*ldb_lenx; !Length
*lda_text; !From
*cyd_0
*lda_adcopytext; !To
*mv_l =dr
dr0 = x'58000000'!LENX; !Now convert
dr1 = adcopytext
accdr0 = x'18000100'
accdr1 = addr(convert(0))
*ld_dr0
*lsd_accdr0
*ttr_l =dr
text = adcopytext
finish
until cp > range cycle ; !Find first char
i = range-cp-lenx+2; !Length of search
if i > 0 then start
assvar = cp
*ldtb_stype
*ldb_i; !Length
*lda_assvar; !Start
*lb_k; !Required char
*swne_l =dr
*jcc_4,<f83>; !Found ->
finish
cp = range+1; !Set to bottom
exit
f83: !Char found: now compare with text
*std_dr0; !Store desc
cp = dr1
cycle i = 0,1,len
if byteinteger(text+i) # convert(byteinteger(cp+i)) c
then -> f85
repeat
exit
f85: ! match fails
cp = cp+1
repeat
!* Search complete
i = cp+lenx; !Match end pointer
cp1 = cp; !Reset cp1
cp1 = cp1-1 while cp1 # cp0 and byteinteger(cp1-1) # nl
if cp > range start ; !Failure in complete range
lend = cp
cp = cp1
if code = 'U' start
fp = cp
lbeg = pp if cp1 > end
finish else start
lbeg = cp1 if cp1 # cp0
finish
-> no
finish
!* Match successful - reset pointers
ms = cp
ml = i
lbeg = cp1 if cp1 # cp0 and code # 'U'
move hole if code = 'D'
cp = ml if code = 'T' or code = 'D'
fp = cp if code = 'U' or code = 'D'
-> ok if cp1 = cp0
-> lok
s('S'): !substitute
-> no if cp # ms
move hole
cp = ml; fp = ml
s('I'): !+insert
-> ok if len < 0
move hole
-> no if pp-lbeg > 160 or cp > end
!*m* insert
assvar = pp
lenx = len+1
*ldtb_btype
*ldb_lenx
*lda_text; !From
*cyd_0
*lda_assvar; !To
*put_x'B300'; !Move
pp = pp+lenx
!*e*
i1:
-> ok unless pp<=cp<=pp+hole min
-> abdn
s('Q'): !find-
ms = cp and ml = cp and ->ok if len<0
cp1 = cp
snum = codesnum>>7; ! No of newlines max to traverse.
k = convert(byteinteger(text)); ! First byte of string.
lim = fp; ! cp must be >= lim.
cycle ; ! scans back from current position.
cp = cp-1
if cp<lim start
i = 0 and exit if lim=top; ! Failure.
lim = top; cp = pp
continue
finish
j = convert(byteinteger(cp))
if j=nl start
snum = snum-1
i = 0 and exit if snum=0; ! Out of range - failure.
cp1 = cp; ! Marks the latest nl encountered.
finishelseif j=k start ; ! Found first char of string.
cp0 = cp; i = 1
for j=1,1,len cycle
cp = cp+1; cp = fp if cp=pp
i = 0 and exit unless convert(byteinteger(text+j)) = c
convert(byteinteger(cp))
repeat
exit if i = 1; ! Text found.
cp = cp0; ! Failure - reset cp.
finish
repeat
! Move hole and reset pointers as necessary.
if i=1 start ; ! Success.
cp = cp0; ! Start of located string
if byteinteger(cp1)=nl and cp1#lend start ; ! Moved to an earlier line.
lend = cp1
! Find lbeg
j = cp
cycle
j = pp if j=fp
lbeg = j
j = j-1
repeat until lbeg=top or byteinteger(j)=nl
finish
finishelsestart ; ! Failure.
if byteinteger(cp1)=nl and cp1#lend start
cp = cp+1; lbeg = cp; lend = cp1
finishelse cp = cp1; ! Same line - pointer does not change.
finish
! Now move text around as necessary.
unless fp<=cp<=end+1 start ; ! Need to move hole.
transfer input unless wtop<=fp<=wend+1; ! Can only be primary file here.
j = pp-cp
un val(pp, 6); ! Flag hole movement for unwinding.
pp = pp-j; fp = fp-j
cp = fp
move(j,pp,fp)
oldpp = pp
oldfp = fp-in disp
lend = lend+cp-pp if lend<cp
finish
if i=1 start ; ! Success
ms = cp; ml = cp+len+1
->ok
finish
ms = 0
->no
s('G'): !get (line from tt)
cp = lbeg if fp<lbeg<cp
move hole
prompt(":")
read ch(k)
-> no if k = ':'
transfer input unless wtop<=fp<=wend+1 or pp=lbeg
while pp # lbeg cycle
fp = fp-1; cp = cp-1; pp = pp-1
byteinteger(cp) = byteinteger(pp)
repeat
while k # nl cycle
byteinteger(pp) = k; pp = pp+1
read ch(k)
repeat
s('B'): !+break
move hole
byteinteger(pp) = nl; pp = pp+1
lbeg = pp
-> i1
s('P'): !print
print line
-> ok if num = 1
s('M'): !move
-> no if cp > end
lend = end and num = 1 if num = 0 and code = 'M'; ! M*
cp = lend+1
lbeg = cp
-> lok
s('K'): !kill
->no if cp>end
move hole
pp = lbeg
! Move current position to start of appropriate line, and delete
! all lines traversed.
if num=1 then num=0 and cp = lend+1 else c
if num<=0 then cp = end+1 elsestart
i = cp
while num>0 and i<=end cycle
j = end-i+1; !Limit of search for nls
*ldtb_stype
*ldb_j; !Length
*lda_i; !Start
*lb_mynl; !Find nl
*swne_l =dr
*jcc_8,<abdn>; !Fatal error
*std_dr0
i = dr1+1; !nl found
num = num-1; !Decrement count
repeat
cp = i
finish
fp = cp
num = 1 and ->lok unless cp>end
! Failure here if num>0
lend = cp
->no
s('J'): !join
-> no if lend >= end
cp = lend
move hole
-> no if pp-lbeg > 120
cp = lend+1; fp = cp
-> lok
s('W'): !move back
ms = 0
!*i* move back
-> no if lbeg = top
print1 = 0
if num = 0 start ; !m-*
num = 1
lbeg = top+1
cp = fp
finish else if fp<lbeg<=cp start
! Start of current line is to right of hole.
! Note that lbeg is never equal to fp.
lend = lbeg-1
lbeg = lbeg-1 until lbeg = fp or byteinteger(lbeg-1) = nl
cp = lbeg
-> ok unless lbeg = fp
! If lbeg=fp then start of previous line is to left of hole (or =pp).
! Note that cp=fp here.
lbeg = pp+1
finish else cp = fp
lbeg = lbeg-1 until lbeg = top or byteinteger(lbeg-1) = nl
if pp>lbeg start ; ! Note: can only be in primary file.
transfer input unless in disp=0
update un pointers
j = pp-lbeg
un val(pp, 6); ! Flag hole movement for unwinding.
pp = pp-j
cp = cp-j
fp = cp
move(j,pp,cp)
oldpp = pp
oldfp = fp-in disp
finish
-> lok
s('N'): !note
marker = cp
-> ok
s('A'): !adjust or abstract
if sin=0 start ; ! Adjust
cp = lbeg if fp<lbeg<cp
move hole
transfer input unless lbeg=pp or in disp=0
while pp#lbeg cycle
fp = fp-1; pp = pp-1; cp = cp-1
byteinteger(fp) = byteinteger(pp)
repeat
! Now have hole just before line, lbeg=pp, cp=fp.
cycle ; ! num
->no if cp>end
margin = -1
cycle ; ! Input line
exit if fp=lend; ! Blank line.
if margin=-1 start ; ! Look for first line of para.
i = lbeg-1
i = i-1 while i>top and (byteinteger(i)#nl or byteinteger(i-1)#nl)
i = i+1 unless i=top; ! i points to lbeg of first line.
if i<lbeg start ; ! Move back to first line.
transfer input unless in disp=0
unval(pp,6); ! For unwinding.
j = pp-i; fp = fp-j; pp=i
move(j,pp,fp)
oldpp = pp; oldfp = fp-in disp
lbeg = i
cp = fp
find lend(i)
->abdn if i#0
finish
if byteinteger(fp)=' ' start ; ! Margin to be indented.
margin = amargin
i = margin+apgap; i = 0 if i<0
finishelsestart
margin = 0
i = 0
finish
! Now output left margin for first line.
cline = i
npp = pp
byteinteger(npp) = ' ' and npp = npp+1 and i = i-1 while i>0
finish ; ! Of paragraph initialisation.
fp = fp+1 while byteinteger(fp)=' '; ! Skip over left margin
fp = fp-1 if fp=lend
! Note that a line of spaces does not terminate a paragraph.
if byteinteger(lend-1)=' ' start
! Do not format this line.
if pp>top and byteinteger(pp-1)#nl start
byteinteger(pp) = nl
pp = pp+1
lbeg = pp
finish
i = margin
byteinteger(pp) = ' ' and pp = pp+1 and i = i-1 while i>0
byteinteger(pp) = byteinteger(fp) and pp = pp+1 and c
fp = fp+1 until fp=lend
cline = aline; ! To force a line.
finish
! Now output this input line.
while fp#lend cycle
if byteinteger(fp)#' ' start ; ! Start of a word.
j = 1
j = j+1 while fp+j<lend and byteinteger(fp+j)#' '
if cline+j>aline start
! Word does not fit on line. Take a new line.
byteinteger(pp) = nl; pp = pp+1
lbeg = pp
i = margin; ! Initial spaces
cline = margin
npp = pp
byteinteger(npp) = ' ' and npp = npp+1 and i=i-1 while i>0
finish
! Now place word.
cline = cline+j
j = fp+j
pp = npp
byteinteger(pp) = byteinteger(fp) and pp = pp+1 and c
fp = fp+1 until fp=j
npp = pp
finishelsestart ; ! Space character.
j = 1
j = j+1 while byteinteger(fp+j)=' '
fp = fp+j
cline = cline+j
npp = pp
byteinteger(npp) = ' ' and npp = npp+1 and j = j-1 while j>0
finish
repeat
! Now move to next input line.
fp = lend+1; cp = fp
find lend(i)
-> abdn if i#0
exit if cp=lend
! exit if input line just dealt with was last of paragraph.
if pp>lbeg and byteinteger(pp-1)#' ' start
npp = pp
byteinteger(npp) = ' '; npp = npp+1
cline = cline+1
finish
repeat ; ! Input line
! Now find a non-blank line
cycle
byteinteger(pp) = nl; pp = pp+1; lbeg = pp
exit unless fp=lend<=end
fp = lend+1; cp = fp
find lend(i)
->abdn if i#0
repeat
num = num-1
repeat until num=0 or num=stopper
->get
finish
! Abstract
if showflag > seconad then -> no; !Require %o= in SHOW
-> no unless top <= marker <= cp
len = cp-marker; ! Size of extract.
if seconad = 0 then start ; !Merge with primary
switch to main file
->abdn if (pp-top) + (end-fp) + len + hole min > wend-wtop
! I.e. give up if < hole min bytes of spare space left
move hole
move(len,marker,pp)
pp = pp+len; lbeg = pp
switch to secondary file
-> ok
finish
i = integer(seconad)+len; !Add to secondary output
if i > integer(seconad+8) then start ; !Too small
changefilesize(outwork,i,k)
if k # 0 then start
connect(outwork,3,i,0,r,k)
changefilesize(outwork,i,k)
if k # 0 then psysmes(45,k) and -> er7
!Extend fails
seconad = r_conad
finish
integer(seconad+8) = ((i+4095)>>12)<<12; !Round up
finish
k = seconad+integer(seconad)
move(len,marker,k)
integer(seconad) = i
-> ok
!Special commands
c(3): !%f, %m, %q
mon = 'M'-code
-> c1
c(2): ! %w, %x, %y, %z macro definitions
read item
j = (code-'W')<<7
printstring(string(addr(stored(j)))) and ->c1 if sym=nl
-> er1 if sym # '='
i = j+1
cycle
read sym
stored(i) = sym
byteinteger(addr(stored(j))) = i-j and ->c1 if sym=nl
i = i+1
-> er6 if i&127=0
repeat
abdn:
printstring("Line or file too big.".snl)
comreg(24) = 4
-> pc('C')
c(1): !more % commands - l, u, s, c
read item
->er1 if sym#'=' and type#1
-> pc(code)
pc('A'): !Set or report 'Adjust' pointers.
if sym#'=' start
! Print out current setting of parameters.
printstring("Margin "); iwrite(amargin)
printstring(snl."Paragraph indent "); iwrite(apgap)
printstring(snl."Line length "); iwrite(aline)
printch(nl)
-> c1
finish
! Set adjust params.
for i=1,1,3 cycle
read item
if sym='-' then j = -1 and read item else j = 1
prof_adparm(i) = j*num and read item if type=0
exit unless sym=','
repeat
amargin = 0 if amargin<0
aline = 0 if aline<0
->c1 if type=1
->erq
pc('B'): !Back up file
->er0 unless showflag=0
i = mpp-mtop + mend-mfp+1 + 32; ! 32 for file header.
outfile("ECCE#BACKUP", -i, i, 0, j, k)
if k#0 start
printstring("Not enough workfile space. %C recommended.".snl)
-> er7
finish
integer(j) = i; ! Set file size in header.
integer(j+12) = 3; ! Character file.
j = j+32
move(mpp-mtop,mtop,j); ! Part before hole.
j = J+mpp-mtop
move(mend-mfp+1,mfp,j); ! Part after hole.
printstring("File ECCE#BACKUP written to.".snl)
-> c1
pc('L'): !lower mode
mask = 0
convert == array(addr(lower(0)),bform)
-> c1
pc('U'): !upper mode
mask = 32
convert == array(addr(upper(0)),bform)
-> c1
pc('S'): !switch input
if showflag > 0 then -> c(0)
mark command line if sin=0
cmax = 0; ! Prevents command line repetition, after mode switch.
if sym = '=' then start ; !New sec input
tempname = ""
cycle i = 1,1,31
read sym until sym # ' '
unless nl # sym # ';' then exit
tempname = tempname.tostring(sym)
repeat
makeupper(tempname)
i = check distinct(tempname,secoutput)
if i # 0 then psysmes(8,i) and -> er7; !Inconsistent file use
connect input(tempname,j,k,len,i)
if i # 0 then psysmes(8,i) and -> er7; !Connect fails
secinput = tempname
stop = k
send = stop+len-1
send = send-1 while send >= stop c
and byteinteger(send) # nl
scp = stop; slbeg = stop
spp = stop; sfp = stop
switch modes if sin=0
finish else switch modes
-> set
pc('O'): !secondary output
if seconad # 0 then start ; !Dispatch file
if charno(secoutput,1) = '.' c
then sendfile(outwork,secoutput,"EOUTPUT",0,0,i) c
else sendoutput(outwork,secoutput,i)
if i # 0 then psysmes(6,i)
seconad = 0
finish
secoutput = ""
if sym # '=' then -> c1; !No param
tempname = ""
cycle i = 1,1,31
readsym until sym # ' '
unless nl # sym # ';' then exit
tempname = tempname.tostring(sym)
repeat
makeupper(tempname)
if charno(tempname,1) # '.' then start
i = check distinct(tempname,secinput)
if i = 0 then i = checkoutputfile(tempname)
if i # 0 then psysmes(10,i) and -> er7
finish
i = '0'
i = i+1 while exist("T#ESOUT".tostring(i))#0
i = '0' if i>'4'
outwork = "T#ESOUT".tostring(i)
outfile(outwork,-4096,4096,0,seconad,i)
if i # 0 then psysmes(10,i) and seconad = 0 and -> er7
!Create fails
secoutput = tempname
integer(seconad+12) = 3; !Character file
-> c1
pc('P'): !profile (i.e. set it)
write profile("ECCE",prof,pvsn,i)
-> c1
pc('C'): !close
if seconad # 0 then start ; !Dispatch file
if charno(secoutput,1) = '.' c
then sendfile(outwork,secoutput,"EOUTPUT",0,0,i) c
else sendoutput(outwork,secoutput,i)
if i # 0 then psysmes(6,i)
finish
if showflag = 0 start
if sin=-1 start
switch to main file
sin = 0
finish
! Set parms.
wtop = top; wend = pp; stop = fp; send = end
finish
end ; ! of edinner
integerfn checkoutputfile(string (31) s)
record (finf)r
string (31) member, user
integer flag, i, j
if s -> user.(".").s and user # uinfs(1) c
then setfname(s) and result = 258
unless s -> s.("_").member then member = ""
connect(s,0,0,0,r,flag)
if member # "" then start
if r_filetype # 6 then result = 286; !Not a pd file
! PD file must exist.
if flag = 0 then start ; ! OK - it does exist
setfname(member)
if 1 <= length(member) <= 11 then start
cycle i = 1,1,length(member)
j = charno(member,i)
unless 'A' <= upper(j) <= 'Z' c
or (i>1 and '0' <= j <= '9') then result = 270
repeat
! See whether member exists
flag = -exist(s."_".member); ! If member exists, set flag to -1.
finish else flag = 270; !Invalid membername
finish
finish else start ; ! PD file member not specified.
if flag = 0 and r_filetype = 6 then flag = 310; ! Not allowed to overwrite a PD file.
flag = -1 if flag=0; ! May need to issue warning later - output exists.
flag = 0 if flag = 218; !Need not exist
finish
result = flag
end ; !Of check output file
integerfn checkdistinct(string (31) s, t)
string (31) member
if s -> s.("_").member then start
finish
if t -> t.("_").member then start
finish
if s = t then result = 266; !Inconsistent file use
result = 0
end ; !Of check distinct
routine makeupper(stringname s)
integer dr0, dr1, accdr0, accdr1
dr0 = x'58000000'!length(s)
dr1 = addr(s)+1
accdr0 = x'18000100'
accdr1 = addr(upper(0))
*ld_dr0
*lsd_accdr0
*ttr_l =dr
end ; !Of makeupper
routine sendoutput(string (31) file, out, integername f)
string (31) s1, s2
trim(file,f)
if f # 0 start
printstring("Unable to trim workfile ".file." - Ecce fails.".snl)
return
finish
if out -> s1.("_").s2 then start
modpdfile(2,s1,s2,"",f); !Destroy first
modpdfile(1,s1,s2,file,f)
if f#0 start
printstring("Unable to write to pdfile ".s1.snl)
newgen(file,"ECCE#BACKUP",f)
if f#0 then rename(file,"ECCE#BACKUP",f)
if f=0 then printstring("Edited text left in file ECCE#BACKUP.".snl)
f = 1; ! To prevent ECCE#BACKUP from being deleted!
finish else destroy(file,f) and f=0
finish else start
newgen(file,out,f)
if f # 0 then rename(file,out,f)
finish
printstring("File ".out." written to.".snl) if f=0
end ; !Of send output
routine connect input(string (255) file, integername conad,start,size,f)
record (finf) r
conad = 0; start = 0; size = 0; f = 0
unless 1 <= length(file) <= 31 then f = 220 and return
if file # ".N" and file # ".NULL" start
connect(file,0,0,0,r,f); !Any mode,any size,no protect
if f # 0 then return
if r_filetype = 3 start
conad = r_conad
start = r_conad+r_datastart
size = r_dataend-r_datastart
finish else start
f = 267; !Invalid filetype
setfname(file)
finish
finish
end ; !Of connect input
externalroutine ecce(string (255) in)
integer workhead, worktop, workend, inhead, intop, inend, oinend
integer insize, worksize, holesize
integer f, j
string (255) out
string (8) work
!Start: decompose and vet params
if in -> in.("/").out then in = in.",".out
unless in -> in.(",").out then out = in
if out -> in.(",").out then -> er1
makeupper(in)
if in = "" or in = ".N" then in = ".NULL"
makeupper(out); !In case of ".NULL"
unless out = ".N" or out = ".NULL" then start
f = checkoutputfile(out)
if f > 0 then -> er
if f=-1 and in#out start
! f is -1 if output file exists.
printstring("**Warning: overwriting file ".out.". If you do not want".snl)
printstring("to lose current contents, use Int:A now to get out of ECCE.".snl)
finish
finish
!Setup files
connect input(in,inhead,intop,insize,f)
-> er if f # 0
work = "T#ETEMP"
f = 1
for j= '0',1,'4' cycle
f = 0 and exit if exist(work.tostring(j))=0
repeat
j = '0' if f=1
work = work.tostring(j)
holesize = 262144; ! 1/4 meg hole.
cycle
worksize = insize + holesize
outfile(work,-worksize,worksize,0,workhead,f)
exit if f=0
->er if holesize = 4096; ! 4K - minimum reasonable.
holesize = holesize>>1
repeat
if inhead#0 and integer(inhead+4)>32 start
move(integer(inhead+4)-32,inhead+32,workhead+32)
! Copy last part of unusual input file header
integer(workhead+4) = integer(inhead+4)
finish
integer(workhead+8) = worksize; worksize = worksize-integer(workhead+4)
integer(workhead+12) = 3; ! Type=character
worktop = workhead+integer(workhead+4)
workend = worktop+worksize-2*integer(workhead+4)
inend = intop+insize-1
inend = inend-1 and insize = insize-1 while inend>=intop and byteinteger(inend)#nl
oinend = inend
prompt("Edit".tostring(13).tostring(nl).">")
edinner(workhead, worktop, workend, inhead, intop, inend, work, in)
! Edited file: [worktop,workend) + [intop,inend]
worksize = workend-worktop + inend+1-intop
if out=".NULL" or (in=out and insize=worksize and inend=oinend and c
worktop=workend) then f = 0 elsestart
! File must be written back.
j = inend-intop+1
move(j,intop,workend)
integer(workhead) = worksize+integer(workhead+4)
sendoutput(work,out,f)
finish
destroy("ECCE#BACKUP",f) if f=0 and out#"ECCE#BACKUP"
return
er1:
print string( c
" Form is E(old) or E(old,new) or E(,new)".snl)
comreg(24) = 8
return
er:
comreg(24) = f; !Set return code
psysmes(73,f) if f > 0
end ; !Of e
externalroutine show(string (255) in)
integer intop, inend, inhead, insize, f
if in = "" then in = "T#LIST"; !Use compiler default listing file if none specified
makeupper(in)
connect input(in,inhead,intop,insize,f)
-> er if f # 0
if intop = 0 then f = 220 and -> er; !No ".N"
prompt("Show".tostring(13).tostring(nl).">")
inend = intop+insize-1
inend = inend-1 while inend>=intop and byteinteger(inend)#nl
edinner(inhead, intop, inend, inhead, intop, inend, in, "")
return
er:
comreg(24) = f; !Set return code
psysmes(74,f) if f > 0
return
end ; !Of show
externalroutine recap(string (255) in)
systemroutinespec get journal(stringname file, integername flag)
string (31) file
integer flag
if in = "" then start
get journal(file,flag)
if flag = 0 then show(file)
finish else flag = 215; !Too many params
if flag > 0 then psysmes(75,flag)
comreg(24) = flag; !Set return code
end ; !Of recap
endoffile