HandCodingSupportImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) September 10, 1986 11:26:24 pm PDT
McCreight October 27, 1986 4:09:48 pm PST
DIRECTORY
Atom USING [PropList, PutPropOnList],
Convert USING [CardFromDecimalLiteral, CardFromHexLiteral, CardFromOctalLiteral, RealFromLiteral],
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, IntToWord, WordAddressToBytePC, WordToBytes, WordToCard],
HandCoding USING [drJ1, drJ2, drJ3, IllegalDst, IllegalMix, IllegalSrc, Lit16, Lit8, RegSpec, ShortRegSpec],
HandCodingPseudos USING [GenLabelHere, GetGlobalLabel, Label, MakeLabelGlobal],
HandCodingSupport USING [Area, AreaRep, GetProc, ProcList, PutProc],
IO USING [GetCedarToken, GetIndex, PutF, STREAM, TokenKind],
ProcessProps USING [AddPropList, GetPropList],
RefText USING [TrustTextAsRope],
Rope USING [Cat, FromRefText, ROPE];
HandCodingSupportImpl: CEDAR PROGRAM
IMPORTS Atom, Convert, DragOpsCrossUtils, HandCoding, HandCodingPseudos, IO, ProcessProps, RefText, Rope
EXPORTS HandCodingSupport
= BEGIN OPEN DragOpsCross, DragOpsCrossUtils, HandCoding, HandCodingSupport;
CARD: TYPE = LONG CARDINAL;
ROPE: TYPE = Rope.ROPE;
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
Dummies for put and get
DummyGet: GetProc = {RETURN [ZerosWord]};
DummyPut: PutProc = {};
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;
};
LoadArea: PUBLIC PROC [st, errs: IO.STREAM, area: Area ← NIL] = {
buffer: REF TEXT ← NEW[TEXT[64]];
kind: IO.TokenKind ← tokenEOF;
pBuffer: REF TEXT ← NEW[TEXT[64]];
pKind: IO.TokenKind ← tokenEOF;
Next: PROC = {
IF pKind = tokenEOF
THEN {
buffer.length ← 0;
[tokenKind: kind, token: buffer] ← IO.GetCedarToken[st, buffer]}
ELSE {
temp: REF TEXT ← buffer;
buffer ← pBuffer;
pBuffer ← temp;
kind ← pKind;
pKind ← tokenEOF};
};
Peek: PROC RETURNS [c: CHAR ← 0C]= {
IF pKind = tokenEOF THEN {
pBuffer.length ← 0;
[tokenKind: pKind, token: pBuffer] ← IO.GetCedarToken[st, pBuffer];
};
IF pBuffer.length = 1 THEN c ← pBuffer[0];
};
inner: PROC = {
DO
name: ROPE ← NIL;
word: Word ← DragOpsCross.ZerosWord;
undefined: BOOL ← FALSE;
Next[];
SELECT kind FROM
tokenID => {
label: HandCodingPseudos.Label ← NIL;
name ← Rope.FromRefText[buffer];
WHILE Peek[] = '. DO
This is a complex name
Next[]; Next[];
IF kind # tokenID THEN GO TO syntaxError;
name ← Rope.Cat[name, ".", Rope.FromRefText[buffer]];
ENDLOOP;
label ← HandCodingPseudos.GetGlobalLabel[name];
IF label = NIL
THEN {
undefined ← TRUE;
}
ELSE {
word ← DragOpsCrossUtils.IntToWord[label.offset];
};
};
tokenDECIMAL => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromDecimalLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenOCTAL => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromOctalLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenHEX => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromHexLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenREAL => {
This is a hack for REAL literals. We hope that the bits put out by Cedar are the right bits for the REAL literals (they should be, but floating point is rather hard to get exactly right).
word ← DragOpsCrossUtils.CardToWord[
LOOPHOLE[Convert.RealFromLiteral[RefText.TrustTextAsRope[buffer]]]];
};
tokenEOF => EXIT;
ENDCASE => GO TO syntaxError;
IF Peek[] = '= THEN {
The preceeding name was a definition
Next[];
definition ← name;
LOOP;
};
IF definition # NIL THEN {
Create a label, and make its definition global
card: CARD = GetOutputPC[area];
IF undefined THEN {
At this point we put out a message about undefined crap. The new label is also not defined!
IO.PutF[errs, "Warning: '%g' is undefined.\n", [rope[name]]];
LOOP;
};
SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
HandCodingPseudos.MakeLabelGlobal[definition, HandCodingPseudos.GenLabelHere[]];
SetOutputPC[card, area];
definition ← NIL;
LOOP;
};
SELECT Peek[] FROM
': => {
The preceeding word was a word address
word ← DragOpsCrossUtils.WordAddressToBytePC[word];
SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
Next[];
wordMode ← TRUE;
};
'/ => {
The preceeding word was a byte address
SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
Next[];
wordMode ← FALSE;
};
ENDCASE => {
The preceeding word was a byte or word datum. If the item is larger than a byte, output a word anyway (helpful for addresses).
IF wordMode OR DragOpsCrossUtils.WordToCard[word] > 255
THEN OutputWord[area, word]
ELSE OutputByte[area, DragOpsCrossUtils.WordToBytes[word][3]]
};
IF undefined THEN {
At this point we put out a message about undefined crap.
IO.PutF[errs, "Warning: '%g' is undefined.\n", [rope[name]]];
};
ENDLOOP;
EXITS syntaxError => {
IO.PutF[errs, "Error: bad syntax near %g, aborting the read.\n",
[integer[IO.GetIndex[st]]]];
};
};
definition: ROPE ← NIL;
wordMode: BOOL ← TRUE;
IF area = NIL THEN area ← GetCurrentArea[];
ProcessProps.AddPropList[
Atom.PutPropOnList[NIL, $CurrentArea, area],
inner];
};
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];
};
END.