DIRECTORY
Ascii USING [Digit],
Basics USING [BITAND],
IO,
Rope,
VM USING [AddressForPageNumber, SimpleAllocate, WordsForPages],

MicroDefs,
MicroGlobalVars,
MicroOps,
MicroUtils USING [GetCharAtPointer, PutCharAtPointer];

MicroMacroOpsImpl: CEDAR PROGRAM

IMPORTS
Ascii, IO, VM,
MicroDefs, MicroGlobalVars, MicroOps, MicroUtils

EXPORTS
MicroOps

= BEGIN OPEN MicroDefs, MicroGlobalVars;

argumentBuffer: LONG POINTER TO WORD _ NIL;
argBufEnd, argPtr: LONG POINTER TO WORD _ NIL;
macDefnBuffer: LONG POINTER TO WORD _ NIL;

numMacroPages: INT = 256;		-- be generous, we can only do this once!
macroInitialFree: INT = VM.WordsForPages[numMacroPages];
macroIndex: PUBLIC INT;
freeMacroSpace: INT;

InitMacroOps: PUBLIC PROC = TRUSTED {
numPages: INT = 4;
IF argumentBuffer = NIL THEN {
buf: LONG POINTER _ VM.AddressForPageNumber[VM.SimpleAllocate[numPages].page];
argumentBuffer _ LOOPHOLE[buf, LONG POINTER TO WORD];
buf _ VM.AddressForPageNumber[VM.SimpleAllocate[2*numPages].page];
macDefnBuffer _ LOOPHOLE[buf, LONG POINTER TO WORD];
AllocMacroStorage[];
};
argBufEnd _ argumentBuffer + VM.WordsForPages[numPages];
argPtr _ argBufEnd;
nextMacroIndex _ 1;		-- 0 means no macro defn!
freeMacroSpace _ macroInitialFree;
};

ArgString: PUBLIC PROC[nChars: INTEGER] RETURNS[LONG POINTER TO WORD] =
TRUSTED {
maybeArgP: INT = LOOPHOLE[argPtr - nChars - 1];
IF maybeArgP < LOOPHOLE[argumentBuffer, INT] THEN
MicroDefs.Error["Macro argument storage full\n"];
argPtr _ argPtr - nChars - 1;
argPtr^ _ nChars + 1;
RETURN[argPtr+1];
};

CollectArgs: PUBLIC PROC RETURNS[nArgs: INT] = TRUSTED {
nesting: INT _ 0;
stPtr, oldStPtr: NAT _ stmtBufferTop;
nWords: NAT;
nArgs _ 0;

DO
ch: CHAR _ MicroOps.GetStmtChar[stPtr _ stPtr - 1];
SELECT ch FROM
endc => ERROR MicroDefs.Error["Brackets mismatched - bug"];

symc, numc, num6c => stPtr _ stPtr - 1;

'( => nesting _ nesting - 1;

'[ => {
IF nesting # 0 THEN { nesting _ nesting - 1; LOOP};
MicroOps.PutStmtValue[stPtr, oldStPtr - stPtr];
nArgs _ nArgs + 1;
EXIT
};

', => {		-- comma
IF nesting # 0 THEN LOOP;		-- enclosed in () or []
MicroOps.PutStmtValue[stPtr, oldStPtr - stPtr];
nArgs _ nArgs + 1;
oldStPtr _ stPtr;
LOOP;
};

'), '] => nesting _ nesting + 1;

ENDCASE => stPtr _ stPtr;		-- so can set a breakpoint here
ENDLOOP;
nWords _ stmtBufferTop - stPtr;
stmtBufferTop _ stPtr;
IF LOOPHOLE[argPtr - nWords, INT] < LOOPHOLE[argumentBuffer, INT] THEN {
MicroOps.ReportError["\n ***Macro argument storage full\n", FALSE];
RETURN[0];
};
FOR i: NAT DECREASING IN [stPtr .. stPtr+nWords) DO
argPtr _ argPtr - 1;
argPtr^ _ (stmtBuffer+i)^;
ENDLOOP;
RETURN[nArgs];		-- redundant, for info only
};

