[Indigo]<Cedar>TIP>GPMImpl.mesa!6

GPMImpl.Mesa

Strachey's General Purpose Macrogenerator

as described in Computer Journal, Oct. 1965. pp. 225-241

Bill Paxton, November 1981

Maxwell, January 3, 1983 11:02 am

Paul Rovner, July 20, 1983 1:55 pm

McGregor, September 10, 1982 10:20 am

Russ Atkinson, September 23, 1983 10:54 am

DIRECTORY

FS USING [StreamOpen],

GPM,

IO,

Rope;

GPMImpl: CEDAR MONITOR

IMPORTS FS, IO, Rope

EXPORTS GPM = BEGIN OPEN GPM;

ROPE: TYPE = Rope.ROPE;

STREAM: TYPE = IO.STREAM;

Open: PUBLIC PROC [stream: STREAM] RETURNS [self: Handle] = {

self ← NEW[Object];

self.st ← GetStack[];

self.output ← GetText[];

self.outputChar ← endOfInput;

self.stream ← stream;

InitStack[self] };

Close: PUBLIC PROC [self: Handle] = {

IF self.stream # NIL THEN IO.Close[self.stream];

self.stream ← NIL;

FreeText[self.output];

self.output ← NIL;

FreeStack[self.st];

self.st ← NIL };

stk1, stk2: REF Stack; -- minicache

GetStack: ENTRY PROC RETURNS [stk: REF Stack] = {

IF stk1 # NIL THEN { stk ← stk1; stk1 ← NIL }

ELSE IF stk2 # NIL THEN { stk ← stk2; stk2 ← NIL }

ELSE stk ← NEW[Stack[10000]] };

FreeStack: ENTRY PROC [stk: REF Stack] = {

IF stk = NIL THEN RETURN;

IF stk1 = NIL THEN stk1 ← stk

ELSE IF stk2 = NIL THEN stk2 ← stk };

txt1, txt2: REF TEXT; -- minicache

GetText: ENTRY PROC RETURNS [txt: REF TEXT] = {

IF txt1 # NIL THEN { txt ← txt1; txt1 ← NIL }

ELSE IF txt2 # NIL THEN { txt ← txt2; txt2 ← NIL }

ELSE txt ← NEW[TEXT[100]] };

FreeText: ENTRY PROC [txt: REF TEXT] = {

IF txt = NIL THEN RETURN;

IF txt1 = NIL THEN txt1 ← txt

ELSE IF txt2 = NIL THEN txt2 ← txt };

