GPMImpl.mesa
Doug Wyatt, March 1, 1985 1:38:29 pm PST
Russ Atkinson (RRA) October 24, 1985 6:40:49 pm PDT
Michael Plass, November 26, 1991 1:36 pm PST
Bier, December 13, 1988 10:36:25 pm PST
Copyright Ó 1985, 1986, 1991 by Xerox Corporation. All rights reserved.
Strachey's General Purpose Macrogenerator
as described in Computer Journal, Oct. 1965. pp. 225-241
DIRECTORY
PFS, GPM, IO, Rope;
GPMImpl: CEDAR PROGRAM
IMPORTS PFS, IO, Rope
EXPORTS GPM = BEGIN
BuiltIn: TYPE = GPM.BuiltIn;
Entry: TYPE = GPM.Entry;
ErrorCode: TYPE = GPM.ErrorCode;
Handle: TYPE = GPM.Handle;
Index: TYPE = GPM.Index;
Object: TYPE = GPM.Object;
ROPE: TYPE = Rope.ROPE;
Stack: TYPE = GPM.Stack;
STREAM: TYPE = IO.STREAM;
for debugging
outputloc: INT ¬ 0;
inputloc: INT ¬ 0;
Open: PUBLIC PROC [stream: STREAM] RETURNS [self: Handle] = {
self ¬ NEW[Object];
self.st ¬ NEW[Stack[10000]];
self.output ¬ NEW[TEXT[100]];
self.outputChar ¬ endOfInput;
self.stream ¬ stream;
self.s ¬ 21; self.e ¬ 12; self.q ¬ 1; self.a ¬ endOfInput;
self.st[0] ¬ index[GPM.maxIndex];
self.st[1] ¬ length[4];
self.st[2] ¬ char['D];
self.st[3] ¬ char['E];
self.st[4] ¬ char['F];
self.st[5] ¬ builtin[GPM.DEF];
self.st[6] ¬ index[0];
self.st[7] ¬ length[4];
self.st[8] ¬ char['V];
self.st[9] ¬ char['A];
self.st[10] ¬ char['L];
self.st[11] ¬ builtin[GPM.gpmVAL];
self.st[12] ¬ index[6];
self.st[13] ¬ length[7];
self.st[14] ¬ char['U];
self.st[15] ¬ char['P];
self.st[16] ¬ char['D];
self.st[17] ¬ char['A];
self.st[18] ¬ char['T];
self.st[19] ¬ char['E];
self.st[20] ¬ builtin[GPM.UPDATE];
outputloc ¬ 0;
inputloc ¬ 0;
};
Close: PUBLIC PROC [self: Handle] = {
IF self.stream # NIL THEN IO.Close[self.stream];
self.stream ¬ NIL;
self.output ¬ NIL;
self.st ¬ NIL;
};
GetIndex: PUBLIC PROC [self: Handle] RETURNS [i: INT] = {
RETURN [IO.GetIndex[self.stream]];
};
DumpToStream: PUBLIC PROC [output: STREAM, input: Handle] = {
DO IO.PutChar[output,GetChar[input ! Error => IF ec = EndOfStream THEN EXIT]]; ENDLOOP;
input.stream ¬ NIL;
Close[input]
};
Error: PUBLIC ERROR [ec: ErrorCode, errorMsg: ROPE] = CODE;
Internal procs
endOfInput: CHAR = 0C;
Load: PROC [self: Handle] = {
IF self.h=0
THEN {
IF self.output.length = 0 AND self.outputChar = endOfInput THEN {
self.outputChar ¬ self.a; RETURN
};
IF self.output.length = self.output.maxLength THEN {
new: REF TEXT ¬ NEW[TEXT[self.output.maxLength*2]];
new.length ¬ self.output.length;
FOR i:NAT IN [0..self.output.length) DO new[i] ¬ self.output[i]; ENDLOOP;
self.output ¬ new
};
self.output[self.output.length] ¬ self.a;
self.output.length ¬ self.output.length+1
}
ELSE { self.st[self.s] ¬ char[self.a]; self.s ¬ self.s+1 };
};
NextCh: PROC [self: Handle] = {
IF self.c=0
THEN {
self.a ¬ IO.GetChar[self.stream ! IO.EndOfStream => { self.a ¬ endOfInput; CONTINUE }];
inputloc ¬ inputloc+1
}
ELSE { self.a ¬ ToChar[self.st[self.c]]; self.c ¬ self.c+1 };
};
Find: PROC [self: Handle, x: Index] = {
x is index of name
finds name in e chain and sets w to start of def
ptr: Index ¬ self.e; -- start of definitions
self.w ¬ x; -- index of name length
DO -- search for macro name definition
match: BOOL ¬ TRUE;
len: Index ¬ ToLength[self.st[self.w]];
FOR r:Index IN [0..len) DO
IF self.st[self.w+r]#self.st[ptr+r+1] THEN { match ¬ FALSE; EXIT };
ENDLOOP;
IF match THEN { self.w ¬ ptr+1+len; RETURN };
ptr ¬ ToIndex[self.st[ptr]]; -- next entry
IF ptr = GPM.maxIndex THEN EXIT; -- end of chain
ENDLOOP;
undefined
Error[MacroError,Rope.Concat["Undefined name: ",Rope.Concat[Item[self,self.w],AtLoc[self]]]]
};
Item: PROC [self: Handle, x: Index] RETURNS [rope: ROPE] = {
return the item on the stack starting at st[x]
if item is not complete, stop at st[s-1] and
follow by "...(Incomplete)"
proc: SAFE PROC RETURNS [CHAR] = { k ¬ k+1; RETURN [ToChar[self.st[x+k]]] };
k: Index ¬ 0;
stklen: Index ¬ ToLength[self.st[x]];
incomplete: BOOL ¬ stklen=0;
len: Index ¬ IF incomplete THEN self.s-x-1 ELSE stklen-1;
rope ¬ Rope.FromProc[len, proc];
IF incomplete THEN rope ¬ Rope.Concat[rope,"...(Incomplete)"]
};
AtLoc: PROC [self: Handle] RETURNS [rope: ROPE] = {
RETURN [Rope.Concat[" at ", IO.PutR1[[integer[IO.GetIndex[self.stream]-1]]]]]
};
EndFn: PROC [self: Handle] = {
remove call and arg list; copy back result if any
y: Index;
len: Index;
IF self.f > self.p THEN { -- encountered terminator in bad place
msg: ROPE;
IF self.c=0 THEN ERROR; -- found terminator in input source
msg ¬ Rope.Concat["Terminator in argument list for ",Item[self,self.f+2]];
msg ¬ Rope.Concat[msg,". Probably due to a semicolon missing from the definition of "];
msg ¬ Rope.Concat[msg,Item[self,self.p+2]];
Error[MacroError,msg]
};
first remove any defs in arg list from e chain
and adjust defs in results so chain will be correct later
y ¬ self.s;
self.st[self.s] ¬ index[self.e];
len ¬ ToLength[self.st[self.p-1]]; -- arg list stuff to be removed
WHILE ToIndex[self.st[y]] >= self.p-1+len DO -- take care of defs in results
next: Index ¬ ToIndex[self.st[y]];
self.st[y] ¬ index[next-len];
y ¬ next;
ENDLOOP;
self.w ¬ ToIndex[self.st[y]];
WHILE self.w > self.p-1 DO self.w ¬ ToIndex[self.st[self.w]]; ENDLOOP;
skip over defs in args
self.st[y] ¬ index[self.w];
self.e ¬ ToIndex[self.st[self.s]];
IF self.h # 0 THEN
IF self.h > self.p THEN self.h ¬ self.h-len
ELSE self.st[self.h] ¬ length[ToLength[self.st[self.h]]-len];
self.c ¬ ToIndex[self.st[self.p+1]];
self.s ¬ self.s-len;
y ¬ self.p-1; -- dest for results
self.w ¬ self.p-1+len; -- source of results
self.p ¬ ToIndex[self.st[self.p]];
UNTIL y=self.s DO
self.st[y] ¬ self.st[self.w];
y ¬ y+1;
self.w ¬ self.w+1;
ENDLOOP
};
GetChar: PUBLIC PROC [self: Handle] RETURNS [char: CHAR] = {
DO
main loop
flag: BOOL ¬ FALSE;
IF self.st = NIL THEN Error[EndOfStream, "Stream already closed"];
IF self.outputChar # endOfInput THEN {
char ¬ self.outputChar;
self.outputChar ¬ endOfInput;
outputloc ¬ outputloc+1;
RETURN
};
IF self.output.length > self.outputPtr THEN {
char ¬ self.output[self.outputPtr];
IF (self.outputPtr ¬ self.outputPtr+1) = self.output.length THEN
self.output.length ¬ self.outputPtr ¬ 0;
outputloc ¬ outputloc+1;
RETURN
};
NextCh[self];
SELECT self.a FROM
self.startQuote => { self.q ¬ self.q+1; flag ¬ TRUE };
self.singleQuote => { NextCh[self]; Load[self]; LOOP };
self.startCall => {
Fn; start new function call
self.st[self.s] ¬ index[self.h];
self.st[self.s+1] ¬ index[self.f];
self.st[self.s+2] ¬ index[0];
self.st[self.s+3] ¬ length[0];
self.h ¬ self.s+3;
self.f ¬ self.s+1;
self.s ¬ self.s+4;
LOOP
};
self.sepArg => IF self.h=0 THEN NULL ELSE {
NextItem; collect next arg
self.st[self.h] ¬ length[self.s-self.h-ToLength[self.st[self.h]]];
self.st[self.s] ¬ length[0];
self.h ¬ self.s;
self.s ¬ self.s+1;
LOOP
};
self.endCall => IF self.h=0 THEN NULL ELSE {
Apply;
oldstf1: Index ¬ ToIndex[self.st[self.f-1]];
oldstf: Index ¬ ToIndex[self.st[self.f]];
self.st[self.h] ¬ length[self.s-self.h];
self.st[self.s] ¬ mark;
self.st[self.f-1] ¬ length[self.s-self.f+2];
self.st[self.f] ¬ index[self.p];
self.st[self.f+1] ¬ index[self.c];
self.p ¬ self.f;
self.h ¬ oldstf1;
self.f ¬ oldstf;
self.s ¬ self.s+1;
IF self.h # 0 THEN -- increase count of extra stuff
self.st[self.h] ¬ length[ToLength[self.st[self.h]]+ToLength[self.st[self.p-1]]];
Find[self,self.p+2];
IF IsBuiltIn[self.st[self.w]] THEN {
SELECT ToBuiltIn[self.st[self.w]] FROM
GPM.DEF => {
add self.a new definition
IF self.h # 0 THEN self.st[self.h] ¬ length[ToLength[self.st[self.h]]-ToLength[self.st[self.p-1]]+6];
self.st[self.p-1] ¬ length[6];
self.st[self.p+5] ¬ index[self.e];
self.e ¬ self.p+5
};
GPM.gpmVAL => {
get value of name
Find[self, self.p+6];
UNTIL self.st[self.w+1]=mark DO
self.a ¬ ToChar[self.st[self.w+1]];
self.w ¬ self.w+1;
Load[self];
ENDLOOP
};
GPM.UPDATE => {
change value of name
y: Index;
Find[self, self.p+9];
y ¬ self.p+9+ToLength[self.st[self.p+9]];
IF ToLength[self.st[y]] > ToLength[self.st[self.w]] THEN
Error[MacroError,Rope.Concat["UPDATE arg too long for ",
Rope.Concat[Item[self,self.p+9],AtLoc[self]]]];
FOR r:NAT IN [1..ToLength[self.st[y]]] DO
self.st[self.w+r] ¬ self.st[y+r];
ENDLOOP
};
ENDCASE => ERROR;
EndFn[self];
LOOP
};
self.c ¬ self.w+1;
LOOP
};
self.numArg => IF self.p=0 THEN NULL ELSE {
LoadArg;
NextCh[self]; -- read arg number
self.w ¬ self.p+2;
IF self.a NOT IN ['0..'9] THEN
Error[MacroError,Rope.Concat["Bad arg number in definition of ",Item[self,self.p+2]]];
FOR r:NAT IN [0..self.a-'0) DO
self.w ¬ self.w+ToLength[self.st[self.w]];
IF self.st[self.w]=mark THEN EXIT; -- act like have null arg
ENDLOOP;
IF self.st[self.w]=mark THEN LOOP;
FOR r:NAT IN [1..ToLength[self.st[self.w]]) DO
self.a ¬ ToChar[self.st[self.w+r]]; Load[self]; ENDLOOP;
LOOP
};
marker => { EndFn[self]; LOOP };
endOfInput =>
IF self.h # 0
THEN Error[MacroError,"End of input encountered inside macro call"]
ELSE Error[EndOfStream,"EndOfStream"];
ENDCASE;
DO
subloop for copying literals
IF flag THEN flag ¬ FALSE ELSE { Load[self]; IF self.q = 1 THEN EXIT };
NextCh[self];
SELECT self.a FROM
self.startQuote => { self.q ¬ self.q+1; LOOP };
endOfInput =>
Error[MacroError,"End of input encountered inside macro quoted string"];
self.endQuote => NULL;
ENDCASE => LOOP;
self.q ¬ self.q-1;
IF self.q = 1 THEN EXIT;
ENDLOOP;
ENDLOOP
};
ToIndex: PROC [e: Entry] RETURNS [i: Index] = INLINE { RETURN [LOOPHOLE[e]] };
ToLength: PROC [e: Entry] RETURNS [i: Index] = INLINE { RETURN [LOOPHOLE[e]] };
ToChar: PROC [e: Entry] RETURNS [char: CHAR] = INLINE { RETURN [LOOPHOLE[e]] };
ToBuiltIn: PROC [e: Entry] RETURNS [name: BuiltIn] = INLINE { RETURN [LOOPHOLE[-e]] };
index: PROC [i: Index] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[i,INTEGER]]] };
length: PROC [i: Index] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[i,INTEGER]]] };
char: PROC [c: CHAR] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[c,INTEGER]]] };
mark: Entry = char[marker];
marker: CHAR = 377C;
builtin: PROC [name: BuiltIn] RETURNS [Entry] = INLINE { RETURN [[-name]] };
IsBuiltIn: PROC [e: Entry] RETURNS [BOOL] = INLINE { RETURN [e < 0] };
debugging aids
WriteStack: PROC [self: Handle] = {
h: STREAM ¬ PFS.StreamOpen[PFS.PathFromRope["GPMStack.txt"], create];
{ ENABLE UNWIND => IO.Close[h];
IF self.h = 0
THEN IO.PutRope[h, "h = 0\n"]
ELSE {
IO.PutRope[h, "\n\nIncomplete string on top of stack\n\n"];
FOR i: Index ¬ self.h + self.st[self.h] + 1--?--, i+1 UNTIL i >= self.s DO
WriteChar[i, self, h];
ENDLOOP
};
IF self.c = 0
THEN IO.PutRope[h, "\n\nc = 0\n\n"]
ELSE {
IO.PutRope[h, "\n\nString being scanned from stack\n\n"];
FOR i: Index ¬ self.c, i+1
UNTIL i >= self.s OR self.st[i] = mark DO
WriteChar[i, self, h];
ENDLOOP
};
IF self.p = 0
THEN IO.PutRope[h, "\n\np = 0\n\n"]
ELSE {
last: Index ¬ self.s;
IO.PutRope[h, "\n\nCalls entered but not yet completed\n\n"];
FOR i: Index ¬ self.p, self.st[i] UNTIL i >= last OR i=0 DO
last ¬ i;
WriteItem[self, h, i+2];
ENDLOOP
};
IF self.f = 0
THEN IO.PutRope[h, "\n\nf = 0\n\n"]
ELSE {
last: Index ¬ self.s;
IO.PutRope[h, "\n\nCalls started but not yet entered\n\n"];
FOR i: Index ¬ self.f, self.st[i] UNTIL i >= last OR i=0 DO
last ¬ i;
WriteItem[self, h, i+2];
ENDLOOP
};
IF self.e = 0
THEN IO.PutRope[h, "\n\ne = 0\n\n"]
ELSE {
last: Index ¬ self.s;
IO.PutRope[h, "\n\nCurrent definitions\n\n"];
FOR i: Index ¬ self.e, self.st[i] UNTIL i >= last OR i=0 DO
last ¬ i;
WriteItem[self, h, i+1];
ENDLOOP
};
};
IO.Close[h];
};
WriteChar: PROC [i: Index, self: Handle, h: STREAM] = {
IO.Put1[h, [character[LOOPHOLE [MIN[self.st[i],128], CHAR]]]];
};
WriteItem: PROC [self: Handle, h: STREAM, i: Index] = {
len: INTEGER ¬ self.st[i];
end: Index ¬ MIN[i+len, self.s];
IO.PutChar[h, '\t];
FOR j: Index IN [i+1..end) DO
WriteChar[j, self, h];
ENDLOOP;
IO.PutChar[h, '\n];
};
END.