stmtTooLong: ROPE = "\n ***Statement too long\n";

MacroCall: PUBLIC PROC[symIndex: INTEGER, nArgs: INTEGER] = {
dP: LONG POINTER TO WORD;
symb: SymbolObj;
sType: SymbolType;
free: INTEGER;
myArgsPtr: LONG POINTER TO WORD _ argPtr;

CopyArgument: PROC[nP: LONG POINTER TO WORD] RETURNS[continue: BOOL] = {
nL: INTEGER;
TRUSTED { nL _ nP^ - 1};
IF nL = 0 THEN RETURN[TRUE];
IF nL >= free THEN {
MicroOps.ReportError[stmtTooLong,  FALSE];
RETURN[FALSE];
};
free _ free - nL;
FOR i: INTEGER IN [0..nL) DO
TRUSTED {
nP _ nP + 1;
[] _ MicroOps.PushStmtValue[nP^]
};
ENDLOOP;
RETURN[TRUE];
};

IF traceCalls THEN TraceMacroCall[symIndex, nArgs];
symb _ MicroOps.GetSymbol[symIndex];
sType _ symb.sType;
IF sType = macroType THEN TRUSTED {		-- expand macro
nP: LONG POINTER TO WORD;
dpI: REF INT _ NARROW[symb.sData];
dP _ MacroDefnFromIndex[dpI^];
TRUSTED { free _ stmtTailBottom - stmtBufferTop - dP^ };
IF free <= 0 THEN {
MicroOps.ReportError[stmtTooLong, FALSE];
RETURN
};
DO
ch: CHAR;
dP _ dP + 1;
ch _ MicroUtils.GetCharAtPointer[dP];
SELECT ch FROM
Aargn => {		-- Copy param'th argument
param: INTEGER;
dP _ dP + 1;
param _ dP^;
IF param > nArgs THEN LOOP;
nP _ myArgsPtr;
FOR i: INTEGER IN [2..param] DO
nP _ nP + nP^; ENDLOOP;
IF ~CopyArgument[nP] THEN EXIT;
};
Aarg1 => {		--  Copy argument 1
IF nArgs = 0 THEN LOOP;
IF ~CopyArgument[myArgsPtr] THEN EXIT;
};
Aarg2 => {		-- Copy argument 2
IF nArgs <= 1 THEN LOOP;
IF ~CopyArgument[myArgsPtr + myArgsPtr^] THEN EXIT;
};
Anargs => {		-- Give number of args
IF nArgs >= 8 THEN [] _ MicroOps.PushStmtChar[(nArgs/8) + '0];
[] _ MicroOps.PushStmtChar[Basics.BITAND[LOOPHOLE[nArgs], 7] + '0];
};
symc, numc, num6c => {		-- Packed value, short (push in reverse order)
[] _ MicroOps.PushStmtValue[(dP+1)^];
[] _ MicroOps.PushStmtValue[dP^];
dP _ dP + 1;
};
40C => {		-- Packed value, long
ERROR;		-- should not occur
};
Aend => EXIT;		-- End of definition
ENDCASE => [] _ MicroOps.PushStmtValue[dP^];		-- default

ENDLOOP;
}
ELSE
SELECT sType FROM
fieldType =>
IF nArgs = 1 THEN TRUSTED {
lx: INTEGER _ LOOPHOLE[myArgsPtr^, INTEGER] - 1;
MicroOps.DoField[symIndex, myArgsPtr+1, lx, TRUE]
}
ELSE MacroError[symb, nArgs];
builtInType => MicroOps.DoBuiltIn[symIndex, nArgs, myArgsPtr];
memoryType =>
IF nArgs = 2 THEN TRUSTED {
sP: LONG POINTER TO WORD _ myArgsPtr + 1;
secondParam: LONG POINTER TO WORD = myArgsPtr + myArgsPtr^;
sLen: INTEGER = LOOPHOLE[secondParam^, INTEGER] - 1;
loc: INTEGER = MicroOps.EvalArg[secondParam+1, sLen];
memSymb: SymbolObj = MicroOps.GetSymbol[symIndex];
memory: Memory = NARROW[memSymb.sData];
atm: ATOM;
s2Index: INTEGER;
s2Len: INTEGER = LOOPHOLE[myArgsPtr^, INTEGER] - 1;
[s2Index, atm] _ ExpandArgForIndex[sP, s2Len];
IF s2Index = 0 THEN
s2Index _ MicroOps.PutInSymbol[atm, nullType].symIndex;
[] _ MicroOps.AddressTagDefn[s2Index, memory, loc];
}
ELSE MacroError[symb, nArgs];
addressType => TRUSTED {
IF nArgs = 1 THEN {
lx: INTEGER = LOOPHOLE[myArgsPtr^, INTEGER] - 1;
MicroOps.StoreBuiltin[symIndex, myArgsPtr+1, lx]
}
ELSE MacroError[symb, nArgs];
};
ENDCASE =>
MicroOps.ReportError[
IO.PutFR["\n *** %g may not be followed by []\n",
	IO.rope[symb.name]],
FALSE];
FOR i: INTEGER IN [1..nArgs] DO
TRUSTED {argPtr _ argPtr + argPtr^}; ENDLOOP;
};

MacroDefn: PUBLIC PROC[argP: LONG POINTER TO WORD, lx: INTEGER]
	RETURNS[macroDefnIndex: INT] = TRUSTED {

endP: LONG POINTER TO WORD = argP+lx;
cP: LONG POINTER TO WORD _ endP;
di: INTEGER _ lx;
ckLen: INTEGER _ lx;		-- Length for initial check at call time
ch: CHAR _ LAST[CHAR];
nWords: INT;

IF lx = 0 THEN {		-- avoids negative di below
macroDefnIndex _ AllocMacroDefn[2];
(macroStorageStart+macroDefnIndex)^ _ 0;
MicroUtils.PutCharAtPointer[macroStorageStart+macroDefnIndex+1, Aend];
RETURN[macroDefnIndex];
};

UNTIL cP = argP DO
lastCh: CHAR _ ch;
cP _ cP - 1;
di _ di - 1;
ch _ MicroUtils.GetCharAtPointer[cP];
IF (ch = '#) AND Ascii.Digit[lastCh] THEN {		-- Argument
aC: CHAR = MicroUtils.GetCharAtPointer[cP+1];
di _ di + 1;		-- we eliminate the #
SELECT aC FROM
'0 => ch _ Anargs;
'1 => ch _ Aarg1;
'2 => ch _ Aarg2;
ENDCASE => {
(macDefnBuffer+di)^ _ LOOPHOLE[aC - '0];
di _ di - 1;
ch _ Aargn;
};
IF aC # '0 THEN ckLen _ ckLen - 1;
}		-- end of Argument
ELSE IF ch < 40C THEN {		-- Packed value (no need for long format stuff)
(macDefnBuffer+di)^ _ (cP _ cP - 1)^;
di _ di - 1;
};
MicroUtils.PutCharAtPointer[macDefnBuffer+di, ch];
ENDLOOP;
nWords _ lx - di;
macroDefnIndex _ AllocMacroDefn[nWords + 2];
FOR i: INT IN [1..nWords] DO
(macroStorageStart+macroDefnIndex+i)^ _ (macDefnBuffer+di+i-1)^;
ENDLOOP;
MicroUtils.PutCharAtPointer[macroStorageStart+macroDefnIndex+nWords+1, Aend];
(macroStorageStart+macroDefnIndex)^ _ ckLen;
RETURN[macroDefnIndex];
};

ExpandArgForIndex: PROC[aPtr: LONG POINTER TO WORD, len: INTEGER]
RETURNS[symIndex: INTEGER, symb: ATOM] = {
argRef: ArgRef;
IF len = 2 THEN TRUSTED {
IF (aPtr+1)^ < 40B AND MicroUtils.GetCharAtPointer[aPtr+1] = symc THEN
RETURN[LOOPHOLE[aPtr^, INTEGER], NIL]
};
argRef _ NEW[ArgRec _ [aPtr, len]];
[] _ MicroOps.Expand[argRef];
[symIndex, symb] _ MicroOps.LookupSymbol[argRef.aPtr, argRef.lx];
};

MacroError: PROC[symb: SymbolObj, nArgs: INTEGER] = {
MicroOps.ReportError[
IO.PutFR["\n *** Wrong number (%g) of args for %g\n",
	IO.int[nArgs], IO.rope[symb.name] ], 
FALSE];
};

TraceMacroCall: PROC[symIndex: INTEGER, nArgs: INTEGER] = {
ap: LONG POINTER TO WORD _ argPtr;
lStrm: STREAM = listingFileRec.strm;
ListArgsBlock: PROC[aP: LONG POINTER TO WORD, nChars: INTEGER] = {
lx: INTEGER;
IF lx = -1 THEN {		-- no expansion
FOR i: NAT IN [0..nChars) DO
TRUSTED { lStrm.PutChar[MicroUtils.GetCharAtPointer[aP+i]] };
ENDLOOP;
}
ELSE {		-- nyi
};
};

lStrm.PutF["* %g\n", IO.rope[MicroOps.GetSymbol[symIndex].name] ];
FOR i: NAT IN [0..nArgs) DO
lStrm.PutRope["\n*\t"];
TRUSTED {
lx: INTEGER = LOOPHOLE[ap^, INTEGER] - 1;
ListArgsBlock[ap+1, lx];
ap _ ap + ap^;
};
ENDLOOP;
lStrm.PutChar['\n];
};

MacroDefnFromIndex: PUBLIC PROC[macroDefnIndex: INT]
		RETURNS[LONG POINTER TO WORD] = TRUSTED {
RETURN[macroStorageStart+macroDefnIndex];
};

AllocMacroDefn: PROC[len: INT] RETURNS[new: INT] = TRUSTED {
IF freeMacroSpace < len THEN MicroDefs.Error["Macro storage full\n"];
new _ nextMacroIndex;
nextMacroIndex _ nextMacroIndex + len;
freeMacroSpace _ freeMacroSpace - len;
};

AllocMacroStorage: PROC = TRUSTED {
numPages: INT = 256;		-- be generous, we only do this once!
buf: LONG POINTER _ VM.AddressForPageNumber[VM.SimpleAllocate[numPages].page];
macroStorageStart _ LOOPHOLE[buf, LONG POINTER TO WORD];
freeMacroSpace _ macroInitialFree;
};

END.
:MicroMacroOpsImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Willie-sue, February 26, 1986 11:35:16 am PST
taken from MicMac.bcpl
Allocate an n-char. argument string
Collect macro arguments, return # of args.
Note: the statement reading routine guarantees proper nesting
of parens and brackets, and nothing in the language can destroy it,
so no stack is necessary here.
Note we read the buffer backwards, so we see ]'s and )'s first

argPtr _ argPtr - nWords;
Do macro call

clear away argList
Parse macro definition.
Ok to do this into macDefnBuffer, one char (integer) per word;  parsed version is always smaller than unpacked original, so macDefnBuffer need only be twice as big as the argumentBuffer.
get space for unpacked body of macro defn
Internal procedures

Trace the call for debugging
Κ
s˜š
œ™Icodešœ
Οm
œ1™<K™-J˜Jš
œ™—J˜š
Οk	˜	Jšœžœ	˜Jšœžœžœ˜Jšžœ
˜Jš
œ˜Jšžœ
žœ7˜?J˜J˜
J˜J˜	Jšœžœ&˜6—J˜šœžœ
ž˜ J˜š
ž˜Jšœžœžœ
˜Jš
œ0˜0—J˜š
ž˜Jš
œ˜—J˜Jšœžœ
žœ˜(J˜Jšœžœžœ
˜+Jšœžœžœ
˜.Jšœžœžœ
˜*J˜Jšœžœ	Οc)˜DJšœžœžœ˜8Jšœžœ
žœ
˜Jšœžœ
˜J˜šΟnœžœ
žœžœ˜%Jšœ
žœ˜šžœžœ
žœ˜Jš	œžœ
žœžœžœ ˜NJšœžœžœ˜5Jšœžœžœ"˜BJšœžœžœ˜4Jš
œ˜J˜—Jšœžœ˜8Jš
œ˜JšœŸ˜.Jš
œ"˜"J˜—J˜š 	œžœ
žœ	žœžœ
žœ˜GJšžœ˜	J™#Jšœžœžœ˜/šžœ
žœžœž˜1J˜1—Jš
œ˜Jš
œ˜Jšžœ˜J˜—J˜š œžœ
žœ
žœžœžœ˜8J™*J™=J™CJ™J™>J™Jšœ	žœ˜Jšœžœ˜%Jšœžœ
˜Jš
œ
˜
J˜š
ž˜Jšœžœ+˜3šžœž˜Jšœžœ.˜;J˜Jš
œ'˜'J˜J˜J˜˜Jšžœ
žœžœ˜3Jš
œ/˜/J˜Jš
ž˜J˜—J˜šœ	Ÿ˜Jšžœ
žœ
žœŸ˜2Jš
œ/˜/J˜Jš
œ˜Jšžœ
˜J˜—J˜J˜ J˜JšžœŸ˜:—Jšžœ
˜—Jš
œ˜Jš
œ˜šžœ
žœžœžœžœžœ˜HJšœ:žœ˜CJšžœ˜
J˜—Jš
œ™šžœžœ
ž
œž˜3Jš
œ˜Jš
œ˜Jšžœ
˜—Jšžœ
Ÿ˜+J˜—J˜Jšœ
žœ ˜1J˜š
 	œžœ
žœžœ	žœ˜=J™
Jšœžœ
˜J˜Jš
œ˜Jšœžœ
˜Jš	œžœ
žœ
žœ
žœ
˜)J˜š
 œžœžœžœžœ˜HJšœžœ
˜Jšžœ˜Jšžœžœ
žœ
žœ˜šžœžœ˜Jšœ#žœ˜*Jšžœ
žœ˜J˜—J˜šžœžœ
žœ	ž˜šžœ˜	J˜Jš
œ ˜ Jš
œ˜—Jšžœ
˜—Jšžœ
žœ˜
J˜—J˜Jšžœžœ!˜3Jš
œ$˜$Jš
œ˜šžœžœ
žœŸ˜4Jšœžœ
˜Jšœžœ
žœžœ
˜"Jš
œ˜Jšžœ1˜8šžœž˜Jšœ"žœ˜)Jš
ž˜J˜—š
ž˜Jšœžœ
˜	J˜Jš
œ%˜%šžœž˜šœŸ˜%Jšœžœ
˜Jš
œ˜J˜Jšžœžœ
žœ
˜Jš
œ˜šžœžœ
žœž˜Jšœžœ
˜—Jšžœžœ
žœ
˜J˜—šœŸ˜Jšžœžœ
žœ
˜Jšžœžœ
žœ
˜&J˜—šœŸ˜Jšžœžœ
žœ
˜Jšžœ'žœ
žœ
˜3J˜—šœ
Ÿ˜#Jšžœžœ,˜>Jšœ"žœ
žœ˜CJ˜—šœŸ.˜FJš
œ%˜%Jš
œ!˜!J˜J˜—šœ
Ÿ˜JšžœŸ˜J˜—JšœžœŸ˜#Jšžœ'Ÿ
˜8—J˜Jšžœ
˜J˜
š
ž˜šžœž˜˜šžœžœ
žœ˜Jšœžœžœ
žœ˜0Jšœ,žœ
˜1J˜
Jšžœ˜——Jš
œ>˜>˜
šžœžœ
žœ˜Jšœžœ˜)Jšœ
žœ˜;Jšœžœžœžœ˜4Jšœžœ)˜5Jš
œ2˜2Jšœžœ˜'Jšœžœ
˜
Jšœ	žœ
˜Jšœžœžœ
žœ˜3Jš
œ.˜.šžœ
ž˜Jš
œ7˜7—Jš
œ3˜3J˜
Jšžœ˜——šœžœ˜šžœžœ˜Jšœžœžœ
žœ˜0Jš
œ0˜0J˜
Jšžœ˜J˜——šžœ˜
š
œ˜šžœ/˜1Jšœ
žœ˜—Jšžœ˜———J™Jš
œ™šžœžœ
žœž˜Jšžœžœ
˜-————J˜—J˜š
 	œžœ