GetIndex: PUBLIC PROC [self: Handle] RETURNS [i: LONG INTEGER] = {

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: CHARACTER = 0C;

Load: PROC [self: Handle] = INLINE { OPEN self;

IF h=0 THEN {

IF output.length = 0 AND outputChar = endOfInput THEN {

outputChar ← a; RETURN };

IF output.length = output.maxLength THEN {

new: REF TEXT ← NEW[TEXT[output.maxLength*2]];

new.length ← output.length;

FOR i:NAT IN [0..output.length) DO new[i] ← output[i]; ENDLOOP;

output ← new };

output[output.length] ← a;

output.length ← output.length+1 }

ELSE { st[s] ← char[a]; s ← s+1 }};

NextCh: PROC [self: Handle] = INLINE { OPEN self;

IF c=0 THEN {

a ← IO.GetChar[stream ! IO.EndOfStream => { a ← endOfInput; CONTINUE }];

inputloc ← inputloc+1 }

ELSE { a ← ToChar[st[c]]; c ← c+1 }};

Find: PROC [self: Handle, x: Index] = { OPEN self;

x is index of name

finds name in e chain and sets w to start of def

ptr: Index ← e; -- start of definitions

w ← x; -- index of name length

DO -- search for macro name definition

match: BOOLEAN ← TRUE;

len: Index ← ToLength[st[w]];

FOR r:Index IN [0..len) DO

IF st[w+r]#st[ptr+r+1] THEN { match ← FALSE; EXIT };

ENDLOOP;

IF match THEN { w ← ptr+1+len; RETURN };

ptr ← ToIndex[st[ptr]]; -- next entry

IF ptr = maxIndex THEN EXIT; -- end of chain

ENDLOOP;

undefined

Error[MacroError,Rope.Concat["Undefined name: ",Rope.Concat[Item[self,w],AtLoc[self]]]] };

Item: PROC [self: Handle, x: Index] RETURNS [rope: ROPE] = { OPEN self;

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 [CHARACTER] = { k ← k+1; RETURN [ToChar[st[x+k]]] };

k: Index ← 0;

stklen: Index ← ToLength[st[x]];

incomplete: BOOLEAN ← stklen=0;

len: Index ← IF incomplete THEN 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.PutR[IO.int[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 };

outputloc, inputloc: INT ← 0; -- for debugging

GetChar: PUBLIC PROC [self: Handle] RETURNS [char: CHARACTER] = { OPEN self;

DO -- main loop

flag: BOOLEAN ← FALSE;

IF st = NIL THEN Error[EndOfStream, "Stream already closed"];

IF outputChar # endOfInput THEN {

char ← outputChar; outputChar ← endOfInput; outputloc ← outputloc+1; RETURN };

IF output.length > outputPtr THEN {

char ← output[outputPtr];

IF (outputPtr ← outputPtr+1) = output.length THEN

output.length ← outputPtr ← 0;

outputloc ← outputloc+1;

RETURN };

NextCh[self];

SELECT a FROM

startQuote => { q ← q+1; flag ← TRUE };

singleQuote => { NextCh[self]; Load[self]; LOOP };

startCall => { -- Fn; start new function call

st[s] ← index[h];

st[s+1] ← index[f];

st[s+2] ← index[0];

st[s+3] ← length[0];

h ← s+3;

f ← s+1;

s ← s+4;

LOOP };

sepArg => IF h=0 THEN NULL ELSE { -- NextItem; collect next arg

st[h] ← length[s-h-ToLength[st[h]]];

st[s] ← length[0];

h ← s;

s ← s+1;

LOOP };

endCall => IF h=0 THEN NULL ELSE { -- Apply;

oldstf1: Index ← ToIndex[st[f-1]];

oldstf: Index ← ToIndex[st[f]];

st[h] ← length[s-h];

st[s] ← mark;

st[f-1] ← length[s-f+2];

st[f] ← index[p];

st[f+1] ← index[c];

p ← f;

h ← oldstf1;

f ← oldstf;

s ← s+1;

IF h # 0 THEN -- increase count of extra stuff

st[h] ← length[ToLength[st[h]]+ToLength[st[p-1]]];

Find[self,p+2];

IF IsBuiltIn[st[w]] THEN {

SELECT ToBuiltIn[st[w]] FROM

DEF => { -- add a new definition

IF h # 0 THEN st[h] ← length[ToLength[st[h]]-ToLength[st[p-1]]+6];

st[p-1] ← length[6];

st[p+5] ← index[e];

e ← p+5 };

gpmVAL => { -- get value of name

Find[self,p+6];

UNTIL st[w+1]=mark DO

a ← ToChar[st[w+1]];

w ← w+1;

Load[self];

ENDLOOP };

UPDATE => { -- change value of name

y: Index;

Find[self,p+9];

y ← p+9+ToLength[st[p+9]];

IF ToLength[st[y]] > ToLength[st[w]] THEN

Error[MacroError,Rope.Concat["UPDATE arg too long for ",

Rope.Concat[Item[self,p+9],AtLoc[self]]]];

FOR r:NAT IN [1..ToLength[st[y]]] DO st[w+r] ← st[y+r]; ENDLOOP };

ENDCASE => ERROR;

EndFn[self];

LOOP };

c ← w+1;

LOOP };

numArg => IF p=0 THEN NULL ELSE { -- LoadArg;

NextCh[self]; -- read arg number

w ← p+2;

IF a NOT IN ['0..'9] THEN

Error[MacroError,Rope.Concat["Bad arg number in definition of ",Item[self,p+2]]];

FOR r:NAT IN [0..a-'0) DO

w ← w+ToLength[st[w]];

IF st[w]=mark THEN EXIT; -- act like have null arg

ENDLOOP;

IF st[w]=mark THEN LOOP;

FOR r:NAT IN [1..ToLength[st[w]]) DO

a ← ToChar[st[w+r]]; Load[self]; ENDLOOP;

LOOP };

marker => { EndFn[self]; LOOP };

endOfInput =>

IF 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 q = 1 THEN EXIT };

NextCh[self];

SELECT a FROM

startQuote => { q ← q+1; LOOP };

endOfInput => Error[MacroError,"End of input encountered inside macro quoted string"];

endQuote => NULL;

ENDCASE => LOOP;

q ← q-1;

IF q = 1 THEN EXIT;

ENDLOOP;

ENDLOOP };

ToIndex: PROC [e: Entry] RETURNS [i: Index] = INLINE { RETURN [LOOPHOLE[e]] };

WITH x:e SELECT FROM

index => RETURN [x.index];

ENDCASE => ERROR };

ToLength: PROC [e: Entry] RETURNS [i: Index] = INLINE { RETURN [LOOPHOLE[e]] };

WITH x:e SELECT FROM

length => RETURN [x.length];

ENDCASE => ERROR };

