DIRECTORY
Atom USING [PropList, PutPropOnList],
DragOpsCross USING [Byte, bytesPerWord, FourBytes, Inst, JBBformat, JDist8, LRRBformat, QRformat, RJBformat, RRformat, ShortRegQR, TrapBase, TrapWidthBytes, Word, wordsPerPage, XopBase, ZerosWord],
DragOpsCrossUtils USING [BytePCToWordAddress, CardToByte, CardToHalf, CardToWord, WordToBytes, WordToCard],
HandCoding USING [drJ1, drJ2, drJ3, IllegalDst, IllegalMix, IllegalSrc, Lit16, Lit8, RegSpec, ShortRegSpec],
HandCodingSupport USING [Area, AreaRep, GetProc, ProcList, PutProc],
ProcessProps USING [AddPropList, GetPropList];
HandCodingSupportImpl:
CEDAR
PROGRAM
IMPORTS Atom, DragOpsCrossUtils, HandCoding, ProcessProps
EXPORTS HandCodingSupport
= BEGIN OPEN DragOpsCross, DragOpsCrossUtils, HandCoding, HandCodingSupport;
CARD: TYPE = LONG CARDINAL;
initInst:
CARD = TrapBase*bytesPerWord+64*TrapWidthBytes;
initial code loc starts somewhat after the last trap location (we leave room for 64 traps, although only 32 are currently defined)
initData:
CARD = XopBase*bytesPerWord*2;
well out of the range of the traps or the initial code
Output area stuff
NewArea:
PUBLIC PROC [name:
ATOM, getWord: GetProc, putWord: PutProc, data:
REF ←
NIL]
RETURNS [Area] = {
Creates a new code area.
RETURN [
NEW[AreaRep ← [
name: name, props: NIL,
currentPC: initInst, currentData: initData,
currentWord: ZerosWord, currentDirty: FALSE,
getWord: getWord, putWord: putWord, data: data]]];
};
GenWithArea:
PUBLIC PROC [area: Area, list: ProcList] = {
Places the area on the process property list under the property $CurrentArea, then calls each procedure in the procedure list, then returns (with the process property list reset to its original value).
inner:
PROC = {
FOR each: ProcList ← list, each.rest
WHILE each #
NIL
DO
each.first[];
ENDLOOP };
Gen1WithArea[area, inner];
};
Gen1WithArea:
PUBLIC PROC [area: Area, proc:
PROC] = {
Places the area on the process property list under the property $CurrentArea, then calls proc (which may be a nested procedure), then returns (with the process property list reset to its original value).
inner:
PROC = {
proc[];
ForceOut[area];
};
IF area = NIL THEN area ← GetCurrentArea[];
ProcessProps.AddPropList[
Atom.PutPropOnList[NIL, $CurrentArea, area],
inner];
};
ForceOut:
PUBLIC PROC [area: Area] = {
Forces the area to dump any buffering it has into the output.
addr: INT;
index: [0..bytesPerWord);
IF area = NIL THEN area ← GetCurrentArea[];
[addr, index] ← ConvertCurrentPC[area];
IF area.currentDirty
THEN {
area.putWord[area.data, addr, area.currentWord];
area.currentDirty ← FALSE;
};
};
EmptyArea: PUBLIC ERROR = CODE;
GetCurrentArea:
PUBLIC PROC [nilOK:
BOOL ←
FALSE]
RETURNS [area: Area ←
NIL] = {
Gets the current output area as established by GenWithArea.
FOR each: Atom.PropList ← ProcessProps.GetPropList[], each.rest
WHILE each #
NIL
DO
IF each.first.key = $CurrentArea THEN {area ← NARROW[each.first.val]; EXIT};
ENDLOOP;
IF NOT nilOK AND area = NIL THEN ERROR EmptyArea;
};
Format Common Routines
InstToByte:
PROC [inst: Inst]
RETURNS [Byte] =
INLINE {
RETURN [
LOOPHOLE[inst]]};
OQBcommon:
PUBLIC
PROC [op: Inst, rest: Word] = {
area: Area = GetCurrentArea[];
OutputByte[area, InstToByte[op]];
OutputAlphaBetaGammaDelta[area, rest];
};
OIcommon:
PUBLIC
PROC [op: Inst] = {
OutputByte[GetCurrentArea[], InstToByte[op]];
};
LRcommon:
PUBLIC
PROC [op: Inst, reg: RegSpec] = {
WITH r: reg
SELECT
FROM
reg => {op ← LOOPHOLE[LOOPHOLE[op, CARDINAL] + r.reg]};
ENDCASE => ERROR IllegalSrc;
OutputByte[GetCurrentArea[], InstToByte[op]];
};
QRcommon:
PUBLIC
PROC [op: Inst, left: DragOpsCross.ShortRegQR, right: RegSpec] = {
form: QRformat ← LOOPHOLE[0];
form.aOp ← VAL[ORD[left]];
WITH r: right
SELECT
FROM
dstStack => ERROR IllegalSrc;
reg => {form.reg ← r.reg};
aux => {form.reg ← r.aux; form.aux ← TRUE};
const => {form.reg ← r.const; form.opt ← TRUE};
srcStack => {form.reg ← r.stack; form.opt ← TRUE};
ENDCASE => ERROR IllegalSrc;
form.op ← op;
OutputAlphaBeta[GetCurrentArea[], LOOPHOLE[form, CARDINAL]];
};
OBcommon:
PUBLIC
PROC [op: Inst, lit: Lit8] = {
area: Area = GetCurrentArea[];
OutputByte[area, InstToByte[op]];
OutputByte[area, CardToByte[lit]];
};
LRBcommon:
PUBLIC
PROC [op: Inst, reg: RegSpec, lit: Lit8] = {
area: Area = GetCurrentArea[];
WITH r: reg
SELECT
FROM
reg => {op ← LOOPHOLE[LOOPHOLE[op, CARDINAL] + r.reg]};
ENDCASE => ERROR IllegalSrc;
OutputByte[area, InstToByte[op]];
OutputByte[area, CardToByte[lit]];
};
RRcommon:
PUBLIC
PROC [op: Inst, c: RegSpec, a,b: RegSpec] = {
check for aux and reg mix
useAux: BOOL ← FALSE;
useReg: BOOL ← FALSE;
form: RRformat ← LOOPHOLE[ZerosWord];
WITH c: c
SELECT
FROM
reg => {useReg ← TRUE; form.c ← c.reg};
aux => {useAux ← TRUE; form.c ← c.aux};
dstStack => {form.c ← c.stack; form.cOpt ← TRUE};
const => {form.c ← c.const; form.cOpt ← TRUE};
srcStack => ERROR IllegalDst;
ENDCASE;
WITH a: a
SELECT
FROM
reg => {useReg ← TRUE; form.a ← a.reg};
aux => {useAux ← TRUE; form.a ← a.aux};
dstStack => ERROR IllegalSrc;
const => {form.a ← a.const; form.aOpt ← TRUE};
srcStack => {form.a ← a.stack; form.aOpt ← TRUE};
ENDCASE;
WITH b: b
SELECT
FROM
reg => {useReg ← TRUE; form.b ← b.reg};
aux => {useAux ← TRUE; form.b ← b.aux};
dstStack => ERROR IllegalSrc;
const => {form.b ← b.const; form.bOpt ← TRUE};
srcStack => {form.b ← b.stack; form.bOpt ← TRUE};
ENDCASE;
IF useAux
THEN {
IF useReg THEN ERROR IllegalMix;
form.aux ← TRUE;
};
form.op ← op;
OutputBytes[GetCurrentArea[], LOOPHOLE[form], 0, 3];
};
RJBcommon:
PUBLIC
PROC [op: Inst, left: ShortRegSpec, right: RegSpec, dist: JDist8] = {
form: RJBformat ← LOOPHOLE[ZerosWord];
form.aOp ← VAL[ORD[left]];
WITH r: right
SELECT
FROM
reg => {form.reg ← r.reg};
aux => {form.aux ← TRUE; form.reg ← r.aux};
dstStack => ERROR IllegalSrc;
const => {form.reg ← r.const; form.opt ← TRUE};
srcStack => {form.reg ← r.stack; form.opt ← TRUE};
ENDCASE;
form.op ← op;
form.dist ← dist;
OutputBytes[GetCurrentArea[], LOOPHOLE[form], 0, 3];
};
ODBcommon:
PUBLIC
PROC [op: Inst, lit: Lit16] = {
area: Area = GetCurrentArea[];
OutputByte[area, InstToByte[op]];
OutputAlphaBeta[area, lit];
};
LRRBcommon:
PUBLIC
PROC [op: Inst, reg1,reg2: RegSpec, disp: Lit8] = {
area: Area = GetCurrentArea[];
form: LRRBformat ← LOOPHOLE[ZerosWord];
form.op ← op;
form.disp ← disp;
WITH r: reg1
SELECT
FROM
reg => {form.reg1 ← r.reg};
aux => {form.reg1 ← r.aux};
ENDCASE => ERROR IllegalSrc;
WITH r: reg2
SELECT
FROM
reg => {form.reg2 ← r.reg};
aux => {form.reg2 ← r.aux};
ENDCASE => ERROR IllegalSrc;
OutputBytes[GetCurrentArea[], LOOPHOLE[form], 0, 3];
};
JBBcommon:
PUBLIC
PROC [op: Inst, dist: JDist8, lit: Lit8] = {
form: JBBformat ← LOOPHOLE[ZerosWord];
form.op ← op;
form.dist ← dist;
form.lit ← lit;
OutputBytes[GetCurrentArea[], LOOPHOLE[form], 0, 3];
};
Directives to control code output (not yet really implemented)
GetOutputPC:
PUBLIC
PROC [area: Area ←
NIL]
RETURNS [
CARD] = {
gets the current output PC
IF area = NIL THEN area ← GetCurrentArea[];
RETURN [area.currentPC];
};
SetOutputPC:
PUBLIC
PROC [pc:
CARD, area: Area ←
NIL] = {
sets the current output PC
addr: CARD;
index: [0..bytesPerWord);
IF area = NIL THEN area ← GetCurrentArea[];
[addr, index] ← ConvertCurrentPC[area];
IF area.currentDirty
THEN {
Only force out the word if it is "dirty"
area.putWord[area.data, addr, area.currentWord];
area.currentDirty ← FALSE;
};
area.currentPC ← pc;
[addr, index] ← ConvertCurrentPC[area];
};
WordAlign:
PUBLIC
PROC [area: Area ←
NIL] = {
make the code generation PC word-aligned, padding with noops
addr: CARD;
index: [0..bytesPerWord);
IF area = NIL THEN area ← GetCurrentArea[];
[addr, index] ← ConvertCurrentPC[area];
SELECT index
FROM
1 => {HandCoding.drJ3[]; HandCoding.drJ1[]; HandCoding.drJ1[]};
2 => {HandCoding.drJ2[]; HandCoding.drJ1[]};
3 => HandCoding.drJ1[];
ENDCASE => {};
};
ReserveData:
PUBLIC
PROC [words:
CARD, area: Area ←
NIL]
RETURNS [pc:
CARD] = {
reserve some # of words of data
old: CARD;
IF area = NIL THEN area ← GetCurrentArea[];
old ← area.currentPC;
SetOutputPC[area.currentData, area];
WordAlign[area];
pc ← area.currentPC;
area.currentData ← area.currentData + words*bytesPerWord;
OutputWord[area, ZerosWord, FALSE];
WHILE words > wordsPerPage
DO
SetOutputPC[pc+(words-1)*bytesPerWord, area];
OutputWord[area, ZerosWord, FALSE];
words ← words - wordsPerPage;
ENDLOOP;
SetOutputPC[old, area];
};
OutputByte:
PUBLIC
PROC [area: Area, byte: Byte] = {
output the given byte into the current output area
addr: CARD;
index: [0..bytesPerWord);
IF area = NIL THEN area ← GetCurrentArea[];
[addr, index] ← ConvertCurrentPC[area];
IF
NOT area.currentDirty
THEN {
area.currentWord ← area.getWord[area.data, addr];
area.currentDirty ← TRUE;
};
LOOPHOLE[area.currentWord, FourBytes][index] ← byte;
area.currentPC ← area.currentPC + 1;
IF index = bytesPerWord-1
THEN {
area.putWord[area.data, addr, area.currentWord];
area.currentDirty ← FALSE;
};
};
OutputOneByte:
PUBLIC
PROC [area: Area, word: Word] = {
output the low-order byte of the word into the current output area
OutputByte[area, WordToBytes[word][3]];
};
OutputAlphaBeta:
PUBLIC
PROC [area: Area, lit: Lit16] = {
output the literal as necessary for the ODB format of the word into the current output area {RRA: the byte order changed on September 13, 1985}
IF area = NIL THEN area ← GetCurrentArea[];
OutputByte[area, LOOPHOLE[lit / 256]];
OutputByte[area, LOOPHOLE[lit MOD 256]];
};
OutputAlphaBetaGammaDelta:
PUBLIC
PROC [area: Area, word: Word] = {
output the given literal as AlphaBetaGammaDelta (Alpha is the high-order byte, Beta the next highest, and so on) {RRA: the byte order changed on September 13, 1985}
IF area = NIL THEN area ← GetCurrentArea[];
OutputByte[area, WordToBytes[word][0]];
OutputByte[area, WordToBytes[word][1]];
OutputByte[area, WordToBytes[word][2]];
OutputByte[area, WordToBytes[word][3]];
};
OutputWord:
PUBLIC
PROC [area: Area, word: Word, align:
BOOL ←
FALSE] = {
output the given word into the current output area, aligning if requested
addr: CARD;
index: [0..bytesPerWord);
IF area = NIL THEN area ← GetCurrentArea[];
[addr, index] ← ConvertCurrentPC[area];
IF area.currentDirty
THEN {
area.putWord[area.data, addr, area.currentWord];
area.currentDirty ← FALSE;
};
SELECT
TRUE
FROM
index = 0 => {
area.putWord[area.data, addr, word];
area.currentPC ← area.currentPC + 4;
};
align => {
area.putWord[area.data, addr+1, word];
area.currentPC ← area.currentPC + (bytesPerWord - index) + 4
};
ENDCASE =>
OutputBytes[area, WordToBytes[word], 0, 4];
};
Helper procedures that take Area as an argument and assume that it is not NIL.
OutputBytes:
PROC [area: Area, bytes: FourBytes, start:
NAT, len:
NAT] = {
output the specified bytes
addr: CARD;
index: NAT;
[addr, index] ← ConvertCurrentPC[area];
THROUGH [0..len)
DO
IF
NOT area.currentDirty
THEN {
area.currentWord ← area.getWord[area.data, addr];
area.currentDirty ← TRUE;
};
LOOPHOLE[area.currentWord, FourBytes][index] ← bytes[start];
start ← start + 1;
index ← index + 1;
IF index = bytesPerWord
THEN {
area.putWord[area.data, addr, area.currentWord];
area.currentDirty ← FALSE;
addr ← addr + 1;
index ← 0;
};
ENDLOOP;
area.currentPC ← area.currentPC + len;
};
ConvertCurrentPC:
PROC [area: Area]
RETURNS [addr:
CARD, index:
NAT] =
INLINE {
returns word and byte index for the current PC
word: Word ← DragOpsCrossUtils.CardToWord[area.currentPC];
[word, index] ← DragOpsCrossUtils.BytePCToWordAddress[[word]];
addr ← DragOpsCrossUtils.WordToCard[word];
};