žœžœžœ
˜?Jšœ
žœžœžœ˜)J™Jš
œΊ
™Ί
J˜Jšœžœ˜%Jšœžœ˜ Jšœžœ˜JšœžœŸ(˜>Jšœžœžœ
žœ˜Jšœžœ
˜J˜šžœžœŸ˜-Jš
œ#˜#Jš
œ(˜(Jš
œF˜FJšžœ˜J˜—J˜šžœž˜Jšœžœ˜J˜J˜Jš
œ%˜%šžœžœžœŸ˜8Jšœžœ%˜-JšœŸ˜#šžœž˜J˜J˜J˜šžœ˜Jšœžœ
˜(J˜J˜J˜——Jšžœ	žœ˜"JšœŸ˜šžœ
žœ
žœŸ/˜HJš
œ%˜%J˜J˜—Jš
œ2˜2—Jšžœ
˜—Jš
œ)™)J˜Jš
œ,˜,šžœžœ
žœ
ž˜Jš
œ@˜@Jšžœ
˜—Jš
œM˜MJš
œ,˜,Jšžœ˜J˜—J˜—™J™š œžœžœ
žœ
žœ
žœžœ
˜AJšžœžœžœ˜*Jš
œ˜šžœ	žœ
žœ˜šžœžœ,ž˜FJšžœ
žœžœžœ
˜%—J˜—Jšœ	žœ˜#Jš
œ˜Jš
œA˜AJ˜—J˜š 
œžœžœ˜5š
œ˜šžœ3˜5Jšžœ
žœ˜&—Jšžœ˜—J˜—J˜š œžœžœ	žœ˜;J™Jšœžœ
˜"Jšœžœ˜$š 
œžœžœ
žœ˜BJšœžœ
˜šžœ	žœŸ˜"šžœžœ
žœ
ž˜Jšžœ6˜=Jšžœ
˜—J˜
JšžœŸ˜J˜—˜J˜——Jšœžœ+˜Bšžœžœ
žœž˜Jš
œ˜šžœ˜	Jšœžœžœžœ˜)Jš
œ˜J˜J˜—Jšžœ
˜—Jš
œ˜J˜—J˜š œžœ
žœžœ
˜4Jš
œžœ
žœ
žœ
žœ
žœžœ˜+Jšžœ#˜)J˜—J˜š œžœžœžœžœžœ˜<Jšžœžœ)˜EJš
œ˜Jš
œ&˜&Jš
œ&˜&J˜—J˜š œžœžœ˜#Jšœ
žœ	Ÿ%˜;Jš	œžœ
žœžœžœ ˜NJšœžœžœ˜8Jš
œ"˜"J˜—J˜Jšžœ
˜——…—#ξ4›