ToChar: PROC [e: Entry] RETURNS [char: CHARACTER] = INLINE { RETURN [LOOPHOLE[e]] };

WITH x:e SELECT FROM

char => RETURN [x.char];

ENDCASE => ERROR };

ToBuiltIn: PROC [e: Entry] RETURNS [name: BuiltIn] = INLINE { RETURN [LOOPHOLE[-e]] };

WITH x:e SELECT FROM

builtin => RETURN [x.name];

ENDCASE => ERROR };

index: PROC [i: Index] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[i,INTEGER]]] };

RETURN [[index[i]]] };

length: PROC [i: Index] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[i,INTEGER]]] };

RETURN [[length[i]]] };

char: PROC [c: CHARACTER] RETURNS [Entry] = INLINE { RETURN [[LOOPHOLE[c,INTEGER]]] };

RETURN [[char[c]]] };

mark: Entry ← char[marker];

[char[marker]];

marker: CHARACTER = 377C;

builtin: PROC [name: BuiltIn] RETURNS [Entry] = INLINE { RETURN [[-name]] };

RETURN [[builtin[name]]] };

IsBuiltIn: PROC [e: Entry] RETURNS [BOOLEAN] = INLINE { RETURN [e < 0] };

InitStack: PROC [self: Handle] = { OPEN self;

s ← 21; e ← 12; q ← 1; a ← endOfInput;

FOR i:NAT IN [0..20] DO st[i] ← initst[i]; ENDLOOP };

initst: REF Stack ← NEW[Stack[21]];

debugging aids

WriteStack: PROC [self: Handle] = {

h: STREAM ← FS.StreamOpen[fileName: "GPMStack.Txt", accessOptions: $create];

{ ENABLE ANY => IO.Close[h];

WriteH[self, h];

WriteC[self, h];

WritePChain[self, h];

WriteFChain[self, h];

WriteEChain[self, h];

IO.Close[h] }};

WriteChar: PROC [i: Index, self: Handle, h: STREAM] = { OPEN IO;

c: CHAR ← LOOPHOLE [MIN[self.st[i],128]];

Put[h, char[c]] };

WriteH: PROC [self: Handle, h: STREAM] = { OPEN IO;

IF self.h = 0 THEN PutRope[h, "h = 0\n"]

ELSE {

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 }};

WriteC: PROC [self: Handle, h: STREAM] = { OPEN IO;

IF self.c = 0 THEN PutRope[h, "\n\nc = 0\n\n"]

ELSE {

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 }};

WritePChain: PROC [self: Handle, h: STREAM] = { OPEN IO;

IF self.p = 0 THEN PutRope[h, "\n\np = 0\n\n"]

ELSE {

last: Index ← self.s;

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 }};

WriteFChain: PROC [self: Handle, h: STREAM] = { OPEN IO;

IF self.f = 0 THEN PutRope[h, "\n\nf = 0\n\n"]

ELSE {

last: Index ← self.s;

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 }};

WriteEChain: PROC [self: Handle, h: STREAM] = { OPEN IO;

IF self.e = 0 THEN PutRope[h, "\n\ne = 0\n\n"]

ELSE {

last: Index ← self.s;

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 }};

WriteItem: PROC [self: Handle, h: STREAM, i: Index] = { OPEN IO;

len: INTEGER ← self.st[i];

end: Index ← MIN[i+len, self.s];

Put[h, char['\t]];

FOR j: Index IN [i+1..end) DO

WriteChar[j, self, h];

ENDLOOP;

Put[h, char['\n]] };

initialization

initst[0] ← index[maxIndex];

initst[1] ← length[4];

initst[2] ← char['D];

initst[3] ← char['E];

initst[4] ← char['F];

initst[5] ← builtin[DEF];

initst[6] ← index[0];

initst[7] ← length[4];

initst[8] ← char['V];

initst[9] ← char['A];

initst[10] ← char['L];

initst[11] ← builtin[gpmVAL];

initst[12] ← index[6];

initst[13] ← length[7];

initst[14] ← char['U];

initst[15] ← char['P];

initst[16] ← char['D];

initst[17] ← char['A];

initst[18] ← char['T];

initst[19] ← char['E];

initst[20] ← builtin[UPDATE];

FreeStack[GetStack[]];

FreeText[GetText[]];

END.