<> <> <> <> 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.