MicroAccumulateImpl:
CEDAR
PROGRAM
IMPORTS
Basics, IO,
MicroDefs, MicroGlobalVars, MicroOps
EXPORTS
MicroOps, MicroUtils
= BEGIN OPEN MicroDefs, MicroGlobalVars;
MemStackObj: TYPE = REF MemStackRec;
MemStackRec:
TYPE =
RECORD[
prev: MemStackObj ← NIL,
accWord: WordSeq ← NIL, -- word being assembled
used: WordSeq ← NIL, -- bits already stored into
memory: Memory ← NIL, -- current memory
listingBuf: WordSeq ← NIL,
anyStores: BOOL ← FALSE, -- true if any stores done
location: INTEGER ← 0, -- current location in memory
symIndex: INTEGER ← 0 -- of current field (?)
];
currentMem: MemStackObj ← NIL;
RestartAcc:
PUBLIC
PROC = {
UNTIL currentMem =
NIL
DO
symb: SymbolObj = MicroOps.GetSymbol[currentMem.symIndex];
symb.sVal ← 0; -- reset memory location counter
currentMem ← currentMem.prev;
ENDLOOP;
targetSym ← 0;
};
InitAcc:
PUBLIC
PROC = {
Initialize accumulator
currentMem ← NIL;
ClearAssemWord[0];
IF targetSym # 0 THEN TargetSet[targetSym];
};
Assemble:
PUBLIC
PROC = {
Assemble top level word
IF currentMem # NIL THEN ClearAssemWord[currentMem.symIndex];
MicroOps.ProcessOneClause[accumulateVal];
IF currentMem.anyStores
THEN {
IF (currentMem.memory.memSymPost # 0) THEN APost[currentMem.memory];
Produce[];
};
};
Produce:
PROC = {
Produce assembled word
IF currentMem.location >= currentMem.memory.size
THEN {
MicroOps.ReportError[
IO.PutFR["\n *** Store out of range to %g in %g\n",
IO.int[currentMem.location],
IO.rope[MicroOps.GetSymbol[currentMem.memory.symIndex].name] ],
FALSE];
RETURN
};
MicroOps.WriteWord[currentMem.accWord, currentMem.memory, currentMem.location];
IF currentMem.listingBuf #
NIL
THEN {
options: WORD = currentMem.memory.listOptions;
IF Basics.
BITAND[options, LFany] # 0
THEN
MicroOps.ListWord[
currentMem.accWord, currentMem.listingBuf, currentMem.memory, currentMem.location, options];
};
currentMem.symIndex ←
MicroOps.AddressTagDefn[currentMem.symIndex, currentMem.memory, currentMem.location+1];
};
ClearAssemWord:
PROC[symIndex:
INTEGER] = {
Clear Assembled Word
IF currentMem #
NIL
THEN {
IF currentMem.listingBuf # NIL THEN MakeTempZero[currentMem.listingBuf];
IF currentMem.memory #
NIL
AND currentMem.memory.accumWord #
NIL
THEN {
FOR i:
INTEGER
IN [0.. currentMem.memory.accumWord.length)
DO
currentMem.accWord[i] ← currentMem.memory.accumWord[i];
ENDLOOP;
currentMem.memory.lTag ← 0;
};
currentMem.anyStores ← FALSE;
MakeZero[currentMem.used];
}
ELSE currentMem ← NEW[MemStackRec ← []];
currentMem.symIndex ← symIndex;
currentMem.location ← MicroOps.GetSymbol[symIndex].sVal;
};
SetField:
PUBLIC
PROC[symIndex:
INTEGER, val:
WORD, set:
BOOL] = {
Store val into field with name GetSymbol[symIndex].name
Error if something is in the field already, value is too big for field, or the field is too big for the memory (overflow the memory)
OPEN Basics;
symbol: SymbolObj = MicroOps.GetSymbol[symIndex];
firstBitNum: INT = symbol.sMisc;
numBits: INTEGER = LOOPHOLE[symbol.sVal, INTEGER];
IF currentMem = NIL THEN ERROR MicroDefs.Error["No target for field set"];
IF firstBitNum+numBits > currentMem.memory.widthInBits
THEN {
MicroOps.ReportError[
IO.PutFR["\n *** Field %g doesn't fit in memory %g\n",
IO.rope[symbol.name],
IO.rope[MicroOps.GetSymbol[currentMem.memory.symIndex].name] ],
FALSE];
RETURN
};
IF Basics.
BITSHIFT[val, -numBits] # 0
THEN {
MicroOps.ReportError[
IO.PutFR["\n *** Value %g doesn't fit in field %g\n",
IO.card[LOOPHOLE[val, CARDINAL]], IO.rope[symbol.name] ],
FALSE];
RETURN
};
BEGIN
used: WORD ← GetBits[currentMem.used, firstBitNum, numBits];
IF set
THEN {
IF (used # 0)
AND
(
BITAND[GetBits[currentMem.accWord, firstBitNum, numBits], used] #
BITAND[val, used])
THEN {
MicroOps.ReportError[
IO.PutFR["\n *** Field %g already set\n",
IO.rope[symbol.name] ],
FALSE];
RETURN
};
SetBits[currentMem.used, firstBitNum, numBits, 177777B];
SetBits[currentMem.accWord, firstBitNum, numBits, val];
}
ELSE
IF used # (
BITSHIFT[1, numBits] - 1)
THEN {
valToStore:
WORD ←
IF used = 0
THEN val
ELSE
BITAND[GetBits[currentMem.accWord, firstBitNum, numBits], used] +
BITAND[val, BITNOT[used]];
SetBits[currentMem.accWord, firstBitNum, numBits, valToStore];
};
END;
currentMem.anyStores ← TRUE;
};
GetField:
PUBLIC
PROC[symIndex:
INTEGER]
RETURNS[
WORD] = {
symbol: SymbolObj = MicroOps.GetSymbol[symIndex];
IF currentMem =
NIL
THEN ERROR
MicroDefs.Error[IO.PutFR["\nNo target for GetField of %g\n", IO.rope[symbol.name]] ];
RETURN[GetBits[currentMem.accWord, symbol.sMisc, LOOPHOLE[symbol.sVal, INTEGER]] ];
};
TargetSet:
PUBLIC
PROC[symIndex:
INTEGER] = {
memIndex: INTEGER;
IF currentMem.prev # NIL THEN ERROR MicroDefs.Error["\"Target\" not legal inside Store\n"];
IF currentMem.anyStores THEN ERROR MicroDefs.Error["\"Target\" given after field set\n"];
MemPop[];
memIndex ← MicroOps.GetSymbol[symIndex].sMisc;
MemPush[NARROW[MicroOps.GetSymbol[memIndex].sData]];
ClearAssemWord[symIndex];
targetSym ← symIndex;
};
MemPush:
PROC[newMem: Memory] = {
Push currentMem accumulator
length: NAT = newMem.widthInWords;
currentMem ←
NEW[MemStackRec ← [
prev: currentMem,
memory: newMem,
accWord: NEW[WordSeqRec[length]],
used: NEW[WordSeqRec[length]]
] ];
MakeZero[currentMem.accWord];
MakeZero[currentMem.used];
IF expandedListingFlag
AND ((currentMem.prev =
NIL)
OR (listTargetOnlyFlag =
FALSE))
THEN {
currentMem.listingBuf ← NEW[WordSeqRec[newMem.widthInBits]];
MakeTempZero[currentMem.listingBuf];
}
ELSE currentMem.listingBuf ← NIL;
};
MemPop:
PROC = {
Pop old accumulator
currentMem ← currentMem.prev;
};
LabelDefn:
PUBLIC
PROC[symIndex:
INTEGER, symb:
ATOM] = {
sObj: SymbolObj;
IF symIndex = 0
THEN [symIndex, sObj] ← MicroOps.PutInSymbol[symb, addressType]
ELSE sObj ← MicroOps.GetSymbol[symIndex];
sObj.sMisc ← currentMem.memory.symIndex;
symIndex ← MicroOps.AddressTagDefn[symIndex, currentMem.memory, currentMem.location];
IF currentMem.prev =
NIL
THEN
{ labelSymIndex ← symIndex; labelLineCount ← stmtLineCount };
};
UndefnRef:
PUBLIC
PROC[feIndex:
INTEGER, symIndex:
INTEGER] = {
Write undefined reference
sObj: SymbolObj = MicroOps.GetSymbol[symIndex];
IF currentMem.symIndex = 0
THEN
MicroOps.ReportError[
IO.PutFR["\n *** Undefined symbol %g in 'DEFAULT'\n", IO.rope[sObj.name]],
FALSE]
ELSE {
MicroOps.WriteFixup[currentMem.memory.symIndex, currentMem.location, feIndex, symIndex];
currentMem.anyStores ← TRUE;
};
};
IsFieldSet:
PUBLIC
PROC[symIndex:
INTEGER]
RETURNS[
BOOL] = {
Test if field has been set
symb: SymbolObj = MicroOps.GetSymbol[symIndex];
RETURN[GetBits[currentMem.used, symb.sMisc, LOOPHOLE[symb.sVal, INTEGER]] # 0]
};
StoreBuiltin:
PUBLIC
PROC[
symIndex: INTEGER, aPtr: LONG POINTER TO WORD, lx: INTEGER] = {
memIndex: INTEGER = MicroOps.GetSymbol[symIndex].sMisc;
mem: Memory = NARROW[MicroOps.GetSymbol[memIndex].sData];
MemPush[mem];
ClearAssemWord[symIndex];
[] ← MicroOps.ProcessStmt[aPtr, lx, accumulateVal];
IF (mem.memSymPost # 0) THEN APost[mem];
Produce[];
MemPop[];
};
DefaultBuiltin:
PUBLIC
PROC[
symIndex: INTEGER, aPtr: LONG POINTER TO WORD, lx: INTEGER] = {
mem: Memory;
sObj: SymbolObj;
sObj ← MicroOps.GetSymbol[symIndex];
MemPush[mem ← NARROW[sObj.sData]];
ClearAssemWord[0];
[] ← MicroOps.ProcessStmt[aPtr, lx, accumulateVal];
mem.accumWord ← currentMem.accWord; -- move bits to the memory
MemPop[];
};
SetListFieldsBuiltin:
PUBLIC
PROC[
symIndex: INTEGER, aPtr: LONG POINTER TO WORD, lx: INTEGER] = TRUSTED {
bn: INTEGER ← 0;
sObj: SymbolObj;
mem: Memory;
map: WordSeq;
memWidth: INTEGER;
i: NAT ← 0;
sObj ← MicroOps.GetSymbol[symIndex];
mem ← NARROW[sObj.sData];
map ← mem.listFields;
memWidth ← mem.widthInBits;
MemPush[mem];
ClearAssemWord[0];
[] ← MicroOps.ProcessStmt[aPtr, lx, accumulateVal];
WHILE (bn # memWidth)
DO
bn1: INTEGER ← bn;
DO
bn ← bn + 1;
IF (bn = memWidth) OR (GetBits[currentMem.accWord, bn-1, 1] # 0) THEN EXIT;
ENDLOOP;
map[i] ← LOOPHOLE[bn - bn1];
i ← i + 1;
ENDLOOP;
MemPop[];
};
APost:
PROC[mem: Memory] = {
Do the post-macro for memory mem
old: NAT ← stmtTailBottom;
[] ← MicroOps.PushStmtChar[endc]; -- set end mark
MicroOps.MacroCall[mem.memSymPost, 0];
MicroOps.ProcessOneClause[accumulateVal];
stmtTailBottom ← old;
};
GetBits:
PUBLIC
PROC[acw: WordSeq, firstBitNum, numBits:
INTEGER]
RETURNS[WORD] = {
this code depends on no field being more than 16 bits wide
OPEN Basics;
mask: WORD = MakeMask[numBits];
whichCase: WhichBitsCase;
shift, index: NAT;
[whichCase, index, shift] ← WhichBits[firstBitNum, numBits];
SELECT whichCase
FROM
oneOnly => RETURN[BITAND[BITSHIFT[acw[index], -shift], mask]];
twoWords => {
ln: LongNumber;
val: WORD;
ln.lo ← acw[index+1];
ln.hi ← acw[index];
val ← Basics.ExtractWordField[ln, shift];
RETURN[Basics.BITAND[LOOPHOLE[val], mask] ];
};
ENDCASE =>
ERROR MicroDefs.Error[
IO.PutFR["\n FirstBitNum (%g) or NumBits (%g) out of range\n",
IO.card[firstBitNum], IO.card[numBits]] ];
};
WhichBitsCase: TYPE = {oneOnly, twoWords, outOfRange};
SetBits:
PUBLIC
PROC[acw: WordSeq, firstBitNum, numBits:
INTEGER, val:
WORD] = {
OPEN Basics;
mask: WORD ← MakeMask[numBits];
shift, index: NAT;
whichCase: WhichBitsCase;
valToStore: WORD = BITAND[mask, val];
[whichCase, index, shift] ← WhichBits[firstBitNum, numBits];
SELECT whichCase
FROM
oneOnly => {
ln1, ln2: LongNumber;
ln1.lo ← acw[index]; ln1.hi ← 0;
ln2.lo ← mask; ln2.hi ← 0;
TRUSTED { ln1 ← DoubleAnd[ln1, DoubleNot[DoubleShiftLeft[ln2, shift]]] };
ln2.lo ← valToStore; ln2.hi ← 0;
TRUSTED { ln1 ← DoubleOr[ln1, DoubleShiftLeft[ln2, shift]] };
acw[index] ← ln1.lo;
};
twoWords => {
ln1, ln2: LongNumber;
ln1.lo ← acw[index+1]; ln1.hi ← acw[index];
ln2.lo ← mask; ln2.hi ← 0;
TRUSTED { ln1 ← DoubleAnd[ln1, DoubleNot[DoubleShiftLeft[ln2, shift]]] };
ln2.lo ← valToStore; ln2.hi ← 0;
TRUSTED { ln1 ← DoubleOr[ln1, DoubleShiftLeft[ln2, shift]] };
acw[index+1] ← ln1.lo; acw[index] ← ln1.hi;
};
ENDCASE =>
ERROR MicroDefs.Error[
IO.PutFR["\n FirstBitNum (%g) or NumBits (%g) out of range\n",
IO.card[firstBitNum], IO.card[numBits]] ];
};
WhichBits:
PROC[firstBit, numBits:
INTEGER]
RETURNS[whichCase: WhichBitsCase, leftIndex, shift: NAT] = {
rightMost: INTEGER = firstBit + numBits - 1;
rightIndex: INTEGER = rightMost/16;
leftIndex ← firstBit/16;
shift ← (rightIndex+1)*16 - rightMost - 1;
IF leftIndex = rightIndex
THEN whichCase ← oneOnly
ELSE
IF leftIndex+1 = rightIndex
THEN whichCase ← twoWords
ELSE
{whichCase ← outOfRange; leftIndex ← shift ← 0 };
};
MakeZero:
PROC[acw: WordSeq] =
{ IF acw # NIL THEN FOR i: NAT IN [0..acw.length) DO acw[i] ← 0; ENDLOOP };
MakeTempZero:
PROC[tmp: WordSeq] =
{ FOR i: NAT IN [0..tmp.length) DO tmp[i] ← 0; ENDLOOP };
MakeMask:
PROC[num:
CARDINAL]
RETURNS[
WORD] = {
SELECT num
FROM
0 => RETURN[0];
1 => RETURN[1];
2 => RETURN[3];
3 => RETURN[7];
4 => RETURN[17B];
5 => RETURN[37B];
6 => RETURN[77B];
7 => RETURN[177B];
8 => RETURN[377B];
9 => RETURN[777B];
10 => RETURN[1777B];
11 => RETURN[3777B];
12 => RETURN[7777B];
13 => RETURN[17777B];
14 => RETURN[37777B];
15 => RETURN[77777B];
16 => RETURN[177777B];
ENDCASE =>
ERROR MicroDefs.Error[IO.PutFR["\nNumBits field too big (%g)\n", IO.card[num]] ];
};
END.