-- file Edit.mesa
-- last modified by Satterthwaite, 9-Mar-82 14:22:18
DIRECTORY
Ascii: TYPE USING [CR, SP, TAB],
DCSFileTypes: TYPE USING [tLeaderPage],
Directory: TYPE USING [CreateFile, Error, Lookup, UpdateDates, ignore],
Exec: TYPE USING [AddCommand, commandLine, w],
File: TYPE USING [Capability, Permissions, delete, grow, read, shrink, write],
FileStream: TYPE USING [FileByteIndex, Create, EndOf, GetIndex, SetIndex],
Stream: TYPE USING [Handle, Delete, GetChar, PutChar],
TTY: TYPE USING [Handle, GetLine, LineOverflow, PutChar, Rubout];
Edit: PROGRAM
IMPORTS Directory, Exec, FileStream, Stream, TTY = {
-- characters and strings
MAXCHAR: NAT = LAST[CHARACTER] - 0c;
MAXSTR: NAT = 100;
character: TYPE = [-1..MAXCHAR];
string: TYPE = PACKED ARRAY [1..MAXSTR] OF character;
ENDFILE: character = -1;
ENDSTR: character = 0;
BACKSPACE: character = 9;
TAB: character = 9;
NEWLINE: character = 13;
BLANK: character = 32;
ESCAPE: character = ord['@];
-- file descriptors and io-related stuff
MAXOPEN: NAT = 10;
filedesc: TYPE = [0..MAXOPEN];
streamindex: TYPE = FileStream.FileByteIndex;
IOERROR: filedesc = 0;
STDIN: filedesc = 1;
STDOUT: filedesc = 2;
STDERR: filedesc = 3;
IOREAD: INTEGER = 1;
IOWRITE: INTEGER = 2;
IOBOTH: INTEGER = 3;
-- standard (Pascal) procedures
ord: PROC [c: CHARACTER] RETURNS [character] = INLINE {RETURN [c - 0c]};
chr: PROC [c: character] RETURNS [CHARACTER] = INLINE {RETURN [c + 0c]};
-- file primitives
tty: TTY.Handle;
kbdline: STRING ← [MAXSTR];
kbdx: CARDINAL;
kbdend: BOOLEAN;
readkbd: PROC = {
IF (kbdend) THEN
kbdline.length ← 0
ELSE {
ENABLE {
TTY.LineOverflow => {
putcf[NEWLINE, STDERR];
message["*** line too long"L];
putcf[NEWLINE, STDERR];
RETRY};
TTY.Rubout => {
IF (kbdline.length) > 0 THEN
RESUME
ELSE {
kbdend ← TRUE;
CONTINUE}}};
IF (kbdline.length > 0)
AND (kbdline[kbdline.length-1] = Ascii.CR) THEN
kbdline.length ← kbdline.length - 1; -- for ESC
tty.GetLine[kbdline];
IF kbdline.length >= kbdline.maxlength THEN
[] ← ERROR TTY.LineOverflow[kbdline];
kbdline[kbdline.length] ← Ascii.CR;
kbdline.length ← kbdline.length + 1};
kbdx ← 0};
filerec: TYPE = RECORD [
type: {none, stream, tty} ← none,
handle: Stream.Handle ← NIL];
filetab: ARRAY filedesc OF filerec;
accessmap: PROC [mode: INTEGER] RETURNS [File.Permissions] = {
RETURN [SELECT mode FROM
IOREAD => File.read,
IOWRITE => File.write + File.grow + File.shrink + File.delete,
IOBOTH => File.read + File.write + File.grow + File.shrink + File.delete,
ENDCASE => File.read]};
fdalloc: PROC RETURNS [fd: filedesc] = {
-- find a free slot in filetab
FOR fd IN (STDERR .. MAXOPEN] DO
IF (filetab[fd].type = none) THEN EXIT
REPEAT
FINISHED => fd ← IOERROR;
ENDLOOP;
RETURN};
fileerror: ERROR = CODE;
findfile: PROC [name: STRING, access: File.Permissions]
RETURNS [File.Capability] = {
cap: File.Capability;
old: BOOLEAN ← (access = File.read);
IF ~old THEN {
cap ← Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
! Directory.Error => {
IF type = fileAlreadyExists THEN GOTO fileExists
ELSE GO TO fileProblem}];
EXITS
fileExists => old ← TRUE};
IF old THEN
cap ← Directory.Lookup[fileName: name, permissions: Directory.ignore
! Directory.Error => {GO TO fileProblem}];
RETURN [Directory.UpdateDates[cap, access]]
EXITS
fileProblem => ERROR fileerror};
makestream: PROC [name: POINTER TO string, mode: INTEGER, fd: filedesc] = {
i: INTEGER ← 0;
intname: STRING ← [MAXSTR];
WHILE (name[i+1] # ENDSTR) DO
intname[i] ← chr[name[i+1]];
i ← i + 1;
ENDLOOP;
intname.length ← i;
filetab[fd] ← [
type: stream,
handle: FileStream.Create[findfile[intname, accessmap[mode]]]]};
open: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [fd: filedesc] = {
fd ← fdalloc[];
IF fd # IOERROR THEN {
makestream[name, mode, fd ! fileerror => {GOTO fail}];
EXITS fail => {filetab[fd] ← [type: none]; fd ← IOERROR}};
RETURN};
create: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [filedesc] = open;
-- check positioning of files opened for output
close: PROC [fd: filedesc] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
Stream.Delete[h]};
tty => NULL;
ENDCASE => NULL;
filetab[fd] ← [type: none]};
remove: PROC [s: POINTER TO string] = {
-- this version just prints a message
message["If we had remove, we would be deleting "L];
putcf[TAB, STDERR];
putstr[s, STDERR];
putcf[NEWLINE, STDERR]};
getindex: PROC [fd: filedesc] RETURNS [streamindex] = {
RETURN [SELECT filetab[fd].type FROM
stream => FileStream.GetIndex[filetab[fd].handle],
ENDCASE => 0]};
setindex: PROC [i: streamindex, fd: filedesc] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
FileStream.SetIndex[h, i]};
ENDCASE => NULL};
getc: PROC [c: POINTER TO character] RETURNS [character] = INLINE {
RETURN [getcf[c, STDIN]]};
getcf: PROC [c: POINTER TO character, fd: filedesc] RETURNS [character] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
c↑ ← IF FileStream.EndOf[h] THEN ENDFILE ELSE ord[h.GetChar[]]};
tty =>
IF (kbdx < kbdline.length) THEN {
c↑ ← ord[kbdline[kbdx]];
kbdx ← kbdx + 1}
ELSE {
readkbd[];
IF (kbdline.length = 0) THEN -- iff kbdend
c↑ ← ENDFILE
ELSE {
c↑ ← ord[kbdline[kbdx]];
kbdx ← kbdx + 1}};
ENDCASE => error["bad file descriptor"L];
RETURN [c↑]};
getline: PROC [s: POINTER TO string, fd: filedesc, maxsize: INTEGER ← MAXSTR]
RETURNS [BOOLEAN] = {
i: INTEGER ← 1;
c: character;
DO
s[i] ← getcf[@c, fd];
i ← i + 1;
IF (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize) THEN EXIT
ENDLOOP;
IF (c = ENDFILE) THEN -- went one too far
i ← i - 1;
s[i] ← ENDSTR;
RETURN [c # ENDFILE]};
putc: PROC [c: character] = INLINE {putcf[c, STDOUT]};
putcf: PROC [c: character, fd: filedesc] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
h.PutChar[chr[c]]};
tty => tty.PutChar[chr[c]];
ENDCASE => error["bad file descriptor"L]};
putstr: PROC [s: POINTER TO string, fd: filedesc] = {
i: INTEGER ← 1;
WHILE (s[i] # ENDSTR) DO
putcf[s[i], fd];
i ← i + 1
ENDLOOP};
-- string utilities
setstring: PROC [s: POINTER TO string, text: STRING] = {
FOR i: CARDINAL IN [1 .. text.length] DO
s[i] ← ord[text[i-1]] ENDLOOP;
s[text.length+1] ← ENDSTR};
-- errors and messages
message: PROC [msg: STRING] = {
FOR i: CARDINAL IN [0 .. msg.length) DO
putcf[ord[msg[i]], STDERR] ENDLOOP};
exit: ERROR = CODE;
error: PROC [msg: STRING] = {
message[msg]; ERROR exit};
-- command arg primitives
MAXCMD: NAT = 20;
cmdargs: [0 .. MAXCMD];
cmd: ARRAY [1 .. MAXCMD] OF RECORD [idx, len: CARDINAL];
getarg: PROC [n: INTEGER, str: POINTER TO string, maxsize: INTEGER]
RETURNS [BOOLEAN] = {
b: BOOLEAN ← ((n > 0) AND (n <= cmdargs));
IF (b) THEN
commandstr[cmd[n].idx, cmd[n].len, str, 1, maxsize];
RETURN [b]};
nargs: PROC RETURNS [INTEGER] = {RETURN [cmdargs]};
commandstr: PROC [i, n: INTEGER,
dest: POINTER TO string, j: INTEGER, maxsize: INTEGER] = {
WHILE (n > 0) AND (j < maxsize) DO
dest[j] ← ord[Exec.commandLine.s[i]];
i ← i + 1;
j ← j + 1;
n ← n - 1;
ENDLOOP;
dest[j] ← ENDSTR};
-- utilities
-- addstr: put c in outset[j] if it fits, increment j
addstr: PROC [c: character, outset: POINTER TO string,
j: POINTER TO INTEGER, maxset: INTEGER] RETURNS [added: BOOLEAN] = {
IF (j↑ > maxset) THEN
added ← FALSE
ELSE {
outset[j↑] ← c;
j↑ ← j↑ + 1;
added ← TRUE};
RETURN};
-- esc: map s[i↑] into escaped character, increment i↑
esc: PROC [s: POINTER TO string, i: POINTER TO INTEGER] RETURNS [c: character] = {
IF (s[i↑] # ESCAPE) THEN
c ← s[i↑]
ELSE IF (s[i↑+1] = ENDSTR) THEN -- @ not special at end
c ← ESCAPE
ELSE {
i↑ ← i↑ + 1;
IF (s[i↑] = ord['n]) THEN
c ← NEWLINE
ELSE IF (s[i↑] = ord['t]) THEN
c ← TAB
ELSE
c ← s[i↑]};
RETURN};
-- isalphanum: true if c is a letter or digit
isalphanum: PROC [c: character] RETURNS [BOOLEAN] = {
RETURN [
(c IN [ord['a] .. ord['z]])
OR (c IN [ord['A] .. ord['Z]])
OR (c IN [ord['0] .. ord['9]])]};
-- isdigit: true if c is a digit
isdigit: PROC [c: character] RETURNS [BOOLEAN] = INLINE {
RETURN [c IN [ord['0] .. ord['9]]]};
-- itoc: convert integer n to char string in s[i] ...
itoc: PROC [n: INTEGER, s: POINTER TO string, i: INTEGER] RETURNS [next: INTEGER] = {
IF (n < 0) THEN {
s[i] ← ord['-];
next ← itoc[-n, s, i+1]}
ELSE {
IF (n >= 10) THEN
i ← itoc[n/10, s, i];
s[i] ← n MOD 10 + ord['0];
s[i+1] ← ENDSTR;
next ← i+1};
RETURN};
-- mustcreate: create file or die
mustcreate: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [fd: filedesc] = {
fd ← create[name, mode];
IF (fd = IOERROR) THEN {
putstr[name, STDERR];
error[": can't create file"L]};
RETURN};
-- scopy: copy string ar st src[i] to dest[j]
scopy: PROC [src: POINTER TO string, i: INTEGER,
dest: POINTER TO string, j: INTEGER] = {
WHILE (src[i] # ENDSTR) DO
dest[j] ← src[i];
i ← i + 1;
j ← j + 1;
ENDLOOP;
dest[j] ← ENDSTR};
-- ctoi: convert string at s[i] to integer, increment i
ctoi: PROC [s: POINTER TO string, i: POINTER TO INTEGER] RETURNS [INTEGER] = {
n, sign: INTEGER;
WHILE (s[i↑] = BLANK) OR (s[i↑] = TAB) DO
i↑ ← i↑ + 1 ENDLOOP;
sign ← IF s[i↑] = ord['-] THEN -1 ELSE 1;
IF (s[i↑] = ord['+]) OR (s[i↑] = ord['-]) THEN
i↑ ← i↑ + 1;
n ← 0;
WHILE (isdigit[s[i↑]]) DO
n ← 10*n + (s[i↑] - ord['0]);
i↑ ← i↑ + 1;
ENDLOOP;
RETURN [sign * n]};
-- putdec: put decimal integer n in field width >= w
putdec: PROC [n, w: INTEGER] = {
s: string;
nd: INTEGER = itoc[n, @s, 1];
FOR i: INTEGER IN [nd .. w] DO
putc[BLANK] ENDLOOP;
FOR i: INTEGER IN [1 .. nd-1] DO
putc[s[i]] ENDLOOP};
-- edittype: types for in-memory version of edit
stcode: TYPE = {ENDDATA, ERR, OK}; -- status returns
-- editcons: const declarations for edit
MAXLINES: NAT = 1000;
MAXPAT: NAT = MAXSTR;
CLOSIZE: NAT = 1; -- size of a closure entry
DITTO: character = -1;
CLOSURE: character = ord['*];
BOL: character = ord['%];
EOL: character = ord['$];
ANYCHAR: character = ord['?];
CCL: character = ord['[];
CCLEND: character = ord[']];
NEGATE: character = ord['↑];
NCCL: character = ord['!]; -- cannot be the same as NEGATE
LITCHAR: character = ord['c];
CURLINE: character = ord['.];
LASTLINE: character = ord['$];
SCAN: character = ord['/];
BACKSCAN: character = ord['\\];
SEMICOL: character = ord[';];
COMMA: character = ord[',];
PERIOD: character = ord['.];
ACMD: character = ord['a];
CCMD: character = ord['c];
DCMD: character = ord['d];
ECMD: character = ord['e];
EQCMD: character = ord['=];
FCMD: character = ord['f];
GCMD: character = ord['g];
ICMD: character = ord['i];
MCMD: character = ord['m];
PCMD: character = ord['p];
QCMD: character = ord['q];
RCMD: character = ord['r];
SCMD: character = ord['s];
WCMD: character = ord['w];
XCMD: character = ord['x];
-- editvar: variables for edit
line1: INTEGER; -- first line number
line2: INTEGER; -- second line number
nlines: INTEGER; -- # of line numbers specified
curln: INTEGER; -- current line, value of dot
lastln: INTEGER; -- last line, value of $
pat: string; -- pattern
lin: string; -- input line
savefile: string; -- remembered file name
-- editprim: editor buffer primitives
buftype: TYPE = RECORD [ -- scratch-file edit buffer entry
txt: streamindex, -- file index for text of line
mark: BOOLEAN]; -- mark for line
buf: ARRAY [0..MAXLINES] OF buftype;
scr: filedesc; -- scratch fd
recout: streamindex; -- next record to write on scr
edittemp: string; -- temp file name "edit.scratch$"
setbuf: PROC = {
-- setbuf (scratch file): create scratch file, set up line 0
setstring[@edittemp, "edit.scratch$"L];
scr ← mustcreate[@edittemp, IOBOTH];
recout ← 0;
curln ← 0;
lastln ← 0};
clrbuf: PROC = {
-- clrbuf (scratch file): dispose of scratch file
close[scr];
remove[@edittemp]};
gettxt: PROC [n: INTEGER, s: POINTER TO string] = {
-- gettext (scratch file): get text from line n into s
IF (n = 0) THEN
s[1] ← ENDSTR
ELSE {
setindex[buf[n].txt, scr];
[] ← getline[s, scr, MAXSTR]}};
blkmove: PROC [n1, n2, n3: INTEGER] = {
-- blkmove: move block of lines n1..n2 to follow n3
IF (n3 < n1-1) THEN {
reverse[n3+1, n1-1];
reverse[n1, n2];
reverse[n3+1, n2]}
ELSE IF (n3 > n2) THEN {
reverse[n1, n2];
reverse[n2+1, n3];
reverse[n1, n3]}};
reverse: PROC [n1, n2: INTEGER] = {
-- reverse: reverse buf[n1]...buf[n2]
WHILE (n1 < n2) DO
temp: buftype = buf[n1];
buf[n1] ← buf[n2];
buf[n2] ← temp;
n1 ← n1 + 1;
n2 ← n2 - 1
ENDLOOP};
puttxt: PROC [lin: POINTER TO string] RETURNS [stat: stcode] = {
-- puttxt (scratch file): put text from lin after curln
stat ← ERR;
IF (lastln < MAXLINES) THEN {
lastln ← lastln + 1;
setindex[recout, scr];
putstr[lin, scr];
putmark[lastln, FALSE];
buf[lastln].txt ← recout;
recout ← getindex[scr];
blkmove[lastln, lastln, curln];
curln ← curln + 1;
stat ← OK};
RETURN};
getmark: PROC [n: INTEGER] RETURNS [BOOLEAN] = {
-- getmark: get mark from nth line
RETURN [buf[n].mark]};
putmark: PROC [n: INTEGER, m: BOOLEAN] = {
-- putmark: put mark m on nth line
buf[n].mark ← m};
-- editproc: procedures for edit
amatch: PROC [lin: POINTER TO string, offset: INTEGER,
pat: POINTER TO string, j: INTEGER] RETURNS [INTEGER] = {
-- amatch: look for match of pat[j] ... at lin[offset] ...
omatch: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
pat: POINTER TO string, j: INTEGER] RETURNS [matched: BOOLEAN] = {
-- omatch: match one patern element at pat[j]
locate: PROC [c: character, pat: POINTER TO string,
offset: INTEGER] RETURNS [found: BOOLEAN ← FALSE] = {
-- locate: look for c in character class at pat[offset]
-- size of class is at pat[offset], characters follow
i: INTEGER ← offset + pat[offset]; -- last position
WHILE (i > offset) DO
IF (c = pat[i]) THEN {
found ← TRUE;
i ← offset} -- force loop termination
ELSE
i ← i - 1
ENDLOOP;
RETURN};
advance: [-1..1] ← -1;
IF (lin[i↑] # ENDSTR) THEN
SELECT pat[j] FROM
LITCHAR =>
IF (lin[i↑] = pat[j+1]) THEN
advance ← 1;
BOL =>
IF (i↑ = 1) THEN
advance ← 0;
ANYCHAR =>
IF (lin[i↑] # NEWLINE) THEN
advance ← 1;
EOL =>
IF (lin[i↑] = NEWLINE) THEN
advance ← 0;
CCL =>
IF (locate[lin[i↑], pat, j+1]) THEN
advance ← 1;
NCCL =>
IF (lin[i↑] # NEWLINE)
AND (~locate[lin[i↑], pat, j+1]) THEN
advance ← 1;
ENDCASE =>
error["in omatch: can't happen"L];
IF (advance >= 0) THEN {
i↑ ← i↑ + advance;
matched ← TRUE}
ELSE
matched ← FALSE;
RETURN};
patsize: PROC [pat: POINTER TO string, n: INTEGER]
RETURNS [size: INTEGER] = {
-- patsize: returns size of pattern entry at pat[n]
SELECT pat[n] FROM
LITCHAR =>
size ← 2;
BOL, EOL, ANYCHAR =>
size ← 1;
CCL, NCCL =>
size ← pat[n+1] + 2;
CLOSURE =>
size ← CLOSIZE;
ENDCASE =>
error["in patsize: can't happen"L];
RETURN [size]};
i, k: INTEGER;
done: BOOLEAN ← FALSE;
WHILE (~done) AND (pat[j] # ENDSTR) DO
IF (pat[j] = CLOSURE) THEN {
j ← j + patsize[pat, j]; -- step over CLOSURE
i ← offset;
-- match as many as possible
WHILE (~done) AND (lin[i] # ENDSTR) DO
IF (~omatch[lin, @i, pat, j]) THEN
done ← TRUE
ENDLOOP;
-- i points to input char that made us fail
-- match rest of pattern against rest of input
-- shrink closure by 1 after each failure
done ← FALSE;
WHILE (~done) AND (i >= offset) DO
k ← amatch[lin, i, pat, j+patsize[pat, j]];
IF (k > 0) THEN -- matched rest of pattern
done ← TRUE
ELSE
i ← i - 1
ENDLOOP;
offset ← k; -- if k = 0 THEN failure else success
done ← TRUE}
ELSE IF (~omatch[lin, @offset, pat, j]) THEN {
offset ← 0; -- non-closure
done ← TRUE}
ELSE -- omatch succeeded on this pattern element
j ← j + patsize[pat, j]
ENDLOOP;
RETURN [offset]};
match: PROC [lin, pat: POINTER TO string] RETURNS [BOOLEAN] = {
-- match: find match anywhere on line
i: INTEGER ← 1;
pos: INTEGER ← 0;
WHILE (lin[i] # ENDSTR) AND (pos = 0) DO
pos ← amatch[lin, i, pat, 1];
i ← i + 1
ENDLOOP;
RETURN [pos > 0]};
skipbl: PROC [s: POINTER TO string, i: POINTER TO INTEGER] = {
-- skipbl: skip blanks and tabs at s[i] ...
WHILE (s[i↑] = BLANK) OR (s[i↑] = TAB) DO
i↑ ← i↑ + 1 ENDLOOP};
optpat: PROC [lin: POINTER TO string, i: POINTER TO INTEGER]
RETURNS [stat: stcode] = {
-- optpat: get optional pattern from lin[i], increment i
makepat: PROC [arg: POINTER TO string, start: INTEGER,
delim: character, pat: POINTER TO string] RETURNS [INTEGER] = {
-- makepat: make pattern from arg[i], terminate at delim
getccl: PROC [arg: POINTER TO string, i: POINTER TO INTEGER,
pat: POINTER TO string, j: POINTER TO INTEGER] RETURNS [BOOLEAN] = {
-- getccl: expand char class at arg[i] into pat[j]
jstart: INTEGER;
dodash: PROC [delim: character, src: POINTER TO string,
i: POINTER TO INTEGER, dest: POINTER TO string,
j: POINTER TO INTEGER, maxset: INTEGER] = {
-- dodash: expand set at src[i↑] into dest[j↑], stop at delim
DASH: character = ord['-];
WHILE (src[i↑] # delim) AND (src[i↑] # ENDSTR) DO
IF (src[i↑] = ESCAPE) THEN
[] ← addstr[esc[src, i], dest, j, maxset]
ELSE IF (src[i↑] # DASH) THEN
[] ← addstr[src[i↑], dest, j, maxset]
ELSE IF (j↑ <= 1) OR (src[i↑+1] = ENDSTR) THEN
[] ← addstr[DASH, dest, j, maxset] -- literal -
ELSE IF (isalphanum[src[i↑-1]])
AND (isalphanum[src[i↑+1]])
AND (src[i↑-1] <= src[i↑+1]) THEN {
FOR k: character IN (src[i↑-1] .. src[i↑+1]] DO
[] ← addstr[k, dest, j, maxset] ENDLOOP;
i↑ ← i↑ + 1}
ELSE
[] ← addstr[DASH, dest, j, maxset];
i↑ ← i↑ + 1
ENDLOOP};
i↑ ← i↑ + 1; -- skip over '[
IF (arg[i↑] = NEGATE) THEN {
[] ← addstr[NCCL, pat, j, MAXPAT];
i↑ ← i↑ + 1}
ELSE
[] ← addstr[CCL, pat, j, MAXPAT];
jstart ← j↑;
[] ← addstr[0, pat, j, MAXPAT]; -- room for count
dodash[CCLEND, arg, i, pat, j, MAXPAT];
pat[jstart] ← j↑ - jstart - 1;
RETURN [arg[i↑] = CCLEND]};
stclose: PROC [pat: POINTER TO string, j: POINTER TO INTEGER,
lastj: INTEGER] = {
-- stclose: insert closure entry at pat[j]
FOR jp: INTEGER DECREASING IN [lastj .. j↑) DO
jt: INTEGER ← jp + CLOSIZE;
[] ← addstr[pat[jp], pat, @jt, MAXPAT]
ENDLOOP;
j↑ ← j↑ + CLOSIZE;
pat[lastj] ← CLOSURE}; -- where original pattern began
i: INTEGER ← start; -- arg index
j: INTEGER ← 1; -- pat index
lastj: INTEGER ← 1;
done: BOOLEAN ← FALSE;
WHILE (~done) AND (arg[i] # delim) AND (arg[i] # ENDSTR) DO
lj: INTEGER ← j;
IF arg[i] = ANYCHAR THEN
[] ← addstr[ANYCHAR, pat, @j, MAXPAT]
ELSE IF (arg[i] = BOL) AND (i = start) THEN
[] ← addstr[BOL, pat, @j, MAXPAT]
ELSE IF (arg[i] = EOL) AND (arg[i+1] = delim) THEN
[] ← addstr[EOL, pat, @j, MAXPAT]
ELSE IF (arg[i] = CCL) THEN
done ← (~getccl[arg, @i, pat, @j])
ELSE IF (arg[i] = CLOSURE) AND (i > start) THEN {
lj ← lastj;
IF (pat[lj] = BOL) OR (pat[lj] = EOL) OR (pat[lj] = CLOSURE) THEN
done ← TRUE -- force loop termination
ELSE
stclose[pat, @j, lastj]}
ELSE {
[] ← addstr[LITCHAR, pat, @j, MAXPAT];
[] ← addstr[esc[arg, @i], pat, @j, MAXPAT]};
lastj ← lj;
IF (~done) THEN
i ← i + 1
ENDLOOP;
RETURN [
IF (done) OR (arg[i] # delim) THEN 0 -- finished early
ELSE IF (~addstr[ENDSTR, pat, @j, MAXPAT]) THEN 0 -- no room
ELSE i]}; -- all is well;
IF (lin[i↑] = ENDSTR) THEN
i↑ ← 0
ELSE IF (lin[i↑+1] = ENDSTR) THEN
i↑ ← 0
ELSE IF (lin[i↑+1] = lin[i↑]) THEN -- repeated delimiter
i↑ ← i↑ + 1 -- leave existing pattern alone
ELSE
i↑ ← makepat[lin, i↑+1, lin[i↑], @pat];
IF (pat[1] = ENDSTR) THEN
i↑ ← 0;
IF (i↑ = 0) THEN {
pat[1] ← ENDSTR;
stat ← ERR}
ELSE stat ← OK;
RETURN};
nextln: PROC [n: INTEGER] RETURNS [INTEGER] = {
-- nextln: get line after n
RETURN [IF (n >= lastln) THEN 0 ELSE n + 1]};
prevln: PROC [n: INTEGER] RETURNS [INTEGER] = {
-- prevln: get line before n
RETURN [IF (n <= 0) THEN lastln ELSE n - 1]};
patscan: PROC [way: character, n: POINTER TO INTEGER] RETURNS [stat: stcode] = {
-- patscan: find next occurrence of pattern after line n
done: BOOLEAN ← FALSE;
line: string;
n↑ ← curln;
stat ← ERR;
DO
n↑ ← IF (way = SCAN) THEN nextln[n↑] ELSE prevln[n↑];
gettxt[n↑, @line];
IF (match[@line, @pat]) THEN {
stat ← OK;
done ← TRUE};
IF (n↑ = curln) OR (done) THEN EXIT
ENDLOOP;
RETURN};
getnum: PROC [lin: POINTER TO string, i, num: POINTER TO INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- getnum: get single line number component
status↑ ← OK;
skipbl[lin, i];
IF (isdigit[lin[i↑]]) THEN {
num↑ ← ctoi[lin, i];
i↑ ← i↑ - 1} -- move back, to be advanced at end
ELSE IF (lin[i↑] = CURLINE) THEN
num↑ ← curln
ELSE IF (lin[i↑] = LASTLINE) THEN
num↑ ← lastln
ELSE IF (lin[i↑] = SCAN) OR (lin[i↑] = BACKSCAN) THEN {
IF (optpat[lin, i] = ERR) THEN -- build pattern
status↑ ← ERR
ELSE
status↑ ← patscan[lin[i↑], num]}
ELSE
status↑ ← ENDDATA;
IF (status↑ = OK) THEN
i↑ ← i↑ + 1; -- next character to be examined
RETURN [status↑]};
getone: PROC [lin: POINTER TO string, i, num: POINTER TO INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- getone: get one line number expression
istart: INTEGER = i↑;
num↑ ← 0;
IF (getnum[lin, i, num, status] = OK) THEN -- first term
DO -- + or - terms
skipbl[lin, i];
IF (lin[i↑] # ord['+]) AND (lin[i↑] # ord['-]) THEN
status↑ ← ENDDATA
ELSE {
pnum: INTEGER;
mul: INTEGER = IF (lin[i↑] = ord['+]) THEN 1 ELSE -1;
i↑ ← i↑ + 1;
IF (getnum[lin, i, @pnum, status] = OK) THEN
num↑ ← num↑ + mul*pnum;
IF (status↑ = ENDDATA) THEN
status↑ ← ERR};
IF (status↑ # OK) THEN EXIT
ENDLOOP;
IF (num↑ < 0) OR (num↑ > lastln) THEN
status↑ ← ERR;
IF (status↑ # ERR) THEN
status↑ ← IF (i↑ <= istart) THEN ENDDATA ELSE OK;
RETURN [status↑]};
getlist: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- getlist: get list of line nums at lin[i], increment i
num: INTEGER;
done: BOOLEAN;
line2 ← 0;
nlines ← 0;
done ← (getone[lin, i, @num, status] # OK);
WHILE (~done) DO
line1 ← line2;
line2 ← num;
nlines ← nlines + 1;
IF (lin[i↑] = SEMICOL) THEN
curln ← num;
IF (lin[i↑] = COMMA) OR (lin[i↑] = SEMICOL) THEN {
i↑ ← i↑ + 1;
done ← (getone[lin, i, @num, status] # OK)}
ELSE
done ← TRUE
ENDLOOP;
nlines ← MIN[nlines, 2];
IF (nlines = 0) THEN
line2 ← curln;
IF (nlines <= 1) THEN
line1 ← line2;
IF (status↑ # ERR) THEN
status↑ ← OK;
RETURN [status↑]};
append: PROC [line: INTEGER, glob: BOOLEAN] RETURNS [stat: stcode] = {
-- append: append lines after "line"
IF (glob) THEN
stat ← ERR
ELSE {
inline: string;
done: BOOLEAN ← FALSE;
curln ← line;
stat ← OK;
WHILE (~done) AND (stat = OK) DO
IF (~getline[@inline, STDIN, MAXSTR]) THEN
stat ← ENDDATA
ELSE IF (inline[1] = PERIOD)
AND (inline[2] = NEWLINE) THEN
done ← TRUE
ELSE IF (puttxt[@inline] = ERR) THEN
stat ← ERR
ENDLOOP};
RETURN};
lndelete: PROC [n1, n2: INTEGER, status: POINTER TO stcode]
RETURNS [stcode] = {
-- lndelete: delete lines n1 through n2
IF (n1 <= 0) THEN
status↑ ← ERR
ELSE {
blkmove[n1, n2, lastln];
lastln ← lastln - (n1 - n1 + 1);
curln ← prevln[n1];
status↑ ← OK};
RETURN [status↑]};
doprint: PROC [n1, n2: INTEGER] RETURNS [stat: stcode] = {
-- doprint: print lines n1 through n2
line: string;
IF (n1 <= 0) THEN
stat ← ERR
ELSE {
FOR i: INTEGER IN [n1 .. n2] DO
gettxt[i, @line];
putstr[@line, STDOUT]
ENDLOOP;
curln ← n2;
stat ← OK};
RETURN};
doread: PROC [n: INTEGER, fil: POINTER TO string] RETURNS [stat: stcode] = {
-- doread: read "fil" after line n
fd: filedesc = open[fil, IOREAD];
IF (fd = IOERROR) THEN
stat ← ERR
ELSE {
inline: string;
count: INTEGER ← 0;
curln ← n;
stat ← OK;
DO
t: BOOLEAN = getline[@inline, fd, MAXSTR];
IF (t) THEN {
stat ← puttxt[@inline];
IF (stat # ERR) THEN
count ← count + 1};
IF (stat # OK) OR (~t) THEN EXIT
ENDLOOP;
close[fd];
putdec[count, 1];
putc[NEWLINE]};
RETURN};
dowrite: PROC [n1, n2: INTEGER, fil: POINTER TO string]
RETURNS [stat: stcode] = {
-- dowrite: write lines n1..n2 into file
fd: filedesc = create[fil, IOWRITE];
IF (fd = IOERROR) THEN
stat ← ERR
ELSE {
line: string;
FOR i: INTEGER IN [n1 .. n2] DO
gettxt[i, @line];
putstr[@line, fd]
ENDLOOP;
close[fd];
putdec[n2-n1+1, 1];
putc[NEWLINE];
stat ← OK};
RETURN};
move: PROC [line3: INTEGER] RETURNS [stat: stcode] = {
-- move: move line1 through line2 after line3
IF (line1 <= 0) OR ((line3 >= line1) AND (line3 < line2)) THEN
stat ← ERR
ELSE {
blkmove[line1, line2, line3];
curln ← IF (line3 > line1)
THEN line3
ELSE line3 + (line2 - line1 + 1);
stat ← OK};
RETURN};
makesub: PROC [arg: POINTER TO string, from: INTEGER,
delim: character, sub: POINTER TO string] RETURNS [INTEGER] = {
-- makesub: make substitution string from arg in sub
i: INTEGER ← from;
j: INTEGER ← 1;
WHILE (arg[i] # delim) AND (arg[i] # ENDSTR) DO
IF (arg[i] = ord['&]) THEN
[] ← addstr[DITTO, sub, @j, MAXPAT]
ELSE
[] ← addstr[esc[arg, @i], sub, @j, MAXPAT];
i ← i + 1
ENDLOOP;
RETURN [
IF (arg[i] # delim) THEN 0 -- missing delimiter
ELSE IF (~addstr[ENDSTR, sub, @j, MAXPAT]) THEN 0
ELSE i]};
getrhs: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
sub: POINTER TO string, gflag: POINTER TO BOOLEAN] RETURNS [stat: stcode] = {
-- getrhs: get right hand side of "s" command
stat ← OK;
IF (lin[i↑] = ENDSTR) THEN
stat ← ERR
ELSE IF (lin[i↑+1] = ENDSTR) THEN
stat ← ERR
ELSE {
i↑ ← makesub[lin, i↑+1, lin[i↑], sub];
IF (i↑ = 0) THEN
stat ← ERR
ELSE IF (lin[i↑+1] = ord['g]) THEN {
i↑ ← i↑ + 1;
gflag↑ ← TRUE}
ELSE
gflag↑ ← FALSE};
RETURN};
catsub: PROC [lin: POINTER TO string, s1, s2: INTEGER,
sub, new: POINTER TO string,
k: POINTER TO INTEGER, maxnew: INTEGER] = {
-- catsub: add replacement text to end of new
i: INTEGER ← 1;
WHILE (sub[i] # ENDSTR) DO
IF (sub[i] = DITTO) THEN
FOR j: INTEGER IN [s1 .. s2) DO
[] ← addstr[lin[j], new, k, maxnew] ENDLOOP
ELSE
[] ← addstr[sub[i], new, k, maxnew];
i ← i + 1
ENDLOOP};
subst: PROC [sub: POINTER TO string, gflag, glob: BOOLEAN] RETURNS [stcode] = {
-- subst: substitute "sub" for occurrences of pattern
stat: stcode ← IF (glob) THEN OK ELSE ERR;
done: BOOLEAN ← (line1 <= 0);
line: INTEGER ← line1;
new, old: string;
WHILE (~done) AND (line <= line2) DO
j, k: INTEGER ← 1;
subbed: BOOLEAN ← FALSE;
lastm: INTEGER ← 0;
gettxt[line, @old];
WHILE (old[k] # ENDSTR) DO
m: INTEGER = IF (gflag) OR (~subbed)
THEN amatch[@old, k, @pat, 1]
ELSE 0;
IF (m > 0) AND (lastm # m) THEN {
-- replace matched text
subbed ← TRUE;
catsub[@old, k, m, sub, @new, @j, MAXSTR];
lastm ← m};
IF (m = 0) OR (m = k) THEN {
-- no match or null match
[] ← addstr[old[k], @new, @j, MAXSTR];
k ← k + 1}
ELSE -- skip matched text
k ← m
ENDLOOP;
IF (subbed) THEN {
IF (~addstr[ENDSTR, @new, @j, MAXSTR]) THEN {
stat ← ERR;
done ← TRUE}
ELSE {
stat ← lndelete[line, line, @stat];
stat ← puttxt[@new];
line2 ← line2 + curln - line;
line ← curln;
IF (stat = ERR) THEN
done ← TRUE
ELSE
stat ← OK}};
line ← line + 1
ENDLOOP;
RETURN [stat]};
ckp: PROC [lin: POINTER TO string, i: INTEGER,
pflag: POINTER TO BOOLEAN, status: POINTER TO stcode] RETURNS [stcode] = {
-- ckp: check for "p" after command
skipbl[lin, @i];
IF (lin[i] = PCMD) THEN {
i ← i + 1;
pflag↑ ← TRUE}
ELSE
pflag↑ ← FALSE;
status↑ ← IF (lin[i] = NEWLINE) THEN OK ELSE ERR;
RETURN [status↑]};
default: PROC [def1, def2: INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- default: set defaulted line numbers
IF (nlines = 0) THEN {
line1 ← def1;
line2 ← def2};
status↑ ← IF (line1 > line2) OR (line1 <= 0) THEN ERR ELSE OK;
RETURN [status↑]};
getfn: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
fil: POINTER TO string] RETURNS [stat: stcode] = {
-- getfn: get file name from lin[i] ...
getword: PROC [s: POINTER TO string, i: INTEGER,
out: POINTER TO string] RETURNS [INTEGER] = {
j: INTEGER ← 1;
WHILE (s[i] = BLANK) OR (s[i] = TAB) OR (s[i] = NEWLINE) DO
i ← i + 1 ENDLOOP;
WHILE (~((s[i] = ENDSTR)
OR (s[i] = BLANK) OR (s[i] = TAB) OR (s[i] = NEWLINE))) DO
out[j] ← s[i];
i ← i + 1;
j ← j + 1
ENDLOOP;
out[j] ← ENDSTR;
RETURN [IF (s[i] = ENDSTR) THEN 0 ELSE i]};
stat ← ERR;
IF (lin[i↑+1] = BLANK) THEN {
k: INTEGER = getword[lin, i↑+2, fil]; -- get new filename
IF (k > 0) THEN
IF (lin[k] = NEWLINE) THEN
stat ← OK}
ELSE IF (lin[i↑+1] = NEWLINE)
AND (savefile[1] # ENDSTR) THEN {
scopy[@savefile, 1, fil, 1];
stat ← OK};
IF (stat = OK) AND (savefile[1] = ENDSTR) THEN
scopy[fil, 1, @savefile, 1]; -- save if no old one
RETURN};
docmd: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
glob: BOOLEAN, status: POINTER TO stcode] RETURNS [stcode] = {
-- docmd: handle all commands except globals
pflag: BOOLEAN ← FALSE; -- may be set by d, m, s
status↑ ← ERR;
IF (lin[i↑] = PCMD) THEN {
IF (lin[i↑+1] = NEWLINE) THEN
IF (default[curln, curln, status] = OK) THEN
status↑ ← doprint[line1, line2]}
ELSE IF (lin[i↑] = NEWLINE) THEN {
IF (nlines = 0) THEN
line2 ← nextln[curln];
status↑ ← doprint[line2, line2]}
ELSE IF (lin[i↑] = QCMD) THEN {
IF (lin[i↑+1]=NEWLINE) AND (nlines=0) AND (~glob) THEN
status↑ ← ENDDATA}
ELSE IF (lin[i↑] = ACMD) THEN {
IF (lin[i↑+1] = NEWLINE) THEN
status↑ ← append[line2, glob]}
ELSE IF (lin[i↑] = CCMD) THEN {
IF (lin[i↑+1] = NEWLINE) THEN
IF (default[curln, curln, status] = OK) THEN
IF (lndelete[line1, line2, status] = OK) THEN
status↑ ← append[prevln[line1], glob]}
ELSE IF (lin[i↑] = DCMD) THEN {
IF (ckp[lin, i↑+1, @pflag, status] = OK) THEN
IF (default[curln, curln, status] = OK) THEN
IF (lndelete[line1, line2, status] = OK) THEN
IF (nextln[curln] # 0) THEN
curln ← nextln[curln]}
ELSE IF (lin[i↑] = ICMD) THEN {
IF (lin[i↑+1] = NEWLINE) THEN
IF (line2 = 0) THEN
status↑ ← append[0, glob]
ELSE
status↑ ← append[prevln[line2], glob]}
ELSE IF (lin[i↑] = EQCMD) THEN {
IF (ckp[lin, i↑+1, @pflag, status] = OK) THEN {
putdec[line2, 1];
putc[NEWLINE]}}
ELSE IF (lin[i↑] = MCMD) THEN {
line3: INTEGER;
i↑ ← i↑ + 1;
IF (getone[lin, i, @line3, status] = ENDDATA) THEN
status↑ ← ERR;
IF (status↑ = OK) THEN
IF (ckp[lin, i↑, @pflag, status] = OK) THEN
IF (default[curln, curln, status] = OK) THEN
status↑ ← move[line3]}
ELSE IF (lin[i↑] = SCMD) THEN {
sub: string;
gflag: BOOLEAN;
i↑ ← i↑ + 1;
IF (optpat[lin, i] = OK) THEN
IF (getrhs[lin, i, @sub, @gflag] = OK) THEN
IF (ckp[lin, i↑+1, @pflag, status] = OK) THEN
IF (default[curln, curln, status] = OK) THEN
status↑ ← subst[@sub, gflag, glob]}
ELSE IF (lin[i↑] = ECMD) THEN {
fil: string;
IF (nlines = 0) THEN
IF (getfn[lin, i, @fil] = OK) THEN {
scopy[@fil, 1, @savefile, 1];
clrbuf[];
setbuf[];
status↑ ← doread[0, @fil]}}
ELSE IF (lin[i↑] = FCMD) THEN {
fil: string;
IF (nlines = 0) THEN
IF (getfn[lin, i, @fil] = OK) THEN {
scopy[@fil, 1, @savefile, 1];
putstr[@savefile, STDOUT];
putc[NEWLINE];
status↑ ← OK}}
ELSE IF (lin[i↑] = RCMD) THEN {
fil: string;
IF (getfn[lin, i, @fil] = OK) THEN
status↑ ← doread[line2, @fil]}
ELSE IF (lin[i↑] = WCMD) THEN {
fil: string;
IF (getfn[lin, i, @fil] = OK) THEN
IF (default[1, lastln, status] = OK) THEN
status↑ ← dowrite[line1, line2, @fil]}
-- else status is ERR --;
IF (status↑ = OK) AND (pflag) THEN
status↑ ← doprint[curln, curln];
RETURN [status↑]};
ckglob: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- ckglob: if global prefix, mark lines to be affected
IF (lin[i↑] # GCMD) AND (lin[i↑] # XCMD) THEN
status↑ ← ENDDATA
ELSE {
gflag: BOOLEAN = (lin[i↑] = GCMD);
i↑ ← i↑ + 1;
IF (optpat[lin, i] = ERR) THEN
status↑ ← ERR
ELSE IF (default[1, lastln, status] # ERR) THEN {
temp: string;
i↑ ← i↑ + 1; -- mark affected lines
FOR n: INTEGER IN [line1 .. line2] DO
gettxt[n, @temp];
putmark[n, (match[@temp, @pat] = gflag)]
ENDLOOP;
FOR n: INTEGER IN [1 .. line1) DO -- erase other marks
putmark[n, FALSE] ENDLOOP;
FOR n: INTEGER IN (line2 .. lastln] DO
putmark[n, FALSE] ENDLOOP;
status↑ ← OK}};
RETURN [status↑]};
doglob: PROC [lin: POINTER TO string, i, cursave: POINTER TO INTEGER,
status: POINTER TO stcode] RETURNS [stcode] = {
-- doglob: do command at lin[i] on all marked lines
count: INTEGER ← 0;
istart: INTEGER = i↑;
n: INTEGER ← line1;
status↑ ← OK;
DO
IF (getmark[n]) THEN {
putmark[n, FALSE];
curln ← n;
cursave↑ ← curln;
i↑ ← istart;
IF (getlist[lin, i, status] = OK) THEN
IF (docmd[lin, i, TRUE, status] = OK) THEN
count ← 0}
ELSE {
n ← nextln[n];
count ← count + 1};
IF (count > lastln) OR (status↑ # OK) THEN EXIT
ENDLOOP;
RETURN [status↑]};
-- edit: main routine for text editor
edit: PROC = {
more: BOOLEAN;
setbuf[];
pat[1] ← ENDSTR;
savefile[1] ← ENDSTR;
IF (getarg[1, @savefile, MAXSTR]) THEN
IF (doread[0, @savefile] = ERR) THEN
message["?"L];
more ← getline[@lin, STDIN, MAXSTR];
WHILE (more) DO
cursave: INTEGER ← curln;
i: INTEGER ← 1;
status: stcode;
IF (getlist[@lin, @i, @status] = OK) THEN {
IF (ckglob[@lin, @i, @status] = OK) THEN
status ← doglob[@lin, @i, @cursave, @status]
ELSE IF (status # ERR) THEN
status ← docmd[@lin, @i, FALSE, @status]
-- ELSE ERR, do nothing--};
IF (status = ERR) THEN {
message["?"L];
curln ← MIN[cursave, lastln]}
ELSE IF (status = ENDDATA) THEN
more ← FALSE;
-- ELSE OK
IF (more) THEN
more ← getline[@lin, STDIN, MAXSTR]
ENDLOOP;
clrbuf[]};
-- here begins the shell
initcmd: PROC = {
idx: CARDINAL ← Exec.commandLine.i;
limx: CARDINAL =
IF Exec.commandLine.s = NIL THEN 0 ELSE Exec.commandLine.s.length-1;
tty ← Exec.w;
kbdx ← kbdline.length ← 0;
kbdend ← FALSE;
filetab[STDIN].type ← filetab[STDOUT].type ← filetab[STDERR].type ← tty;
cmdargs ← 0;
WHILE (idx < limx) DO
WHILE (Exec.commandLine.s[idx] = Ascii.SP) AND (idx < limx) DO
idx ← idx + 1 ENDLOOP;
IF (idx < limx) THEN {
startidx: CARDINAL = idx;
WHILE (idx < limx)
AND (Exec.commandLine.s[idx] # Ascii.SP)
AND (Exec.commandLine.s[idx] # Ascii.TAB) DO
idx ← idx + 1 ENDLOOP;
SELECT Exec.commandLine.s[startidx] FROM
'< => {
name: string;
commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
close[STDIN];
makestream[@name, IOREAD, STDIN]};
'> => {
name: string;
commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
close[STDOUT];
makestream[@name, IOWRITE, STDOUT]};
ENDCASE => {
cmdargs ← cmdargs + 1;
IF cmdargs > MAXCMD THEN {
putcf[NEWLINE, STDERR];
message["*** too many arguments"L];
putcf[NEWLINE, STDERR]}
ELSE
cmd[cmdargs] ← [idx: startidx, len: idx - startidx]}};
ENDLOOP;
putcf[NEWLINE, STDERR]};
endcmd: PROC = {
FOR fd: filedesc IN (IOERROR .. MAXOPEN] DO
close[fd] ENDLOOP;
IF Exec.commandLine.s # NIL THEN
Exec.commandLine.i ← Exec.commandLine.s.length};
main: PROC = {
initcmd[];
edit[ ! exit => {CONTINUE}];
endcmd[]};
Exec.AddCommand["Edit.~"L, main];
}.