-- file Change.mesa
-- last modified by Satterthwaite, 9-Mar-82 14:21:38
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 [Create, EndOf],
Stream: TYPE USING [Handle, Delete, GetChar, PutChar],
TTY: TYPE USING [Handle, GetLine, LineOverflow, PutChar, Rubout];
Change: 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];
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]};
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};
-- 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]])]};
-- main proc here
-- change: change "from" into "to" on each line
change: PROC = {
MAXPAT: NAT = MAXSTR;
CLOSIZE: NAT = 1; -- size of a closure entry
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];
DITTO: character = -1;
lin, pat, sub, arg: string;
getpat: PROC [arg, pat: POINTER TO string] RETURNS [BOOLEAN] = {
-- getpat: convert argument into pattern
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;
RETURN [makepat[arg, 1, ENDSTR, pat] > 0]};
subline: PROC [lin, pat, sub: POINTER TO string] = {
-- subline: substitute sub for pat in lin and print
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]};
putsub: PROC [lin: POINTER TO string, s1, s2: INTEGER,
sub: POINTER TO string] = {
i: INTEGER ← 1;
WHILE (sub[i] # ENDSTR) DO
IF (sub[i] = DITTO) THEN
FOR j: INTEGER IN [s1 .. s2) DO
putc[lin[j]] ENDLOOP
ELSE
putc[sub[i]];
i ← i + 1
ENDLOOP};
i: INTEGER ← 1;
lastm: INTEGER ← 0;
WHILE (lin[i] # ENDSTR) DO
m: INTEGER = amatch[lin, i, pat, 1];
IF (m > 0) AND (lastm # m) THEN {
-- replace matched text
putsub[lin, i, m, sub];
lastm ← m};
IF (m = 0) OR (m = i) THEN {
-- no match or null match
putc[lin[i]];
i ← i + 1}
ELSE -- skip matched text
i ← m
ENDLOOP};
getsub: PROC [arg, sub: POINTER TO string] RETURNS [BOOLEAN] = {
-- getsub: get substitution string into sub
makesub: PROC [arg: POINTER TO string, from: INTEGER,
delim: character, sub: POINTER TO string] RETURNS [INTEGER] = {
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 -- missing delimiter
0
ELSE IF (~addstr[ENDSTR, sub, @j, MAXPAT]) THEN
0
ELSE i]};
RETURN [(makesub[arg, 1, ENDSTR, sub] > 0)]};
IF (~getarg[1, @arg, MAXSTR]) THEN
error["usage: change from [to]"L];
IF (~getpat[@arg, @pat]) THEN
error["change: illegal ""from"" pattern"L];
IF (~getarg[2, @arg, MAXSTR]) THEN
arg[1] ← ENDSTR;
IF (~getsub[@arg, @sub]) THEN
error["change: illegal ""to"" string"L];
WHILE (getline[@lin, STDIN, MAXSTR]) DO
subline[@lin, @pat, @sub] ENDLOOP};
-- 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[];
change[ ! exit => {CONTINUE}];
endcmd[]};
Exec.AddCommand["change.~"L, main];
}.