!ECCExx: Implementation of ECCE for 2900/EMAS, VAX/VMS and APM
! Revised specification (1981/82) including video support.
! Hamish Dewar Edinburgh University Computer Science Department
!
! V0 (09/02/81): initial test release
! V1 (04/06/81): VT52/Bantam/hard-copy support
! V2 (16/11/81): Esprit supported / Overwrite + C-
! V3 (03/03/82): Overwrite modded + K-
! V4 (15/12/82): revised macros & block move
! V5.0 (29/01/83): standard VTI / revised overwrite
!
! This single source file covers the three versions.
! Simulated conditional compilation statements are used for parts
! which are special to specific versions. All these versions
! assume the availability of sufficient memory (virtual or real)
! to avoid the necessity for manipulating explicitly created
! temporary files. In the Emas version the source file (and any
! secondary files) are mapped directly into virtual memory and
! a separate area is used for the new file being created; in the
! VMS version (because of the idiosyncratic record format of files),
! and the APM version (because of lack of virtual memory at present),
! the source file is 'read in' to the new file area (and secondary
! file to its own area).
! All versions use the EUCSD standard Video Terminal Interface and
! VM management routines, together with the IMP run-time support
! library.
!
! The ASCII character set is assumed, with NL (pre-defined = LF)
! as the line-break character WITHIN THE TEXT FILE.
! The Editor expects to receive RETURN (= ASCII RT) and LF distinctively
! FROM THE KEYBOARD, and at present expects THESE CHARACTERS TO BE
! INTERCHANGED.
!
! One of the objectives in the design of the video facilities was
! to avoid having to pre-suppose single-character interaction on
! sequences of printing characters. There are a few cases where
! there would be a small ergonomic gain from exploiting this mode
! of operation on a system where it is unproblematic, but it
! would be a pity to lose compatibility on that score.
! The Editor does pre-suppose termination of input on any control
! character or control sequence without echoing; it might be possible
! to make a special case of some or all of the cursor controls
! where the performance implications of interaction even on every
! control key is problematic.
!
!
!
!
!
!
!
!
!
!
!
!!!!!!!!!!!!!! Standard Video Terminal Interface !!!!!!!!!!!!!
!$IF EMAS OR VAX
! Terminal mode
constinteger SINGLE=1, NOECHO=4, PASSDEL=8, NOTYPEAHEAD=16,
NOTERMECHO=32, CONTROLTERM=64, LEAVECONTROLS=256,
SPECIALPAD=8192, NEWTCP=16384
constinteger SCREENMODE=controlterm+notermecho+leavecontrols+passdel
! Video FUNction/MODE flag values:-
constinteger INTENSE=1, REVERSE=2, UNDERLINE=4, BLINK=8, SHADE=15
constinteger FULLSCROLL=16, ANYSCROLL=32; !FUN only
constinteger NOSCROLL=16, FREEZE=32; !MODE only
recordformat WININFO(byteinteger top,rows,left,cols,
row,col,fun,mode)
externalrecord(wininfo)spec VDU
externalrecord(wininfo)spec WIN
externalintegerspec VTTYPE
!
externalroutinespec DEFINE VIDEO alias "VTDEFVIDEO"(integer emastype)
externalroutinespec SET VIDEO MODE alias "VTSETVIDEO"(integer mode)
externalroutinespec PUSH WINDOW alias "VTPUSH"
externalroutinespec POP WINDOW alias "VTPOP"
externalroutinespec SWOP WINDOW alias "VTSWOP"
externalroutinespec SET FRAME alias "VTSETFRAME"(integer t,r,l,c)
externalroutinespec SET MODE alias "VTSETMODE"(integer m)
externalroutinespec SET SHADE alias "VTSETSHADE"(integer s)
externalroutinespec CLEAR LINE alias "VTCROL"
!%externalroutinespec CLEAR FRAME %alias "VTCFRAME"
externalroutinespec SCROLL alias "VTSCROLL"(integer t,b,n)
externalroutinespec VT AT alias "VTSETCURSOR"(integer row,col)
!%externalroutinespec GOTOXY %alias "VTGOTOXY"(%integer x,y)
!
!$IF EMAS
{%recordformat EVENTINFO(%integer event,sub,extra, %string(255) message)
{%externalrecord(eventinfo)%spec EVENT %alias "VTEVENT"
{%externalroutinespec OPEN INPUT %alias "VTOPIN"(%integer s,
{ %string(255) file)
{%externalroutinespec OPEN OUTPUT %alias "VTOPOUT"(%integer s,
{ %string(255) file)
{%externalroutinespec CLOSE INPUT %alias "VTCLIN"
{%externalroutinespec CLOSE OUTPUT %alias "VTCLOUT"
{%externalintegerfnspec OUTSTREAM %alias "VTOUTS"
!$IF EMAS OR VAX
externalroutinespec SELECT INPUT alias "VTSELIN"(integer i)
externalroutinespec SELECT OUTPUT alias "VTSELOUT"(integer i)
externalroutinespec PRINT SYMBOL alias "VTPSYM"(integer sym)
externalroutinespec SPACE alias "VTSP"
externalroutinespec SPACES alias "VTSPS"(integer n)
externalroutinespec NEWLINE alias "VTNL"
externalroutinespec NEWLINES alias "VTNLS"(integer n)
externalroutinespec PRINT STRING alias "VTPSTRING"(string(255) s)
externalroutinespec WRITE alias "VTWRITE"(integer v,p)
externalroutinespec VTPROMPT alias "VTPROMPT"(string(255) s)
externalroutinespec READ SYMBOL alias "VTRSYM"(integername k)
externalintegerfnspec NEXT SYMBOL alias "VTNSYM"
externalroutinespec SKIP SYMBOL alias "VTSSYM"
externalroutinespec READ alias "VTREAD"(integername v)
constinteger bs=8, rt=13, esc=27, del=127
!$FINISH
constinteger bantam=6
!
!!!!!!!!!!!!!!!!! Other external refs and globals !!!!!!!!!!!!!!!!!!!!!!!!!
constinteger ret=10
constinteger casebit=32; !upper<->lower
!
!$IF VAX OR APM
BEGIN; !program, not routine
constinteger CORDON=0
constinteger MAXNAME=127; !max file-name length
conststring(3) NULLSTREAM = "NL:"
recordformat FILE(string(maxname) NAME, c
integer START,LIM,VMSTART,VMLIM,FLAG)
!$IF VAX
conststring(12) HELPFILE="????????????"
conststring(9) DICTFILE="ECCE_DICT"
externalroutinespec MOVE(integer length,from,to)
!%externalintegerfnspec UINFI(%integer i)
!%externalintegerfnspec CHECKQUOTA(%string(127) filename)
externalstring(72)fnspec SYSMESS(integer i)
externalstring(255)fnspec CLIPARAM
!
! Special routines from PMM to handle file referencing and i/o
externalintegerfnspec READIN(string(maxname)name file,
integer extra, integername base,start,fend,limit)
externalintegerfnspec WRITEOUT(string(maxname)name file,
integer base,start,fend,limit)
externalroutinespec DELETEVM(integer base,limit)
!
routine CONNECT INPUT(record(file)name f)
! Reference file specified by F_NAME
! allocate store to hold it + extra blocks specified by F_FLAG
! place the file in store
! Return store addresses in F_VMSTART/F_VMLIM
! file addresses in F_START/F_LIM
! ( VMSTART <= START <= LIM <= VMLIM )
!
! Discard any previous input file
deletevm(f_vmstart,f_vmlim) if f_vmstart # 0
! Read the file in
f_flag = readin(f_name,f_flag,f_vmstart,f_start,f_lim,f_vmlim)
if f_flag # 0 start
print string(" *".sysmess(f_flag).": ".f_name)
! no newline at present
f_vmstart = 0; f_start = 0; f_lim = 0
finish
! Ensure that file does not end with partial line
f_lim = f_lim-1 while f_lim # f_start and byteinteger(f_lim-1)#nl
end; !CONNECT INPUT
routine CONNECT DICT(integername base)
integer f,s,l
externalintegerfnspec connect(string(127) file,
integername start,length)
f = connect(dictfile,s,l)
f = connect("DR0:[HMD.ECCE]DICT.MAP",s,l) if f&1 = 0; !*temp*
if f&1 = 0 then print string("Dictionary not available") c
else base = s
end
!
!$IF APM
{%routine MOVE(%integer length,from,to)
{ %while length > 0 %cycle
{ byteinteger(to) = byteinteger(from)
{ to = to+1; from = from+1; length = length-1
{ %repeat
{ %return
{! length = length-1
{! %return %if length <= 0
{! *MOVE FROM,A0; *MOVE TO,A1; *MOVE LENGTH,D0
{! *MOVE.B (A0)+,(A1)+; *DBRA D0,-4
{%end
{!
{%routine CONNECT INPUT(%record(file)%name f)
{ %on %event 9 %start
{ printstring(event_message)
{ f_flag = 1
{ %return
{ %finish
{! %if f ## sec %then open input(2,f_name) %c
{! %else open input(3,f_name)
{ open input(2,f_name)
{ select input(0)
{%END
{!
!$IF EMAS
{%constinteger CORDON=2; !to alleviate effects of echoed typeahead
{%constinteger MAXNAME=31
{%conststring(5) NULLSTREAM = ".NULL"
{%conststring(24) HELPFILE = "ECSLIB.GENERALY_ECCEVIEW"
{%conststring(24) DICTFILE = "ECSLIB.GENERALY_ECCEDICT"
{%externalroutinespec PROMPT(%STRING(15) S)
{%externalroutinespec VIEW(%STRING(255) S)
{%recordformat FILE(%string(maxname) NAME, %integer START,LIM,FLAG)
{!
{%routine MOVE(%integer length, from, to)
{ *LB_LENGTH
{ *JAT_14,<L99>
{ *LDTB_X'18000000'
{ *LDB_%B
{ *LDA_FROM
{ *CYD_0
{ *LDA_TO
{ *MV_%L=%DR
{L99:
{%END
{%INCLUDE "ECSC10.ECCE_FCP"
{!
!$FINISH
!
!!!!!!!!!!!!!!!!!!! Editor parameters and options !!!!!!!!!!!!!!!!!
!** NB ORDER -- see VALUE
constinteger optnames=18, optmax=5
! vcccwwwwtemmmwm
! mcltclrttaaiaia
! ooeooeooyrrnrdp
! dlfplfwpplkwgtc
! est sts ey iiha
! nn s
constinteger numeric=2_111111111001110
!
owninteger mapcase=1; !1/0 ignore/heed case
owninteger width=80; !line width
owninteger margin=0; !left margin
owninteger minwin=7; !minimum window size
owninteger mark=0; !1/0 show FP by mark/hilight
owninteger early=0; !1/0 update early/late
!Settable at outset only:-
!$IF EMAS
{%owninteger ttype=-1
!$IF VAX OR APM
owninteger ttype=11; !terminal type (ERCC coding)
!$FINISH
owninteger wtop=0, wrows=255; !window area top,rows
owninteger wleft=0, wcols=255; !window area left,cols
owninteger ctop=99; !command row (1st of 2)
owninteger cleft=0, ccols=255; !command area left,cols
!$IF VAX OR APM
owninteger vmode=0
!$IF EMAS
{%owninteger vmode=newtcp
!$FINISH
ownstring(maxname) pre=""; ![treated specially]
!** end of OPTIONS
ownrecord(file) in,sec,out
conststring(7)array optname(1:optnames) =
"NOMATCH", "MATCH",
"WIDTH", "MARGIN", "MINWIN",
"HILIGHT","MARK",
"LATE", "EARLY",
"TTYPE", "WTOP", "WROWS", "WLEFT", "WCOLS",
"CTOP", "CLEFT", "CCOLS", "VMODE"
!
integermap value(integer i)
result == integer(addr(mapcase)+i<<2); !mapcase == 0
end
!!!!!!!!!!!!!!!!! Command parameter processing !!!!!!!!!!!!!!!!!
!
routine SET PARAMETERS(string(255) parm)
integer l,sym
on event 9 start; stop; finish
!
routine GETNAME(string(maxname)name s)
! Extract next name from PARM, leaving terminator in SYM
s = ""
cycle
sym = nl
l = l+1 and sym = charno(parm,l) if l < length(parm)
exit if sym<' ' or sym=',' or sym='/' or sym='-' or sym='='
if sym = ' ' start
exit if s # ""
finish else start
sym = sym-casebit if sym >= 'a'
sym=0 and return if length(s) >= maxname
s = s.tostring(sym)
finish
repeat
s = ".N" if s = nullstream
end
!
routine GET QUALIFIER
integer i,j,k,ll
string(maxname) s
ll = l+1
get name(s)
if s = "PRE" start
sym=0 and return if sym # '='
get name(pre)
finish else start
i = 0; j = 0; k = 1
while optname(k) # s cycle
k = k+1
l=ll and sym=0 and return if k > optnames
j = j+1; j = 0 and i = i+1 if j = 2 or numeric>>i&1 # 0
repeat
if numeric>>i&1 # 0 start
sym=0 and return if sym # '='
j = 0
cycle
sym = nl
l = l+1 and sym = charno(parm,l) if l < length(parm)
exit unless '0' <= sym <= '9'
j = j*10+sym-'0'
repeat
finish
value(i) = j
finish
end
l = 0
cycle
get name(in_name)
exit if in_name # ""
get qualifier while sym = '-'
exit if sym = '/'
if sym = nl start
prompt("File: ")
cycle
read symbol(sym)
exit if sym < ' '
parm = parm.tostring(sym)
repeat
finish
repeat
prompt("")
in_name = "" if in_name = ".N"
out_name = in_name
get name(sec_name) if sym = ','
if sym = ' ' or sym = '/' start
get name(out_name)
out_name = "" if out_name = ".N"
finish
get qualifier while sym = '-'
if sym # nl start
print string(" Faulty parameters: ".parm)
newline
print symbol(' ') and l = l-1 until l <= -19
print symbol('^'); newline
stop
finish
end; !SET PARAMETERS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!! Key definition map and macros !!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The Video Terminal Interface converts multi-character
! control sequences to character values in the range 128:255.
! For 2-char sequences, the value is 2nd char + 128.
! For 3-char sequences, the value is 3rd char!!96 + 128
! The array DEF records the significance of each symbol,
! as either a basic symbol (<32768) or macro definition.
! Initial entries are a melange of values relevant to specific
! known terminals.
constinteger posmask=16_3FFF, limshift=14
constinteger macro=1<<limshift, null=640<<limshift+640, nullref=127
!128:191 second 0-63 third (!!96) 64:127
!192:255 second 64-127 third (!!96) 0:63
ownintegerarray DEF(0:255) =
' ', 'G', 'K', ' ',
' ', ' ', ' ', ' ',
'g'{BS}, 'N'{TAB}, 'M'{LF}, '{'{VT},
'>'{FF}, '1'{RT}, 'E', 'I',
' ', ' ', ' ', ' ', ' ', ' ', '}', ' ',
'>'{CAN}, 'E'+'0'<<8, ' ', ' '{ESC}, ' ', ' ', '}', ' ',
' ', '!', '"', '#', '$', '%', '&', '''',
'(', ')', '*', '+', ',', '-', '.', '/',
'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',
' ', ' ', ' ', '[', '¬', ']', '^', '_',
'|!|M', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
650<<limshift+648, 'I', 'J', 'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
' ', ' ', ' ', '{', '||', '}', '~', null,
' ', ' ', ' ', ' '{?c},
' ', ' ', ' ', ' '{?g},
' ', ' '{?i}, ' ', ' '{?k},
'F'+'"'<<8{?l}, 'm'+'0'<<8{?m}, ' ', ' '{?o},
'F'+'!'<<8{p}, 'E'+'0'<<8{?q}, 'S'+'!'<<8{?r}, '^'{?s},
'K'{?t}, 'E'{?u}, 648<<limshift+644{?v}, 'G'+'0'<<8{?w},
'I'{?x}, 644<<limshift+640{?y}, ' '{?z}, ' ',
' ', ' ', ' ', ' ',
' ', ' ', ' ', ' '{?C},
' ', ' ', ' ', ' '{?G},
' ', ' ', ' ', '}'{?K},
'{'{?L}, '¬'{?M}, ' ', ' '{?O},
' ', 'o'+'0'<<8{1}, ' '{2}, ' '{?S},
' ', ' ', ' ' ,' '{?W},
' ', ' ', ' ', ' '{?[},
' '{¬}, ' '{]}, ' '{^}, ' '{_},
'}'{@}, '{'{A}, '}'{B}, '>'{C},
'<'{D}, 'G'{E}, ' ', ' '{G},
'L'+'0'<<8{H}, ' ', '$'{J}, 'e'+'0'<<8{K},
' ', 'k'{M}, ' ', ' '{O},
' ', 'I'{Q}, 'K'{R}, ' ',
'E'+'0'<<8{T}, ' ', ' ', 'E'{W},
' ', ' ', ' ', ' '{[},
' ', ' '{]}, ' '{^},
' '('f'-'^'-1), 'S'+'"'<<8{f}, ' ', ' ',
'i'+'0'<<8{i},
' '('z'-'i'-1), 'n'{z}, ' '(127-'z')
!$IF EMAS OR VAX
constinteger macbound=16383
!$IF APM
{%constinteger macbound=8191
!$FINISH
ownbyteintegerarray mac(0:macbound) =
0 (640),
'I','.',' ','.', 'D','.',' ','.',
'%','H',
0 (*)
!Indexing MAC:
!FREEBASE,COMBASE,INSERTBASE re-assignable
constinteger textlim=128
owninteger freebase=128, combase=256, insertbase=384,
matchbase=512, macbase=640, macfree = 650
!
!!!!!!!!!!!!!!!!!!! Start of Editor proper !!!!!!!!!!!!!!!!!!!
!
routine EDI(record(file)name old,secfile,new, string(255) message)
! Only the START and LIM components of the file info records
! OLD, SECFILE and NEW are relevant for editing (except when
! referencing secondary input).
! In the Vax version the original file is copied into the
! working space (NEW) prior to entry; in the EMAS version
! it is accessed (initially) in its original mapped site.
!
constinteger stopper=-10000; !loop stop
!$IF EMAS OR VAX
constinteger mingap=4096; !room for manoeuvre
!$IF APM
{%constinteger mingap=1024
!$FINISH
integer code; !command code
integer ref; !text or bracket pointer
integer scope; !search limit
integer num; !repetition number
owninteger term=ret; !last symbol read
owninteger sym=ret; !last symbol got
integer control,fpsym,pend; !characters
integer hold,holdsym,pos; !work variables
owninteger edmode=-1; !command/data
owninteger error=0
owninteger commandstream=0; !0[1] for terminal[file]
owninteger sin=0; !0[1] for main[secondary] input
owninteger casemask=¬casebit; !¬casebit/¬0 to ignore/heed case
owninteger dict=0
!
!File state info
recordformat fstate(integer start {start of file},
lbeg {line start position},
fp {current position},
lim {end of file},
line {line number of current pos},
diff {diff between LINE and ROW},
top {top row of sub_window},
win {floating top},
bot {bottom row of sub_window},
min {minimum window size})
!** Note that LBEG is such that FP-LBEG = #chars to left of FP
ownrecord(fstate) cur=0,main=0,sec=0
integer fp; !current file position
integer fp1; !temporary FP
integer lend; !line end position
integer gapstart,gaplim; !gap start/limit
integer oldgapstart,oldgaplim
owninteger gapline
!The following assumes that (relevant) addresses are positive
constinteger floor=0; !** LESS THAN ANY VALID ADDRESS **
constinteger ceiling=16_7FFFFFFF
integer newlim; !effective limit of new file
!also = start of deletion store
integer delmax; !current end of deletions
!$IF EMAS
{%integer gdiff
!$IF VAX or APM
constinteger gdiff=0
!$FINISH
owninteger foundpos=0,foundsize=0; !matched text info
owninteger markpos=0,markline; !marker position
!
! Video control
owninteger video=0
owninteger fscroll=0, cscroll=0
owninteger chalf=0
owninteger vgap=0
constinteger unknown=-99999; !impossible value for _DIFF
constinteger offscreen=99; !impossible value for _WIN
owninteger joins=0; !count of lines added/removed
owninteger endon=0; !**END** displayed indic
owninteger altmin,altlim; !pos of earliest/latest alteration
owninteger altline; !for ALTMIN
owninteger altlimlbeg=0; !for ALTLIM
integer fprow,fpcol
integer vp; !file pointer for displaying
owninteger printline=0,printed=0; !for hard-copy
!
ownstring(2) newprom="??", curprom=""
conststring(2)array prom(0:3) = ">>", "$$", "^>", "^$"
!
integer dictpos
integer mac0
owninteger reflim=128,reflim1=128
constinteger mstbound=7
ownintegerarray mstack(0:mstbound) = 0 (*)
owninteger msp=0; !macro stack pointer
owninteger comlim
owninteger tlim,tlim1
owninteger inpos=0,inlim=0,inlim1=0
constinteger null=640<<limshift+640
owninteger idef=null,mdef=null
owninteger traildels=0
!
!Cell format for storage of commands
recordformat commandcell(byteinteger code,ref, c
SHORTinteger scope, integer count)
constinteger cbound=60
record(commandcell) array r(1:cbound)
owninteger ci=0,cmax=0,cmax1=0; !indexing R
!
switch c(4:15), pc('A':95), s(' ':127)
integer type,chain
ownrecord(commandcell) lastcell
!
!Symbol types:-
! 0-3:non-commands 4-7:alteration group 7-9:location group
! 0:numeric 1:terminator 2:illegal 3:quote
! 4: 5:ABCEJKLR@$ 6:ISOG 7:DU
! 8:F 9:TV 10:MNP<>{} 11:( ,
! 12: 13:: 14:) 15:? ¬
!High-order bits used to classify chars in file:
constinteger lowercase=16_10,digit=16_20,uppercase=16_30,
letter=16_10,upperordigit=16_20,alphanum=16_30,
opener=16_40,closer=16_80
constbyteintegerarray symtype(0:255) = c
16_01 (32),
16_02{ }, 16_03{!}, 16_03{"}, 16_0A{#},
16_0A{$}, 16_02{%}, 16_03{&}, 16_03{'},
16_4B{(}, 16_8E{)}, 16_00{*}, 16_0A{+},
16_0B{,}, 16_02{-}, 16_03{.}, 16_03{/},
16_20{0}, 16_20{1}, 16_20{2}, 16_20{3},
16_20{4}, 16_20{5}, 16_20{6}, 16_20{7},
16_20{8}, 16_20{9}, 16_0D{:}, 16_01{;},
16_4A{<}, 16_0F{=}, 16_8A{>}, 16_0F{?},
16_05{@}, 16_15{A}, 16_15{B}, 16_15{C},
16_17{D}, 16_15{E}, 16_18{F}, 16_16{G},
16_12{H}, 16_16{I}, 16_15{J}, 16_15{K},
16_1A{L}, 16_1A{M}, 16_1A{N}, 16_16{O},
16_1A{P}, 16_1A{Q}, 16_1A{R}, 16_16{S},
16_19{T}, 16_17{U}, 16_19{V}, 16_12{W},
16_12{X}, 16_12{Y}, 16_12{Z}, 16_42{[},
16_0F{¬}, 16_82{]}, 16_0A{^}, 16_02{_},
16_02{|!|M}, 16_32{a}, 16_32{b}, 16_35{c},
16_37{d}, 16_35{e}, 16_38{f}, 16_35{g},
16_32{h}, 16_35{i}, 16_32{j}, 16_35{k},
16_3A{l}, 16_3A{m}, 16_3A{n}, 16_35{o},
16_32{p}, 16_32{q}, 16_3A{r}, 16_32{s},
16_37{t}, 16_32{u}, 16_32{v}, 16_32{w},
16_32{x}, 16_32{y}, 16_32{z}, 16_4A{{},
16_02{||}, 16_8A{}, 16_02{~}, 16_02{127},
16_02 (128)
!
on event 9,14 start; !End-of-input, Too big
-> ignore
finish
-> edistart
!!!!!!!!! Simple (command) stream opening and closing !!!!!!!!!!!
!
routine OPEN IN(string(maxname) file)
on event 9 start
printstring(event_message)
return
finish
open input(1,file); select input(1)
commandstream = 1
end
routine OPEN OUT(string(maxname) file)
on event 9 start
printstring(event_message)
signal 9
finish
open output(1,file); select output(1)
end
routine CLOSE IN
close input; select input(0)
end
routine CLOSE OUT
close output; select output(0)
end
!
!!!!!!!!!!!!!! General-purpose output routines !!!!!!!!!!!!!!!!!!!
!
routine PRINT CODE(integer k)
! Print command letter (mapping 'minus' values)
print symbol(k-casebit) and k='-' if 'a' <= k <= 'w'
print symbol(k)
end
!
routine AT(integer row,col); !file window
swop window if win_top # wtop
!$IF EMAS OR VAX
vt at(row,col)
!$IF APM
{ gotoxy(col,row)
!$FINISH
end
routine CAT(integer row,col); !command window
swop window if win_top # ctop
!$IF EMAS OR VAX
vt at(row,col)
!$IF APM
{ gotoxy(col,row)
!$FINISH
end
!
routine COMPLAIN(string(255) text)
cat(1,chalf); print string(text); print symbol(nl)
signal 14
end
!
!!!!!!!!!!!!!!!!!!!! Macro management !!!!!!!!!!!!!!!!!!!!!!!!!!
!
owninteger rr=0
routine MACPUSH(integer newdef)
if newdef # null start
complain("* Too many macro levels") if msp > mstbound
mstack(msp) = inlim<<limshift+inpos
msp = msp+1
inpos = newdef&posmask;l3: inlim = newdef>>limshift
finish
end
!
routine RELEASE(integer k)
integer i
i = def(k)
macfree = i&posmask if i>>limshift = macfree
def(k) = ' '
end
!
routine COMPRESS(integer needed)
!Compress macro text
integer oldfree,i,j,p,pos,lim,max
integerarray order(0:127)
routine SORT(integer a,b)
integer l,u,v
while a < b cycle
l = a-1; u = b
v = order(u)
cycle
l = l+1 until l = u or def(order(l)) > def(v)
exit if l = u
order(u) = order(l)
u = u-1 until u = l or def(order(u)) < def(v)
exit if u = l
order(l) = order(u)
repeat
order(u) = v
sort(a,l-1)
a = u+1
repeat
end
max = -1
for i = 0,1,255 cycle
max = max+1 and order(max) = i if def(i) >= macro
repeat
sort(0,max)
oldfree = macfree; macfree = macbase
for i = 0,1,max cycle
j = order(i); p = def(j)
pos = p&posmask; lim = p>>limshift
if pos # macfree start
while pos # lim cycle
mac(macfree) = mac(pos)
macfree = macfree+1; pos = pos+1
repeat
p = (lim-macfree)<<limshift+(lim-macfree)
def(j) = def(j)-p
inpos = inpos-(lim-macfree) if inlim = lim
j = msp
while j > 0 cycle
j = j-1
mstack(j) = mstack(j)-p if mstack(j)>>limshift = lim
repeat
finish else macfree = lim
repeat
complain("* Macros too long *") if oldfree-macfree < needed
end
! E d i t o r - s p e c i f i c v i d e o r o u t i n e s
!
routine SET WINDOWS
! Make window parameters consistent and set up sub-windows
! -- called at outset only
integer vrows
vrows = vdu_rows-cordon; !effective screen size [temp for Emas]
wrows = vrows-2 if wrows > vrows-2; !must have 2 lines for commands
ctop = vrows-2 if ctop > vrows-2
wtop = vrows-1 if wtop >= vrows
wrows = vrows-wtop if wrows > vrows-wtop
wtop = 0 if wtop = 1 and wtop+wrows > vrows-2
wcols = vdu_cols if wcols > vdu_cols
if wtop-2 < ctop < wtop+wrows start
ctop = wtop+wrows; !try after file window
ctop = wtop-2 if ctop+2 > vrows; !before file window
finish
ccols = 40 if ccols < 40
ccols = vdu_cols if ccols > vdu_cols
chalf = ccols>>1
video = vdu_fun
if vdu_fun&anyscroll # 0 start; !video can scroll
if wcols = vdu_cols start; !full-length rows
fscroll = 1
video = video-256 and wrows = wrows+1 if ctop = wtop+wrows
finish
cscroll = 1 if ccols = vdu_cols
finish
set frame(wtop,wrows,wleft,wcols)
wrows = wrows-1 if video < 0; !restore
win_mode = noscroll
push window; !save
set frame(ctop,2,cleft,ccols)
win_mode = noscroll
mark = 1 if vdu_fun&intense = 0; !cannot highlight
end
!
routine COERCE PARAMETERS
!Make (dynamically alterable) parameters consistent
cur_min = wrows if cur_min > wrows
mark = 0 if video = 0
width = 80 unless 5 <= width <= 256
margin = 0 unless margin < width
casemask = ¬0; casemask = ¬casebit if mapcase # 0
end
!
routine HEADER(integer r)
if video # 0 start
at(r,0); print string("<<"); print symbol(nl)
finish
end
!
routine SAVE COMMAND
!scroll down to preserve command
swop window if win_top # ctop
scroll(0,1,-1); curprom = ""
end
!
!!!!!!!!!!!!!! S c r e e n u p d a t i n g !!!!!!!!!!!!!!!!!
!
!$IF APM
{%routinespec read file
!$FINISH
routine DISPLAY LINE
integer k,p
p = fp; p = lend if fp > lend
if vp # endon start; cycle
vp = gaplim if vp = gapstart
if vp = p start
cur_diff = cur_line-win_row; !NB external ref
while vgap > 0 cycle
vgap = vgap-1; print symbol(' ')
repeat
finish
if vp = altlim start
altlim = floor
return if joins = 0 and vp-altlimlbeg = win_col-mark
finish
!$IF APM
{ read file %if vp = cur_lim
!$FINISH
if vp = cur_lim start
endon = vp
print string(" **END**")
exit
finish
k = byteinteger(vp); vp = vp+1
if k < ' ' or k >= 127 start
exit if k = nl
k = '_'
finish
print symbol(k)
repeat; finish
print symbol(nl)
end
!
routine UPDATE
! If a change has been made to the file, update screen,
! but only if change has affected screen line(s).
! ALTMIN and ALTLIM delimit the area which has been affected
! by alterations
integer r,c,d,lim
return if altlim = floor; !no change =>
return if video = 0
cur_diff = unknown if joins+cur_min <= 0; !many breaks
r = altline-cur_diff
if r < cur_win start
cur_diff = cur_diff-joins
cur_diff = unknown if cur_line-cur_diff >= cur_win
finish else if r <= cur_bot start; !within current window
vp = altmin; c = 0
cycle
altmin = gapstart if altmin = gaplim
exit if altmin = cur_start or byteinteger(altmin-1) = nl
altmin = altmin-1; c = c+1
repeat
swop window if win_top # wtop
d = 0; endon = 0
lim = altlim; lim = gapstart if lim = gaplim
cycle
if c+vgap = 0 and fscroll # 0 and joins # 0 start
if joins < 0 start; !net expansion
if cur_win > cur_top start
cur_win = cur_win-1; r = r-1
cur_diff = cur_diff+1
scroll(cur_top,r,1)
finish else start
scroll(r,cur_bot,-1)
finish
joins = joins+1
finish else if altlim = floor or vp = lim start
d = cur_bot+1-r-joins
if d > 0 start
cycle
scroll(r,cur_bot,1)
joins = joins-1
repeat until joins = 0
cycle; !Scan forward
cycle
vp = gaplim if vp = gapstart
endon = vp and exit if vp = cur_lim
vp = vp+1
repeat until byteinteger(vp-1) = nl
r = r+1; d = d-1
repeat until d = 0
while r <= cur_bot cycle
at(r,mark); display line; r = r+1
repeat
exit
finish
finish
finish
at(r,c+mark); display line; c = 0; r = r+1
repeat until r > cur_bot or (altlim=floor and joins=0)
finish
altmin = ceiling; altlim = floor
joins = 0
end
!
routine DISPLAY(integer indic)
! Update screen & ensure that current line is on screen
integer r,pre,count
!
routine SCANBACK
count = 1
while pre > 0 cycle
vp = gapstart if vp = gaplim
exit if vp = cur_start
cycle
vp = vp-1
vp = gapstart if vp = gaplim
repeat until vp = cur_start or byteinteger(vp-1) = nl
count = count+1; pre = pre-1
repeat
end
!
update
vp = cur_lbeg
vp = vp-gaplim+gapstart if vp < gaplim <= fp
if video = 0 start
printline = cur_line; printed = gapstart+fp
cycle
vp = gaplim if vp = gapstart
printstring("**END**") and exit if vp = cur_lim
exit if byteinteger(vp) = nl
print symbol(byteinteger(vp))
vp = vp+1
print symbol('^') if vp = fp and num = 1
repeat
newline
return
finish
swop window if win_top # wtop; endon = 0
r = cur_line-cur_diff; pre = r-cur_win
if pre < 0 start; !before start of window
if pre > -cur_min and (fscroll # 0 or r>=cur_top) start
!worth prefixing
while r < cur_top cycle
scroll(cur_top,cur_bot,-1); !scroll down
r = r+1
repeat
if cur_win # r start
cur_win = r
header(cur_win-1) if cur_win > cur_top
finish
cycle
at(r,0)
print symbol(' ') if mark # 0
display line
r = r+1; pre = pre+1
repeat until pre >= 0
return
finish
finish else start
pre = r-cur_bot-1
if pre < 0 start; !within window
return if indic = 0 or pre # -1 or lend = cur_lim
vp = lend+1
finish
if pre < cur_min start; !not far ahead
if fscroll # 0 start
scanback
cycle
cur_win = cur_win-1 if cur_win > cur_top
scroll(cur_top,cur_bot,1)
cur_diff = cur_diff+1
at(cur_bot,mark)
display line
count = count-1
repeat until count = 0
return
finish
finish
finish
!Complete refresh
pre = cur_min-1
pre = pre//2 if lend # cur_lim
scanback
r = cur_bot+1-cur_min; !floating window top
if r # cur_win start; !changed
if r < cur_top start; !sub-window changed
if sin = 0 start; !on main sub-window
cur_top = r; sec_bot = r-2
sec_min = sec_bot+1 if sec_min > sec_bot+1
sec_min = 1 if sec_min <= 0
sec_win = 0; sec_diff = unknown
finish else start; !on sec sub-window
cur_bot = cur_min-1
main_top = cur_bot+2; main_win = main_top
main_min = main_bot-main_top+1 if main_min > main_bot-main_top+1
main_min = 1 if main_min <= 0
main_diff = unknown
r = 0
finish
finish
if cur_win = offscreen start
if sin = 0 start
header(cur_top-1) if cur_top > 0
finish else start
header(cur_bot+1) if cur_bot < main_bot
finish
finish
cur_win = r
header(cur_win-1) if cur_win > cur_top
finish
cycle
at(r,0)
print symbol(' ') if mark # 0
display line
r = r+1
repeat until r > cur_bot
end
!
!!!!!!!!!!!!!!!!! Command input routines !!!!!!!!!!!!!!!!!!!!!!!!
!
routine PREPARE FOR INPUT
if video = 0 start
display(0) if printed # gapstart+fp and cur_min # 0
finish else start
display(early)
! Show position of pointer
fprow = cur_line-cur_diff; fpcol = fp-cur_lbeg
!$IF EMAS OR VAX OR APM
at(fprow,fpcol)
fpsym = ' '
if mark = 0 start
fpsym = byteinteger(fp) if fp < lend
set shade(intense)
if fpsym > ' ' then print symbol(fpsym) c
else print symbol('||')
set shade(0)
finish else start
print symbol('~')
! %if vttype # bantam %then print symbol('~') %c
! %else print symbol(esc) %and print symbol(127); !splodge
if fp # cur_lbeg and fp <= lend start
if fp # gaplim then fpsym = byteinteger(fp-1) c
else fpsym = byteinteger(gapstart-1)
finish
finish
fpsym = '_' if fpsym < ' '
!$FINISH
finish
end; !PREPARE FOR INPUT
routine RESTORE FPSYM
!$IF EMAS OR VAX OR APM
if fpsym >= ' ' start
at(fprow,fpcol); print symbol(fpsym)
finish
!$FINISH
end
!
routine READ LINE
!Read next command input line
inpos = freebase; inlim = inpos
cycle
read symbol(term)
exit unless ' ' <= term <= del
if term = del start
if inlim # inpos start
inlim = inlim-1
finish else curprom = ""; ![*maybe corrupt*]
finish else start
mac(inlim) = term; inlim = inlim+1
finish
repeat
inlim1 = inlim
end
!
routinespec split
routinespec consolidate
constinteger getting=-1,inserting=0,overwriting=1
routine OBTAIN INSERT TEXT(integer mode)
integer p
at(cur_line-cur_diff,fp-cur_lbeg+mark)
p = freebase; traildels = 0
cycle
read symbol(term)
if term < ' ' start
exit unless def(term) < ' '
term = def(term)
printsymbol('_')
finish else start
exit unless term <= del
finish
if term = del start
if p = freebase start
if fp > cur_lbeg start
if fp > lend start
fp = fp-1
finish else if mode # inserting start
consolidate if fp = gaplim
fp = fp-1
finish else start
split
gapstart = gapstart-1; cur_lbeg = cur_lbeg+1
oldgapstart = gapstart
altmin = gapstart if altmin > gapstart
finish
finish
finish else start
p = p-1; traildels = traildels+1
finish
finish else start
mac(p) = term; p = p+1
traildels = traildels-1 if traildels > 0
finish
repeat
if mode = getting start
p = freebase and term = ':' if p # freebase and mac(freebase) = ':'
term = term-256 and return if p = freebase and term # ret
finish
if p = freebase then idef = null else start
idef = p<<limshift+freebase
freebase = insertbase; insertbase = idef&posmask
finish
end
!
routine OBTAIN MATCH TEXT
prepare for input
cat(0,0); print code(code); print symbol('!')
curprom = ""
clear line
mdef = matchbase
cycle
read symbol(term)
exit unless ' ' <= term <= del
if term = del start
if mdef # matchbase start
mdef = mdef-1
finish
finish else start
mac(mdef) = term; mdef = mdef+1
finish
repeat
restore fpsym
if mdef = matchbase then mdef = null c
else mdef = mdef<<limshift+matchbase
end
! F i l e m a n i p u l a t i o n r o u t i n e s
!
integerfn distance(integer from,to)
if gaplim <= to <= cur_lim start
from = from+(gaplim-gapstart) unless gaplim <= from <= cur_lim
finish else start
to = to+(gaplim-gapstart) if gaplim <= from <= cur_lim
finish
result = to-from
end
!
routine MOVE BLOCK(integer length,from,to)
!Move block of file, dealing with overlap & relocation
!The following are relocated: FP, LBEG, LEND, FOUNDPOS, MARKPOS,
! ALTMIN, ALTLIM, ALTLIMLBEG
integer reloc,limit
reloc = to-from; limit = from+length
if from <= fp < limit start
fp = fp+reloc; cur_lbeg = cur_lbeg+reloc; !LBEG always relative to FP
finish
lend = lend+reloc if from <= lend < limit
foundpos = foundpos+reloc if from <= foundpos < limit
markpos = markpos+reloc if from <= markpos < limit
altmin = altmin+reloc if from <= altmin < limit
if from <= altlim < limit start
altlim = altlim+reloc; altlimlbeg = altlimlbeg+reloc
finish
while reloc > 0 and length > reloc cycle; !down and bigger than gap
length = length-reloc
move(reloc,from+length,to+length)
repeat
move(length,from,to)
end
!$IF EMAS
{%routine COPY ACROSS
{ move block(cur_lim-gaplim,gaplim,gaplim+gdiff)
{ gaplim = gaplim+gdiff; oldgaplim = oldgaplim+gdiff
{ gdiff = 0
{ cur_lim = newlim
{%end
!$FINISH
!$IF APM
{%constinteger out=2
{%constinteger maxline=256
{
{%routine WRITE FILE(%integer from,to)
{ new_flag = -1
{ select output(out)
{ %while from # to %cycle
{ print ch(byteinteger(from)); from = from+1
{ %repeat
{ select output(0)
{%end
!$FINISH
routine MAKE ROOM
!The gap has become too small: shuffle to enlarge it
!$IF APM
{!Write out part of the file to create space
{%constinteger chunk=mingap+mingap; !(maximum) amount to be expelled
{%integer p,diff,top; !??TOP??
{ top = cur_start; p = cur_lbeg-gaplim+gapstart
{ %if p > top+chunk %start
{ p = top+chunk
{ top = top+1 %while byteinteger(top+(chunk-1)) # nl
{ %finish
{ write file(cur_start,p); !write it out
{ diff = gapstart-p
{ move block(diff,p,cur_start)
{ altmin = altmin-diff %if altmin <= gapstart
{ gapstart = gapstart-diff
{ %seturn %if oldgaplim-gapstart >= mingap
!$FINISH
complain("* Insertions too big *") if new_lim-delmax < mingap
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
move block(delmax+1-oldgaplim,oldgaplim,oldgaplim+mingap)
oldgaplim = oldgaplim+mingap; gaplim = gaplim+mingap
cur_lim = cur_lim+mingap
newlim = newlim+mingap; delmax = delmax+mingap
end
!$IF APM
{%routine READ FILE
{!Read in more of the file (at least one line)
{%constinteger upshift=2048
{%integer p,diff,lim
{%on %event 9 %start
{ select input(0)
{ %return
{%finish
{ %if cur_lim >= old_vmlim-maxline %start; !approaching end of buffer space
{ make room %if gaplim-gapstart < upshift
{ diff = cur_lim-gaplim
{ move block(diff,gaplim,gaplim-upshift)
{ vp = vp+upshift %if vp >= gaplim
{ gaplim = gaplim-upshift
{ cur_lim = cur_lim-upshift
{ %finish
{ select input(2)
{ p = cur_lim
{ %cycle
{ read ch(byteinteger(p))
{ p = p+1
{ %repeat %until byteinteger(p-1) = nl
{ cur_lim = p
{ select input(0)
{%end
!$FINISH
!
routine STORE DELETIONS
integer l,k
!Discard part line
delmax = delmax-1 while byteinteger(delmax) # nl
cycle
l = gaplim-oldgaplim
if l+delmax >= new_lim start
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
k = oldgaplim-gapstart; signal 14 if k <= 0
if k > 1024 start; !a bit much
if k > l > 1024 then k = l else k = 1024
finish
move block(delmax+1-oldgaplim,oldgaplim,oldgaplim-k)
gaplim = gaplim-k; oldgaplim = oldgaplim-k
cur_lim = cur_lim-k
newlim = newlim-k; delmax = delmax-k
l = k if k < l
finish
move(l,oldgaplim,delmax+1)
oldgaplim = oldgaplim+l; delmax = delmax+l
repeat until oldgaplim = gaplim
end
routine ALTER
!Note min/max for alteration in situ
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
if fp < altmin start
altmin = fp
altline = cur_line; gapline = altline
finish
if fp > altlim start
altlim = fp; altlimlbeg = cur_lbeg
finish
end
!
routine SPLIT
!Create gap ahead of FP
integer j
if fp # gaplim start
update if altlim # floor
store deletions if oldgaplim < gaplim
foundpos = 0 if foundpos < fp < foundpos+foundsize
if cur_start <= fp < gapstart start; !fp in upper half
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
j = gapstart-fp; !amount to shift down
gapstart = gapstart-j; gaplim = gaplim-j
move block(j,gapstart,gaplim)
finish else start; !fp in lower half (old or new)
j = fp-gaplim
move block(j,gaplim,gapstart)
gapstart = gapstart+j; gaplim = gaplim+j
finish
oldgaplim = gaplim; oldgapstart = gapstart
finish
if gapstart < altmin start
altmin = gapstart
altline = cur_line; gapline = altline
finish
if gaplim > altlim start
altlim = gaplim; altlimlbeg = cur_lbeg
finish
end
!
routine BREAK
!Break line in two (SPLIT already called)
byteinteger(gapstart) = nl; gapstart = gapstart+1
joins = joins-1
markline = markline+1 if markline >= cur_line
cur_line = cur_line+1; gapline = gapline+1
cur_lbeg = fp
make room if oldgaplim+gdiff-gapstart < mingap
end
!
routine CONSOLIDATE
integer l
! Before moving back etc, ensure that the gap lies on a
! line boundary by copying up the remainder of a split line
! or inserting a newline at end of file
return if sin # 0
if gapstart # cus_start and byteinteger(gapstart-1) # nl start
store deletions if oldgaplim < gaplim
if gaplim # cur_lim start; !not at end of file
l = gaplim
l = l+1 until byteinteger(l-1) = nl
l = l-gaplim
move block(l,gaplim,gapstart)
gapstart = gapstart+l; gaplim = gaplim+l
finish else start
alter; !to update ALTMIN
break
finish
oldgapstart = gapstart; oldgaplim = gaplim
finish
end
!
routine SET LEND
!$IF APM
{ read file %if fp = cur_lim
!$FINISH
lend = fp
if lend # cur_lim start
lend = lend+1 while byteinteger(lend) # nl
finish
end
!
routine SET LBEG
!Establish line start position
cur_lbeg = fp
cycle
if cur_lbeg = gaplim start
return if gapstart = cur_start or byteinteger(gapstart-1) = nl
cur_lbeg = gapstart
cycle
cur_lbeg = cur_lbeg-1
repeat until cur_lbeg = cur_start or byteinteger(cur_lbeg-1) = nl
cur_lbeg = cur_lbeg+(gaplim-gapstart)
return
finish
return if cur_lbeg = cur_start or byteinteger(cur_lbeg-1) = nl
cur_lbeg = cur_lbeg-1
repeat
end
!
integerfn LINE AFTER
!Test Move possible and if so perform it
update if altlim # floor
result = 0 if lend = cur_lim
lend = lend+1
lend = gaplim if lend = gapstart
fp = lend; cur_lbeg = fp
!$IF APM
{ read file %if fp = cur_lim
!$FINISH
if lend # cur_lim start
lend = lend+1 while byteinteger(lend) # nl
finish
cur_line = cur_line+1
result = 1
end
!
integerfn LINE BEFORE
!Set FP to end of previous line if there is one
update if altlim # floor
fp = lend if fp > lend
consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg
result = 0 if fp = cur_start
if fp = gaplim start
result = 0 if gapstart = cur_start
fp = gapstart
finish
cur_line = cur_line-1; !there is a line there
fp = fp-1; lend = fp
set lbeg
! consolidate %if cur_lbeg < gaplim <= fp
result = 1
end
!
routine EXTEND LINE
!Append spaces when FP beyond end of line
integer hold
hold = fp-lend; fp = lend
split
while hold > 0 cycle
byteinteger(gapstart) = ' '; gapstart = gapstart+1
cur_lbeg = cur_lbeg-1; hold = hold-1
repeat
end
!
routine INSERT
!Insert text specified by IDEF (not null)
integer pos,lim
pos = idef&posmask; lim = idef>>limshift
if fp > lend start
fp = lend if mac(pos) = nl
extend line
finish else split
make room if oldgaplim+gdiff-gapstart < mingap
cycle
if mac(pos) = nl then break else start
byteinteger(gapstart) = mac(pos)
gapstart = gapstart+1; cur_lbeg = cur_lbeg-1
finish
pos = pos+1
repeat until pos = lim
end
routine OVERWRITE
!Overwrite existing text
! with text specified by IDEF (not null)
integer pos,lim
pos = idef&posmask; lim = idef>>limshift
if fp > lend start
fp = lend if mac(pos) = nl
extend line
finish else split
make room if oldgaplim+gdiff-gapstart < mingap
cycle
if mac(pos) = nl start
make room if oldgaplim+gdiff-gapstart <= mingap
while fp < lend cycle
byteinteger(gapstart) = mac(fp)
gapstart = gapstart+1; fp = fp+1
repeat
if fp # cur_lim start
fp = fp+1; cur_lbeg = fp; set lend
cur_line = cur_line+1; gapline = gapline+1
altlimlbeg = cur_lbeg if altlim < fp
finish
finish else if fp < lend then fp = fp+1 c
else cur_lbeg = cur_lbeg-1
byteinteger(gapstart) = mac(pos)
gapstart = gapstart+1; pos = pos+1
repeat until pos = lim
gaplim = fp; altlim = gaplim if altlim < gaplim
end
routine JOIN
! Erase from FP to end of line AND the line terminator
! (covers Kill, Join, Uncover)
integer j
if fp > lend then extend line else split
j = lend-fp+1
cur_lbeg = cur_lbeg+j; fp = fp+j; gaplim = gaplim+j
joins = joins+1
if altlim < gaplim start
altlim = gaplim; altlimlbeg = altlim
finish
set lend
markline = markline-1 if markline > cur_line
end
!
routine SWITCH
! Switch between main and secondary input
owninteger maingaplim
![Must scarify GAPLIM on switch to secondary input, as it could
![(on Emas) co-incide with secondary pointer (read SHARED)
update if altlim # floor
cur_fp = fp; !store
markpos = 0; !clear marker
sin = sin!!1
if sin # 0 start; !main -> sec
main = cur; cur = sec
if cur_line < 0 start; !indicator for reset
cur_fp = secfile_start
cur_lbeg = cur_fp; cur_start = cur_fp
cur_lim = secfile_lim
cur_line = 1; cur_min = main_bot>>2+1
coerce parameters
cur_win = offscreen; cur_diff = unknown
finish
maingaplim = gaplim; gaplim = cur_start-1; !impossible value
finish else start; !sec -> main
sec = cur; cur = main
gaplim = maingaplim
finish
fp = cur_fp
set lend
end
!
integerfn MATCHED
integer p,pos,lim,k,l
p = fp; pos = mdef&posmask; lim = mdef>>limshift
cycle
k = mac(pos)
result = 0 if k = nl
l = k!!byteinteger(p)
if l # 0 start
result = 0 if l&casemask # 0 or symtype(k)&alphanum = 0
finish
p = p+1; pos = pos+1
repeat until pos = lim
foundpos = fp; foundsize = p-fp
result = 1
end
!
! extract next command
!
execute:
ci = 0
ci = cmax1 if cmax > cmax1
next: s('?'):
ci = ci+1
code = r(ci)_code; ref = r(ci)_ref
num = r(ci)_count
complain("* Alteration not allowed") if sin # 0 and symtype(code)&15 < 8
-> s(code)
!
! 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
!
s(*): ![safety]
!suppress report for simple moves as control key macros
-> read if control >= 0 and def(control) < 127 c
and symtype(def(control))&15 = 10
cat(1,chalf)
printstring(" Failure: ")
print code(code)
if 7 <= symtype(code)&15 <= 9 start; !text matching group
print symbol('''')
pos = mdef&posmask; hold = pos
cycle
print symbol('''') and exit if pos = mdef>>limshift
print symbol('/') and exit if mac(pos) < ' '
print symbol(mac(pos))
pos = pos+1
repeat until pos-hold >= chalf
finish
print symbol(nl)
error = 1
-> ignore
disast:
complain("* Insertion(s) too big")
!
!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(0)
-> ok if num = 1
s('M'): !Move
-> no if line after = 0
fp = fp+margin if lend # cur_lim
-> ok
!
s('}'): !Cursor down
hold = fp-cur_lbeg
-> no if line after = 0
fp = fp+hold if fp # cur_lim
-> ok
s('>'): !Cursor right
-> no if fp-cur_lbeg >= width or lend = cur_lim
fp = fp+1
->ok
!
s('{'): !Cursor up
hold = fp-cur_lbeg
fp = cur_lbeg+hold and -> no if line before = 0
consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg+hold
-> ok
s('#'): !absolute line n
code = 'M'
num = num-cur_line
-> next if num = 0
-> s('M') if num > 0
num = -num; code = 'm'
s('m'): !Move back
-> no if line before = 0
consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg
if num = 0 start; !M-*
consolidate
fp = cur_start; fp = gaplim if fp = gapstart
cur_lbeg = fp; cur_line = 1
set lend
finish
fp = fp+margin
-> ok
!
s('C'): !Case-change with right-shift
-> no if fp >= lend
holdsym = byteinteger(fp)
if symtype(holdsym)&letter # 0 start
alter
holdsym = holdsym!!casebit
byteinteger(fp) = holdsym
altlim = fp+1 if altlim <= fp
finish
!
s('R'): s('l'): !Right-shift
-> no if fp >= lend
fp = fp+1
-> ok
!
s('c'): !Case-change with left-shift
fp = lend if fp > lend
-> no if fp = cur_lbeg
if fp # gaplim then holdsym = byteinteger(fp-1) c
else holdsym = byteinteger(gapstart-1)
if symtype(holdsym)&letter # 0 start
alter
if fp = gaplim start
gaplim = gaplim-1; oldgaplim = gaplim
gapstart = gapstart-1; oldgapstart = gapstart
altmin = gapstart if altmin > gapstart
finish
byteinteger(fp-1) = holdsym!!casebit
altmin = fp-1 if altmin >= fp
finish
s('L'): s('r'): !Left-shift
fp = lend if fp > lend
s('<'): !Cursor Left
consolidate if fp = gaplim
-> no if fp = cur_lbeg
fp = fp-1
-> ok
!
s('E'): !Erase
-> no if fp >= lend
split
cur_lbeg = cur_lbeg+1
fp = fp+1; gaplim = fp
altlim = gaplim if altlim < gaplim
-> ok
!
s('e'): !Erase back
fp = lend if fp > lend
-> no if fp = cur_lbeg
split
cur_lbeg = cur_lbeg+1; gapstart = gapstart-1
if gapstart < altmin start
altmin = gapstart
if gapstart < oldgapstart start
oldgapstart = gapstart; oldgaplim = oldgaplim-1
byteinteger(oldgaplim) = byteinteger(oldgapstart)
finish
finish
-> ok
!
s('V'): !Verify
-> no if fp >= lend
if ref = 0 then obtain match text c
else if ref # '"' then mdef = def(ref)
-> no if mdef # null and matched = 0
-> next
!
s('D'): !Delete
s('T'): !+ Traverse
if ref = 0 then obtain match text c
else if ref # '"' then mdef = def(ref)
fp1 = fp
-> find
!
s('U'): !Uncover
s('F'): !+Find
if ref = 0 then obtain match text c
else if ref # '"' then mdef = def(ref)
fp1 = fp
fp = fp+1 if fp = foundpos
find:
scope = r(ci)_scope; !number of lines to search
-> next if mdef = null
holdsym = mac(mdef&posmask); !first symbol of quoted text
cycle
while fp < lend cycle
if (byteinteger(fp)!!holdsym)&casemask = 0 start
-> found if matched # 0
finish
fp = fp+1
repeat
exit if fp = cur_lim
scope = scope-1
exit if scope = 0
if code # 'U' start
exit if line after = 0
finish else start
fp = fp1; fp = lend if fp > lend; join
finish
fp1 = fp
repeat
fp = fp1
-> no
found:
-> ok if code = 'F'
fp = fp+foundsize and -> ok if code = 'T'
found1:
if code # 'U' start; !'D','d'
split
hold = foundsize
finish else start
hold = fp-fp1; fp = fp1
split; foundpos = fp+hold
finish
cur_lbeg = cur_lbeg+hold; fp = fp+hold; gaplim = gaplim+hold
altlim = gaplim if altlim < gaplim
-> ok
!
s('t'): s('d'):
s('f'): !Find back
fp = lend if fp > lend
scope = r(ci)_scope
if ref = 0 then obtain match text c
else if ref # '"' then mdef = def(ref)
-> next if mdef = null
holdsym = mac(mdef&posmask); !first symbol of quoted text
update
cycle
while fp = cur_lbeg cycle
scope = scope-1
-> no if scope = 0 or line before = 0
repeat
consolidate if fp = gaplim
fp = fp-1
repeat until (byteinteger(fp)!!holdsym)&casemask = 0 c
and matched # 0
-> ok if code = 'f'
fp = fp+foundsize and -> ok if code = 't'
-> found1
!
constinteger termbit=1<<16, lastbit=1<<15, dummy='a'-1
s('Q'): !Query spelling
!$IF APM
{ complain("Dictionary not available")
!$IF EMAS OR VAX
if dict = 0 start
connect dict(dict)
-> ignore if dict = 0
finish
if fp = foundpos and foundsize < 0 start; !already Queried
fp = fp+1 until symtype(byteinteger(fp))&letter = 0
finish
cycle
-> no if fp >= lend and line after = 0
holdsym = byteinteger(fp)
exit if symtype(holdsym)&letter # 0
fp = fp+1
repeat
foundpos = fp; foundsize = -1
fp1 = fp
type = termbit>>10
dictpos = integer(dict+(holdsym!casebit)<<2)
cycle
fp1 = fp1+1; holdsym = byteinteger(fp1)-dummy
exit if holdsym <= 0 or holdsym > 26
-> no if dictpos = 0
dictpos = dictpos+dict
cycle
hold = integer(dictpos)
exit if hold&31 = holdsym
-> no if hold&lastbit # 0
dictpos = dictpos+4
repeat
hold = hold>>5
if hold&31 # 0 start
fp1 = fp1+1
-> qno if hold&31+dummy # byteinteger(fp1)
finish
hold = hold>>5
if hold&31 # 0 start
fp1 = fp1+1
-> qno if hold&31+dummy # byteinteger(fp1)
finish
dictpos = hold>>5&(¬3)
repeat
-> ok if hold&termbit>>10 # 0
qno:
holdsym = byteinteger(fp1)
-> ok if symtype(holdsym)&upperordigit # 0
-> no
!$FINISH
integerfn found closer
integer k
k = byteinteger(fp)+2; k = ')' if k = '('+2
cycle
fp = fp+1
while fp = lend cycle
result = 0 if line after = 0
repeat
result = 1 if byteinteger(fp) = k
if symtype(byteinteger(fp))&opener # 0 start
result = 0 if found closer = 0
finish
repeat
end
s('N'): !Next word/element
-> no if lend = cur_lim
fp = lend if fp > lend
holdsym = byteinteger(fp)
hold = symtype(holdsym)
if hold&alphanum # 0 or holdsym = ' ' start
fp = fp+1 while symtype(byteinteger(fp))&alphanum # 0
cycle
while fp = lend cycle
-> no if line after = 0
repeat
exit if symtype(byteinteger(fp))&alphanum # 0
fp = fp+1
repeat
foundsize = 0
finish else if hold&opener # 0 start
-> no if found closer = 0
foundsize = 1
finish else start
cycle
fp = fp+1
while fp = lend cycle
-> no if line after = 0
repeat
repeat until byteinteger(fp) = holdsym
foundsize = 1
finish
foundpos = fp
-> ok
!
integerfn found opener
integer k
k = byteinteger(fp)-2; k = '(' if k = ')'-2
cycle
while fp = cur_lbeg cycle
result = 0 if line before = 0
repeat
consolidate if fp = gaplim
fp = fp-1
result = 1 if byteinteger(fp) = k
if symtype(byteinteger(fp))&closer # 0 start
result = 0 if found opener = 0
finish
repeat
end
s('n'): !Locate previous word/element
if fp >= lend start
fp = lend; holdsym = ' '
finish else holdsym = byteinteger(fp)
hold = symtype(holdsym)
if hold&alphanum # 0 or holdsym = ' ' start
cycle
while fp = cur_lbeg cycle
-> no if line before = 0
repeat
consolidate if fp = gaplim
exit if symtype(byteinteger(fp-1))&alphanum # 0
fp = fp-1
repeat
cycle
fp = fp-1
exit if fp = cur_lbeg
consolidate if fp = gaplim
repeat until symtype(byteinteger(fp-1))&alphanum = 0
foundsize = 0
finish else if hold&closer # 0 start
-> no if found opener = 0
foundsize = 1
finish else start
cycle
while fp = cur_lbeg cycle
-> no if line before = 0
repeat
consolidate if fp = gaplim
fp = fp-1
repeat until byteinteger(fp) = holdsym
foundsize = 1
finish
foundpos = fp
-> ok
!
s('S'): !Substitute
-> no if fp # foundpos
if foundsize <= 0 start; !following 'N' etc
fp1 = fp
fp1 = fp1+1 until symtype(byteinteger(fp1))&alphanum = 0
foundsize = fp1-fp
finish
split
cur_lbeg = cur_lbeg+foundsize; fp = fp+foundsize; gaplim = fp
altlim = gaplim if altlim < gaplim
!
s('I'): !+Insert
-> no if fp-cur_lbeg > width and code # 'S'
if ref = 0 start
-> over if fp >= lend
vgap = wcols - (lend-cur_lbeg+mark)
vgap = 10 if vgap < 10
alter
display(0)
obtain insert text(inserting)
!Must ensure update to remove added spaces
if idef = null then alter else insert
altlim = lend+1; altlimlbeg = altlim
->controlterm if term # ret
finish else start
idef = def(ref) if ref # '"'
-> next if idef = null
insert
finish
-> ok
!
!Recovery commands
s('o'): !Overwrite back
-> no if gapstart <= oldgapstart and gaplim <= oldgaplim
if fp # gaplim start
update if altlim # floor
fp = gaplim
cur_line = gapline; set lbeg; set lend
finish
split
if gapstart > oldgapstart start
gapstart = gapstart-1
if byteinteger(gapstart) = nl start
joins = joins+1
cur_line = cur_line-1; altline = cur_line
finish
set lbeg; altmin = gapstart
finish
-> ok if gaplim <= oldgaplim
fp = fp-1; gaplim = fp
cur_lbeg = cur_lbeg-1
-> ok if byteinteger(fp) # nl
joins = joins-1; lend = fp
set lbeg
-> ok
!
s('i'): !Insert back
split
store deletions if oldgaplim < gaplim
! %if oldgaplim < gaplim %start; !FP was at deletion site
! -> no %if byteinteger(fp-1) = nl
! %finish %else %start
-> no if byteinteger(delmax) = nl
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
oldgaplim = oldgaplim-1; !=GAPLIM & FP
byteinteger(oldgaplim) = byteinteger(delmax)
delmax = delmax-1
! %finish
fp = fp-1; gaplim = fp
cur_lbeg = cur_lbeg-1
-> ok
!
s('g'): !Get back
split
store deletions if oldgaplim < gaplim
make room if oldgaplim+gdiff-gapstart < mingap
! %if oldgaplim < gaplim %start
! %cycle
! fp = fp-1
! joins = joins-1 %and lend = fp %if byteinteger(fp) = nl
! %repeat %until fp = oldgaplim %or byteinteger(fp-1) = nl
! %finish %else %start
delmax = delmax-1 while byteinteger(delmax) # nl
-> no if delmax = newlim
!$IF EMAS
{ copy across %if gdiff # 0
!$FINISH
joins = joins-1; lend = fp-1
cycle
fp = fp-1; byteinteger(fp) = byteinteger(delmax)
delmax = delmax-1
repeat until byteinteger(delmax) = nl
oldgaplim = fp
! %finish
gaplim = fp
altmin = fp; set lbeg
-> ok
!
s('O'): !Overwrite
-> no if fp-cur_lbeg > width
over:
if ref = 0 start
display(0)
obtain insert text(overwriting)
if idef = null then alter else overwrite
altmin = fp; altlim = lend; !safe assumption
-> controlterm if term # ret
finish else start
idef = def(ref) if ref # '"'
-> next if idef = null
overwrite
finish
-> ok
!
!!!!!!!!!!!!!!!!!!!!!! Data entry mode !!!!!!!!!!!!!!!!!!!!!!
data entry:
cycle
display(0)
if newprom # curprom start
curprom = newprom
cat(0,0); printstring(curprom)
finish
obtain insert text(overwriting)
if idef # null start
-> qread if sin # 0 or lend = cur_lim
overwrite
if traildels # 0 then altlim = fp+traildels c
else altlim = floor and altmin = ceiling; !up-to-date
finish
exit if term # ret
hold = line after
fp = fp+margin if lend # cur_lim
repeat
controlterm:
control = term; fpsym = 0
-> again
!
!!!!!!!!!!!!!!!!!!!!!!! end of data entry !!!!!!!!!!!!!!!!!!!!!
s('G'): !Get (line from terminal)
update and consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg
if ref = 0 start
split
if video # 0 start
if video < 0 start
display(0)
fprow = cur_line-cur_diff
scroll(fprow,cur_bot+1,-1)
curprom = ""; !lost it
finish else start; !Simulate Break & Move back
!SPLIT already done
break
update
fp = gapstart-1; cur_lbeg = fp
cur_line = cur_line-1
display(0)
fprow = cur_line-cur_diff
gapstart = gapstart-1
fp = gaplim; cur_lbeg = fp
finish
finish else printsymbol(':')
obtain insert text(getting)
if term < 0 start
term = term+256
if video # 0 start
if video < 0 start
scroll(fprow,cur_bot+1,1)
finish else start
alter; !to set ALT...
joins = joins+1
finish
finish
term = ret and -> no if term = ':'
-> controlterm
finish
insert if idef # null
break
altlim = floor; altmin = ceiling; !screen up-to-date
joins = 0
if video < 0 start; !bring back
if fprow = cur_bot start
cur_win = cur_win-1 if cur_win > cur_top
cur_diff = cur_diff+1
scroll(cur_top,cur_bot+1,1)
finish else if edmode >= 0 start
cat(0,0); clear line
finish
finish
-> controlterm if term # ret
finish else start
idef = def(ref) if ref # '"'
insert if idef # null
break
finish
-> ok
!
s('B'): !Break
fp = lend if fp > lend
num = 66 if num = 0 or num > 66
split
make room if oldgaplim+gdiff-gapstart < mingap
break
-> ok
!
s('k'): !Kill back
update if altlim # floor
consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg
-> no if fp = cur_start or (fp = gaplim and gapstart = cur_start)
cur_line = cur_line-1; !there is a line there
split
cycle
gapstart = gapstart-1
if gapstart < oldgapstart start
oldgapstart = oldgapstart-1; oldgaplim = oldgaplim-1
byteinteger(oldgaplim) = byteinteger(oldgapstart)
finish
repeat until gapstart = cur_start or byteinteger(gapstart-1) = nl
altmin = gapstart; joins = 1
-> ok
s('K'): !Kill
-> no if lend = cur_lim
consolidate if cur_lbeg < gaplim <= fp
fp = cur_lbeg
join
-> ok
!
s('J'): !Join
fp = lend if fp < lend
-> no if lend = cur_lim or fp-cur_lbeg > width
join
-> ok
!
constinteger true=1,false=0
integerfn ADJUSTED
integer size
fp1 = cur_lbeg+margin
fp = lend and result = true if fp1 >= lend; !blank line ->
fp = fp1 if fp < fp1
cycle
fp1 = fp; !last boundary
fp = fp+1 while byteinteger(fp) = ' '
fp = fp+1 while byteinteger(fp) > ' '
size = fp-cur_lbeg
if size > width start
result = false if byteinteger(fp1) # ' '
fp = fp1
result = true
finish
if fp = lend start
fp1 = fp+1
fp1 = gaplim if fp1 = gapstart
result = false if fp1 = cur_lim
foundpos = fp1
fp1 = fp1+1 while byteinteger(fp1) = ' '
result = false if byteinteger(fp1) = nl or fp1-foundpos < margin
foundpos = fp1
fp1 = fp1+1 until byteinteger(fp1) <= ' '
foundsize = fp1-foundpos; size = size+1+foundsize
result = true if size > width
split
join
byteinteger(gapstart) = ' '; gapstart = gapstart+1
move(foundsize,foundpos,gapstart)
gapstart = gapstart+foundsize; oldgapstart = gapstart
fp = foundpos+foundsize
gaplim = fp; oldgaplim = gaplim
altlim = gaplim if altlim < gaplim
cur_lbeg = fp-size
finish
repeat
end; !ADJUSTED
s('A'): !Adjust
type = adjusted
if fp = lend start; !break position is at end of line
-> no if line after = 0
finish else start
split
fp = fp+1; gaplim = fp; !erase space
oldgaplim = gaplim; altlim = gaplim if altlim < gaplim
break
hold = 0
while hold < margin cycle
byteinteger(gapstart) = ' '; gapstart = gapstart+1
hold = hold+1
repeat
oldgapstart = gapstart
cur_lbeg = fp-margin
finish
-> ok if type # 0
-> no
!
s('@'): !'at' Column NUM
-> fail if lend = cur_lim
hold = width-(lend-fp)
num = hold if hold < num
hold = fp-cur_lbeg-num
-> next if hold = 0
fp = fp-hold and -> next if fp >= lend and fp-hold >= lend
split
make room if oldgaplim+gdiff-gapstart < mingap
cycle
if hold < 0 start; !left of it
byteinteger(gapstart) = ' '; gapstart = gapstart+1
cur_lbeg = cur_lbeg-1; hold = hold+1
finish else start
-> fail if fp = cur_lbeg or byteinteger(gapstart-1) # ' '
gapstart = gapstart-1; cur_lbeg = cur_lbeg+1
altmin = gapstart if altmin > gapstart
hold = hold-1
finish
repeat until hold = 0
-> next
!
routine put number(integer v)
put number(v//10) and v = v-v//10*10 if v >= 10
byteinteger(gapstart) = v+'0'
gapstart = gapstart+1; cur_lbeg = cur_lbeg-1
end
s('-'):
s('+'): !Increment Number
cycle
-> no if fp = lend
exit if symtype(byteinteger(fp)) = digit
fp = fp+1
repeat
split
hold = 0
cycle
hold = hold*10+byteinteger(fp)-'0'
fp = fp+1; cur_lbeg = cur_lbeg+1
repeat until symtype(byteinteger(fp)) # digit
gaplim = fp; altlim = gaplim if altlim < gaplim
if code = '-' start
hold = hold-num; hold = 0 if hold < 0
finish else hold = hold+num
put number(hold)
-> next
s('^'): !Set Marker
fp = lend if fp > lend
markpos = fp; markline = cur_line
if sin = 0 start
store deletions if oldgaplim < gaplim
oldgapstart = gapstart
finish
-> ok
!
s('='):
-> no if markpos = 0
consolidate
fp = markpos; cur_line = markline
markpos = 0
set lbeg; set lend
-> ok
s(':'): !Define macro
fp1 = markpos
if fp1 # 0 start
hold = distance(fp1,fp)
if hold < 0 start
hold = -hold
fp1 = fp
finish
markpos = 0
finish else start
-> no if fp # foundpos
if foundsize <= 0 start; !following 'N' etc
fp1 = fp
fp1 = fp1+1 until symtype(byteinteger(fp1))&alphanum = 0
foundsize = fp1-fp
finish
fp1 = fp; hold = foundsize
finish
scope = r(ci)_scope
release(scope)
compress(hold) if macbound-macfree < hold
def(scope) = (macfree+hold)<<limshift+macfree
while hold > 0 cycle
mac(macfree) = byteinteger(fp1)
macfree = macfree+1; fp1 = fp1+1
fp1 = gaplim if fp1 = gapstart
hold = hold-1
repeat
-> next
!
s('$'): !switch inputs
fp1 = markpos
switch
if sin = 0 and fp1 # 0 and fp1 # sec_fp start
hold = sec_fp
hold = fp1 and fp1 = sec_fp if fp1 > hold
if fp > lend start
fp = lend if byteinteger(fp1) = nl
extend line
finish else split
make room if oldgaplim+gdiff-gapstart < mingap
cycle
if byteinteger(fp1) = nl then break else start
byteinteger(gapstart) = byteinteger(fp1)
gapstart = gapstart+1; cur_lbeg = cur_lbeg-1
finish
fp1 = fp1+1
repeat until fp1 = hold
finish
-> next
!
! C o m m a n d i n p u t
!
routine GET SYM
!Extract next command input symbol
!Deal with macro termination
if pend # 0 start
sym = pend; pend = 0
finish else start
while inpos >= inlim cycle
sym = ret and return if msp = 0
msp = msp-1
! inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift
inlim = mstack(msp); inpos = inlim&posmask; inlim = inlim>>limshift
repeat
sym = mac(inpos); inpos = inpos+1
finish
end
!
routine GET NAME(string(maxname)name s)
!First symbol in SYM
s = ""
while ' ' <= sym < 127 cycle
s = s.tostring(sym) if length(s) < maxname
get sym
repeat
cat(1,0); !in case of error-report
end
constinteger nomac=-1, first=0, normal=1
routine GET CODE(integer mode)
! Read command unit to CODE, classifying in TYPE
! Expand macros if MODE >= 0 / Leading element if MODE = 0
integer k
cycle
get sym until sym # ' '
code = sym
if sym < ' ' start; !control
type = 1
return if mode > 0; !non-initial
code = term
finish
!Test for printing char version of control sequence
if code = '&' start; !control shift
get sym; -> err if sym < '@'
code = sym&31
if code = esc start
get sym
if sym = '?' start; !canonical 2nd leadin
get sym; sym = sym!!96
finish
code = sym+128
finish
finish
k = def(code)
return if mode = nomac
exit if k < macro; !not macro
macpush(k)
mode = normal
repeat
pend = k>>8; code = k&255
type = symtype(code)&15
return
err:
type = 1; code = ' '
end
!
routine GET TEXT
integer pos,lim
if sym = '!' start
if msp # 0 start; !dummy parameter
pos = inpos; lim = inlim
msp = msp-1
inpos = mstack(msp)&posmask; inlim = mstack(msp)>>limshift
get sym if inpos # inlim
get text
mstack(msp) = inlim<<limshift+inpos
msp = msp+1
inpos = pos; inlim = lim
return
finish
ref = 0
finish else if sym = '"' or 'X' <= sym&95 <= 'Z' start; !text macro
ref = sym
finish else start
ref = nullref; ref = 0 if num # 0; !Insert,etc
return if symtype(sym) # 3; !not valid quote ->
ref = nullref
hold = sym; pos = tlim
cycle
get sym
if sym < ' ' start; !closing quote omitted
return if num = 0; !allowed only for I,S
pend = sym; sym = hold
finish
exit if sym = hold
return if tlim >= textlim; !**
mac(tlim) = sym; tlim = tlim+1
repeat
if tlim # pos start; !not null
def(reflim) = tlim<<limshift+pos
ref = reflim; reflim = reflim+1
finish
finish
get sym
end
routine NUMBER
!Test for numeric item
if symtype(sym)&15 = 0 start
type = 0; num = 0
if sym = '*' then get sym else start
cycle
num = num*10+sym-'0' if num < 100000
get sym
repeat until not '0' <= sym <= '9'
finish
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
!
routine SET OPTIONS
integer i,k
constinteger showpointer=4
conststring(15)array text(0:optmax) =
"Case-matching [",
"Line width [",
"Left margin [",
"Min. window [",
"Show position [",
"Update ["
routine SHOW(integer i)
integer j
j = value(i)
if numeric>>i&1 # 0 then write(j,0) else start
k = 1
while i > 0 cycle
i = i-1; k = k+1
k = k+1 if numeric>>i&1 = 0
repeat
print string(optname(k+j))
finish
end
cat(1,0)
printstring( "RETURN to step through value or 'x' to alter ':' to exit")
print symbol(nl)
cycle
for i = 0,1,optmax cycle
cat(0,0)
printstring(text(i))
minwin = cur_min; !relevant current setting
show(i)
printstring("] :")
clear line
read line
get sym
if sym # ret start
if sym = ':' start
save command; !ie last shown
return
finish
num = 0
while sym >= ' ' cycle
num = num*10+sym-'0' if '0' <= sym <= '9'
get sym
repeat
if numeric>>i&1 # 0 start
value(i) = num
if cur_min # minwin start
cur_min = minwin
cur_win = offscreen; cur_diff = unknown
finish
finish else start
value(i) = value(i)!!1
cur_diff = unknown if i = showpointer
finish
coerce parameters
i = i-1
finish
repeat
repeat
end; !set options
routine DEFINE(integer k)
integer m,n,pos
complain("RETURN cannot be re-defined") if k = ret
complain(tostring(k)." cannot be re-defined") unless k < ' ' c
or 'X' <= k <= 'Z' or 'a' <= k <= 'z' or k >= 128
release(k)
compress(128) if macbound-macfree < 128
get sym until sym # ' '
n = 0
if sym = '"' start
n = comlim-combase
move(n,mac0+combase,mac0+macfree); macfree = macfree+n
finish else start
get sym if sym = '='; !optional
if sym < ' ' start; !no text
if k < ' ' and term # ret and term < ' ' then def(k) = term c
else def(k) = ' '
return
finish
inpos = inpos-1
finish
pos = inpos
inpos = inpos+1 while inpos < inlim and mac(inpos) >= ' '
m = inpos-pos
move(m,mac0+pos,mac0+macfree); macfree = macfree+m
def(k) = macfree<<limshift+(macfree-n-m)
end
routine EXPLAIN(integer k)
!K is initial symbol (NOMAC)
integer m,control,back
conststring(35)array text(' ':127) =
"undefined",
"prefix for system command",
"'ditto' text parameter",
"Move to absolute line n",
"Switch between input files",
"prefix for Special command",
"prefix for control character",
"a possible text delimiter",
"left parenthesis",
"right parenthesis",
"repeat indefinitely",
"Increment Number",
"separator for alternatives",
"back",
"a possible text delimiter",
"a possible text delimiter",
"repeat indefinitely",
"repeat once",
"repeat twice",
"repeat three times",
"repeat four times",
"repeat five times",
"repeat six times",
"repeat seven times",
"repeat eight times",
"repeat nine times",
"Define Macro letter",
"reserved",
"Cursor Left",
"Revert to Marker",
"Cursor Right",
"ignore failure condition",
"Align to column position",
"Adjust line length",
"Break line in two",
"Case-change character",
"Delete text",
"Erase character",
"Find text",
"Get text as complete line",
"reserved",
"Insert text",
"Join next line to this",
"Kill (delete current line)",
"move Left one character",
"Move to next line",
"locate Next word",
"Overwrite with text",
"Print line",
"Query form",
"move Right one character",
"Substitute text",
"Traverse text",
"Uncover (delete up to) text",
"Verify text",
"reserved",
"undefined macro",
"undefined macro",
"undefined macro",
"reserved",
"invert failure condition",
"reserved",
"Set Marker",
"reserved",
"reserved",
"reserved",
"reserved",
"Case-change character backwards",
"reserved",
"Erase character backwards",
"Find text backwards",
"Get back - recover deleted line",
"reserved",
"Insert back - recover character",
"reserved",
"Kill previous line",
"move Right one character",
"Move to previous line",
"Next word backwards",
"Overwrite back (recover)",
"Print previous line",
"reserved",
"move Left one character",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"reserved",
"Cursor Up",
"reserved",
"Cursor Down",
"reserved",
"illegal"
cat(1,0)
m = def(k)
control = 0; control = 1 unless ' ' <= k < del
if control # 0 or (m >= macro and sym < ' ') start; !macro (alone)
print symbol(k) if control = 0
print symbol('=')
print symbol(' ')
if m >= macro start; !defined macro
macpush(m)
get sym; k = sym; m = def(k)
get sym
finish
finish
back = 0
if 'A' <= m <= 'W' and sym = '-' start
m = m+casebit; get sym; back = 1
finish
if sym >= ' ' start; !not single command letter
print symbol(k)
print symbol('-') if back # 0
cycle
print symbol(sym)
get sym
repeat until sym < ' '
print symbol('/') and msp = 0 if msp # 0
finish else if control # 0 and m = '¬' start
print string("¬ : Swop between command/data modes")
finish else if control # 0 and m = '1' start
printstring("1 : repeat last command line")
finish else start
print code(m&255)
k = m>>8
if k # 0 start
if k # '0' start
printsymbol(k)
finish else start
printstring("* (ie ")
print code(m&255)
printstring(" indefinitely)")
finish
finish else start
printstring(" : "); printstring(text(m))
finish
finish
print symbol(nl)
end; !explain
routine OUTPUT KEYDEFS
integer i,j,kk,sym
for kk = 0,1,255 cycle
i = def(kk)
if i >= macro start
print symbol('%'); print symbol('K')
sym = kk
if sym < ' ' or sym >= 128 start
print symbol('&'); sym = sym+64
if sym >= 128 start
sym = kk&127
print symbol('['); !ESC
print symbol('?') and sym = sym!!96 if sym < 64
finish
finish
print symbol(sym); print symbol('=')
j = i>>limshift; i = i&posmask
while i # j cycle
print symbol(mac(i)); i = i+1
repeat
print symbol(nl)
finish
repeat
end
routine ECHO COMMAND
integer pos
cat(1,0)
if control < 0 start
printstring(curprom)
pos = combase
while pos < comlim cycle
print symbol(mac(pos)); pos = pos+1
repeat
clear line
finish
end
!
! I n i t i a l i s a t i o n
!
edistart:
lastcell_code = ')'; lastcell_count = 1
!Stored text pointers
comlim = combase
tlim1 = 0
mac0 = addr(mac(0))
!File pointers
cur_start = new_start
gapstart = cur_start; oldgapstart = gapstart
cur_lbeg = old_start; fp = cur_lbeg
gaplim = fp; oldgaplim = gaplim
cur_lim = old_lim
!$IF VAX
newlim = cur_lim
!$IF EMAS
{ newlim = new_lim-1024
{ gdiff = newlim-cur_lim
!$IF APM
{ newlim = new_lim-1024
!$FINISH
delmax = newlim; byteinteger(delmax) = nl if delmax > 0
set lend
altlim = floor; ! < any NEW pointer
altmin = ceiling; ! > any NEW pointer
!Line numbers
cur_line = 1
sec_line = -1; !indicator for reset
!
!Initialise video info
![!! so that VMODE can, awkwardly, suppress]
vmode = vmode!!screenmode!!specialpad
vmode = 0 if vdu_fun = 0
set video mode(vmode)
set windows
cur_bot = wrows-1
cur_min = minwin
cur_diff = unknown
coerce parameters
cat(1,0); printstring(message)
!
! R e a d n e w c o m m a n d l i n e
!
comread: !Read command file if present
if pre # "" start
open in(pre)
finish
resetread:
pre = ""
inpos = inlim; msp = 0
read:
if markpos = 0 then newprom = prom(sin) c
else newprom = prom(sin+2)
-> data entry if edmode >= 0
pend = 0; fpsym = 0; control = -1
if inpos = inlim start; !no input available
if commandstream = 0 start; !on-line
prepare for input
if newprom # curprom or video = 0 start
curprom = newprom
cat(0,0); printstring(curprom)
finish
cat(0,2); clear line
finish
read line
control = term if inpos = inlim
finish
!Reset command variables
again:
chain = 0; cmax = cmax1
!If last match and insert text strings are within text
! string area, they could be overwritten: so they are
! moved to the reserved match and insert sections
![could re-assign instead?]
if mdef < textlim<<limshift start
hold = mdef>>limshift; mdef = mdef&posmask; hold = hold-mdef
move(hold,mac0+mdef,mac0+matchbase)
mdef = hold<<limshift+(matchbase<<limshift+matchbase)
finish
if idef < textlim<<limshift start
hold = idef>>limshift; idef = idef&posmask; hold = hold-idef
move(hold,mac0+idef,mac0+insertbase)
idef = hold<<limshift+(insertbase<<limshift+insertbase)
finish
!
get code(first)
if control >= 0 start; !control key
if code = '¬' start; !toggle editing mode
edmode = ¬edmode
restore fpsym
-> resetread
finish
finish else if code = '-' start
def(ret) = def(ret)!!casebit; !toggle direction
control = term if inpos = inlim
get code(first)
finish
-> read if type = 1
if type = 0 start; !repetition number
sym = code; number
-> er2 if sym >= ' '
def(ret) = 'M'
-> read if cmax = 0; !no command to repeat
r(cmax)_count = num
-> restore
finish
if code = '%' start
get sym; code = sym
sym = sym&95
->er2 if code < 'A'
get sym until sym # ' '
get sym if sym = '='
-> pc(code&95)
finish
if control < 0 start; !not control key
def(ret) = 'M'
cmax = 0; tlim1 = 0; reflim1 = 128
comlim = combase; combase = freebase; freebase = comlim
comlim = inlim1
finish
!
! C o m m a n d i n p u t: m a i n l o o p
ci = cmax; tlim = tlim1; reflim = reflim1
more: !(command code has been get)
-> er5 if type < 4
-> er0 if type < 8 and newlim <= 0; !no changes when Showing
ci = ci+1; -> er6 if ci >= cbound
num = 1; scope = 0; ref = 0; !defaults
get sym; !next symbol without mapping
if sym = '-' start
code = code!casebit; type = symtype(code)&15
-> er5 if type < 4
code = '-' if code = '+'
get sym
finish
-> c(type)
c(8): !Find
num = 0
c(7): !+ Delete, Uncover
c(9): !+ Traverse, Verify
number
scope = num
num = 0; !as indicator (not I,O,S,G)
c(6): !+ Insert, Overwrite,
! Substitute, Get
get text
-> er4 if ref = nullref and num = 0
num = 1; !restore default
c(5): !Erase, Get, etc
c(10): !+ Move, Next, Print
number
-> put
c(11): !open bracket, comma
ref = chain; chain = ci
-> put
c(13): !:
-> erq unless 'X' <= sym&95 <= 'Z'
scope = sym
get sym
-> put
c(14): !close bracket
unchain; -> er3 if ref = 0
number
r(ref)_count = num
c(15): !invert, query
put:
r(ci)_code = code; r(ci)_ref = ref
r(ci)_scope = scope; r(ci)_count = num
pend = sym; get code(normal)
-> more unless type = 1
ci = ci+1; cmax = ci
r(ci) = lastcell
unchain; -> er3 if ref # 0
if control < 0 start; !not control key
cmax1 = cmax; tlim1 = tlim; reflim1 = reflim
if cscroll = 0 start; !can't scroll command window
echo command if video # 0
finish else start
save command
finish
error = 0
finish
restore:
if error # 0 start
cat(1,chalf); clear line
error = 0
finish
sym = ret if sym < ' '
!$IF EMAS OR VAX OR APM
if fpsym >= ' ' start
at(fprow,fpcol)
print symbol(fpsym)
at(fprow,fpcol)
print symbol(0); !to flush & position video cursor
finish
!$FINISH
-> execute
!
routine REPORT(string(255) message)
!Make command error report (to right of command text)
if edmode < 0 start
echo command if cscroll = 0
finish else cat(1,0)
printstring(message)
end
!
er0:
report(" "); print code(code)
print string(" when Showing")
-> erq
er3:
report(" Brackets")
-> erq
er4:
report(" Text for ")
print code(code)
-> erq
er2:
code = sym
pc(*): c(*):
er5:
report(" "); print code(code)
-> erq
er6:
report(" Size")
erq:
print symbol('?')
cmax1 = 0 if ci > 1
print symbol(nl)
save command if edmode < 0 and cscroll # 0; !(else REPORT echoed)
ignore:
close in and commandstream = 0 if commandstream # 0
-> resetread
!
! Percent commands
pc('S'): !Secondary input
switch if sin # 0
if sym >= ' ' start
get name(secfile_name)
connect input(secfile)
secfile_flag = 0
finish
restore fpsym
sec_line = -1
switch if secfile_start # secfile_lim
-> read
pc('G'): !Get command file
get name(pre)
close in and commandstream = 0 if commandstream # 0
-> comread
pc('P'): !Put key definitions
get name(pre)
open out(pre) if pre # ""
pre = ""
output keydefs
close out
-> read
pc('U'): !ignore/heed case
mapcase = 1
mapcase = 0 and get sym if sym = '-'
coerce parameters
-> read
pc('L'): !Line width
number; -> erq if type # 0
width = num
coerce parameters
-> read
pc('M'): !Margin
number; -> erq if type # 0
margin = num
coerce parameters
-> read
pc('D'): !Display
if sym >= ' ' start
number
-> erq if type # 0
cur_min = num
finish
restore fpsym
coerce parameters
qread:
cur_win = offscreen; cur_diff = unknown
curprom = ""
-> read
pc('H'): !Help
restore fpsym
!$IF EMAS
{ set video mode(0)
{ view(helpfile)
{ set video mode(vmode)
{ -> qread
!$IF VAX
complain("Help facility not available")
!$FINISH
pc('E'): !Environment
restore fpsym
set options
-> qread
pc('W'):
delmax = newlim
-> read
pc('X'): pc('Y'): pc('Z'):
if sym >= ' ' start; !definition
pend = sym
define(code)
finish else start; !enquiry
explain(code)
finish
-> read
pc('Q'):
if sym # ret or term # ret start
pend = sym; get code(nomac)
get sym if sym >= ' '
explain(code)
finish else start
cycle
cat(0,0); printstring("Key (or :): "); clear line
read line
get code(nomac)
get sym if sym >= ' '
exit if code = ':'
explain(code)
repeat
finish
curprom = ""
-> read
pc('K'): !define key(s)
if sym # ret or term # ret start
pend = sym; get code(nomac)
if inpos = inlim start
printsymbol('*') unless ' ' <= code < del
read line
finish
get sym until sym # ' '
pend = sym if sym # '='
define(code)
finish else start
cycle
cat(0,0); printstring("Key = defn: "); clear line
read line
get code(nomac)
exit if code = ':'
if inpos = inlim start
printsymbol('*') unless ' ' <= code < del
read line
finish
get sym until sym # ' '
pend = sym if sym # '='
define(code)
repeat
finish
curprom = ""
-> read
pc('A'): !Abandon
if altline # 0 start
printstring(" Abandon complete edit? (y/n) ")
read line
get sym; -> ignore if sym!casebit # 'y'
get sym; -> ignore if sym >= ' '
finish
new_flag = -1; altline = 0
pc('C'): !Close
restore fpsym
switch if sin # 0
consolidate; !in case of insertion at end
new_flag = 1 if altline # 0
new_lim = gapstart
old_start = gaplim; old_lim = cur_lim
pop window; pop window
!$IF EMAS OR VAX
vt at(vdu_rows-1,0)
!$IF APM
{ gotoxy(0,vdu_rows-1)
!$FINISH
clear line; print symbol(rt); !to flush
set video mode(0)
end; !END OF EDI
!
!$IF EMAS
{%externalroutine VECCE(%string(255) parm)
{%integer f,i,same,holesize,tempsize,outhead
{%string(255) heading
{ set parameters(parm)
{ same = 0; same = 1 %if out_name = in_name
{ %if out_name # "" %start
{ f = checkoutputfile(out_name,same)
{ -> errstop %if f # 0
{ %finish
{ connect input(in)
{ f = in_flag
{ -> stop %if f # 0
{ connect input(sec)
{ f = sec_flag
{ -> stop %if f # 0
{ %if out_name # "" %start
{ holesize = 262144
{ %cycle
{ tempsize = in_lim-in_start + sec_lim-sec_start + holesize
{ outfile("T#ETEMP",-tempsize,tempsize,0,outhead,f)
{ %exit %if f=0
{ ->errstop %if holesize = 16384; ! 16k - minimum reasonable
{ holesize = holesize>>1
{ %repeat
{ integer(outhead+12) = 3; !type = character
{ out_start = outhead+32
{ out_lim = out_start+integer(outhead+8)-32
{ %finish
!$IF VAX
integer f,i,same
string(255) heading
set parameters(cliparam)
same = 0; same = 1 if out_name = in_name
if out_name = "" start
connect input(in); !WITHOUT EXTRA
-> stop if in_flag # 0
finish else start
! f = checkquota(out_name)
! %if f&1 = 0 %start
! print string(" *".sysmess(f).": ".out_name)
! -> stop
! %finish
if sec_name # "" start
connect input(sec)
-> stop if sec_flag # 0
in_flag = (sec_lim-sec_start)>>9; !#blocks in sec file
finish
in_flag = in_flag+20; !EXTRA BLOCKS
connect input(in)
-> stop if in_flag # 0
out_start = in_vmstart; out_lim = in_vmlim
finish
!$IF APM
{%integer i,same
{%string(255) heading
{%constinteger STORESIZE=200000
{%byteintegerarray STORE(0:storesize)
{ set parameters("")
{ same = 0; same = 1 %if out_name = in_name
{ out_vmstart = addr(store(0)); out_start = out_vmstart
{ out_vmlim = out_vmstart+storesize; out_lim = out_vmlim
{ connect input(in)
{ %if sec_name # "" %start
{ sec_vmstart = out_vmstart; out_vmstart = out_vmstart+storesize>>2
{ sec_vmlim = out_vmstart-2; ![scared]
{ sec_start = sec_vmlim-2048; sec_lim = sec_start
{ connect input(sec)
{ %finish
{ in_vmstart = out_vmstart; in_vmlim = out_vmlim
{ in_start = in_vmlim-2048; in_lim = in_start
{ open output(2,out_name)
{ select output(0)
!$FINISH
if out_name # "" start
if in_name # "" start
heading = "Editing ".in_name
heading = heading." with ".sec_name if sec_name # ""
heading = heading." to ".out_name if same = 0
finish else start
heading = "Creating ".out_name
finish
finish else start
heading = "Showing ".in_name
finish
!$IF EMAS OR VAX
define video(ttype)
!$FINISH
!
edi(in,sec,out,heading)
!
!OUT_FLAG is negative if edit abandoned, zero if no changes
!$IF EMAS OR VAX
if out_flag < 0 or (out_flag = 0 and same # 0) start
print string(" File unchanged")
out_start = 0
finish
if out_start # 0 start; !file to be written
i = in_lim-in_start; !lower half
move(i,in_start,out_lim); ! concatenated to upper
out_lim = out_lim+i
!$IF EMAS
{ integer(outhead) = out_lim-outhead; !including header
{ sendoutput("T#ETEMP",out_name,f)
{ %if f # 0 %then printstring(" Edited file left in T#ETEMP") %c
{ %else printstring(in_name." edited to ".out_name)
{ %finish
{ -> stop
{errstop:
{ psysmes(73,f) %if f > 0
{stop:
{ newline
{ comreg(24) = f; !return code
{%end; !OF VECCE
{
{%externalroutine V200ECCE(%string(255) parm)
{ ttype = 11; vecce(parm)
{%end
{%externalroutine BECCE(%string(255) parm)
{ ttype = 6; vecce(parm)
{%end
{%externalroutine EECCE(%string(255) parm)
{ ttype = 13; vecce(parm)
{%end
{%externalroutine VSHOW(%string(255) parm)
{ vecce(parm."/.N")
{%end
{
{%externalroutine VRECAP(%string(255) parm)
{%systemroutinespec GET JOURNAL(%stringname file, %integername flag)
{%string(31) file
{%integer flag
{ get journal(file,flag)
{ %if flag = 0 %start
{ %if parm = "" %then vshow(file) %c
{ %else vecce(file."/".parm)
{ %finish
{ %if flag > 0 %then psysmes(75,flag)
{ comreg(24) = flag; !set return code
{%end
{
{%ENDOFFILE
!$IF VAX
cycle
f = writeout(out_name,out_start,out_start,out_lim,in_vmlim)
exit if f = 0
print string(" *".sysmess(f).": ".out_name)
newline
print string(" Please supply alternative file-name: ")
out_name = ""
cycle
read symbol(i)
exit if i = nl
out_name = out_name.tostring(i)
repeat
newline
repeat
printstring(in_name." edited"); newline if length(in_name) > 30
printstring(" to ".out_name)
finish else start
deletevm(in_vmstart,in_vmlim)
finish
deletevm(sec_vmstart,sec_vmlim) if sec_vmstart # 0
stop:
newline
ENDOFPROGRAM
!$IF APM
{ select output(2)
{ i = out_start
{ %while i # out_lim %cycle
{ print ch(byteinteger(i)); i = i+1
{ %repeat
{ i = in_start
{ %while i # in_lim %cycle
{ print ch(byteinteger(i)); i = i+1
{ %repeat
{%routine COPY REST
{%integer k
{%on %event 9 %start
{ %return
{%finish
{%cycle
{ read ch(k)
{ print ch(k)
{%repeat
{%end
{ select input(2)
{ copy rest
{stop:
{%ENDOFPROGRAM
!$FINISH
$ Command: *spool
*.
(14) FM
Drive 0 Option 0 (off )
Dir. :0.$ Lib. :0.$
Ecce HEAP
HmdDoc ImpEcce
STACK
I.STRIP
*type heap
|!h|C|!|?|A|!_|!}|GHEAP 00|!#06|!5U|!-00|!+06|!,[|!R'Z[|!Q|G|!;|!P|!c|!$|!|C|R|!6|!%|R|!C|!&|!|D|!|C|||!|B|!;|!z|P`|!|?|!6`|?|!|¬|!|I`~'#a|!y|C'|W|!|D|!|CU|!,|!|C|!+[|!n'Z|!:|!J[|!l'^|!:|!k|!|F[|!j|G|!:|!e[|!h'^|!:|!_|!|F[|!f|G|!:|!Y|!|F[|!d|G|!:|!S|!|F[|!b|G|!:|!M|!|F[|!`|G|!:|!G|U|!|E|||!|D`?|!|¬|!|E|!|E`|!|B¬|!|F[|!X'^|!:|!|K[|!V'^|!s|!>|!|D[|!S'^|!:|!'|!|E
Escape
*type i.strip
begin { program to strip parity and remove spurious LFs }
integer Sym, Total = 0
Print string ("Starting...".snl)
Open input (1, ":1.ImpEcce")
Open output (1, ":0.I.EcceXX")
cycle
Read symbol (Sym)
Sym = Sym & 16_7f
if Sym = 13 then continue
Print symbol (Sym)
Total = Total + 1
repeat until Sym < 32 and sym # 10 and sym # 13
Close output
Print string ("Terminator is "); Write (Sym, 0); New line
end of program
*drive 2