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;
initData: CARD = XopBase*bytesPerWord*2;


DummyGet: GetProc = {RETURN [ZerosWord]};
DummyPut: PutProc = {};


NewArea: PUBLIC PROC [name: ATOM, getWord: GetProc, putWord: PutProc, data: REF _ NIL] RETURNS [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] = {
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] = {
inner: PROC = {
proc[];
ForceOut[area];
};
IF area = NIL THEN area _ GetCurrentArea[];
ProcessProps.AddPropList[
Atom.PutPropOnList[NIL, $CurrentArea, area],
inner];
};
ForceOut: PUBLIC PROC [area: Area] = {
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] = {
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;
};


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] = {
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];
};


GetOutputPC: PUBLIC PROC [area: Area _ NIL] RETURNS [CARD] = {
IF area = NIL THEN area _ GetCurrentArea[];
RETURN [area.currentPC];
};

SetOutputPC: PUBLIC PROC [pc: CARD, area: Area _ NIL] = {
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;
};
area.currentPC _ pc;
[addr, index] _ ConvertCurrentPC[area];
};

WordAlign: PUBLIC PROC [area: Area _ NIL] = {
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] = {
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] = {
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] = {
OutputByte[area, WordToBytes[word][3]];
};
OutputAlphaBeta: PUBLIC PROC [area: Area, lit: Lit16] = {
IF area = NIL THEN area _ GetCurrentArea[];
OutputByte[area, LOOPHOLE[lit / 256]];
OutputByte[area, LOOPHOLE[lit MOD 256]];
};
OutputAlphaBetaGammaDelta: PUBLIC PROC [area: Area, word: Word] = {
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] = {
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];
};


OutputBytes: PROC [area: Area, bytes: FourBytes, start: NAT, len: NAT] = {
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 {
word: Word _ DragOpsCrossUtils.CardToWord[area.currentPC];
[word, index] _ DragOpsCrossUtils.BytePCToWordAddress[[word]];
addr _ DragOpsCrossUtils.WordToCard[word];
};


END.


hHandCodingSupportImpl.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) February 5, 1986 4:01:29 pm PST
initial code loc starts somewhat after the last trap location (we leave room for 64 traps, although only 32 are currently defined)
well out of the range of the traps or the initial code
Dummies for put and get
Output area stuff
Creates a new code area.
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).

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

Forces the area to dump any buffering it has into the output.

Gets the current output area as established by GenWithArea.
Format Common Routines
check for aux and reg mix
Directives to control code output (not yet really implemented)
gets the current output PC
sets the current output PC
Only force out the word if it is "dirty"
make the code generation PC word-aligned, padding with noops
reserve some # of words of data
output the given byte into the current output area

output the low-order byte of the word into the current output area

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}

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}

output the given word into the current output area, aligning if requested
Helper procedures that take Area as an argument and assume that it is not NIL.
output the specified bytes
returns word and byte index for the current PC
Κ$˜
codeš
œ™Kšœ
Οm
œ7™BK™3K˜—š
Οk	˜	Kšœžœ˜%Kšœ
žœ³
˜Ε
KšœžœT˜kKšœžœ\˜lKšœžœ-˜DKšœ
žœ˜.K˜—šœžœ
ž˜$Kšžœ2˜9Kšžœ˜Kšœžœ
žœ@˜LK˜Kšžœžœžœ
žœ
˜K˜šœ
žœ+˜9K™‚
—šœ
žœ˜(Kš
œ6™6—K˜—™K˜Kšœžœ˜)Kš
œ˜K˜—™K˜–24 sp tabStopsšΟnœžœžœ,žœžœ
žœ˜iK–24 sp tabStopsš
œ™–24 sp tabStopsšžœžœ˜K–24 sp tabStopsšœžœ
˜K–24 sp tabStopsš
œ+˜+K–24 sp tabStopsšœ&žœ
˜,K–24 sp tabStopsš
œ2˜2—K–24 sp tabStopsš
œ˜K–24 sp tabStops˜—šŸœžœ!˜9Kš
œΙ
™Ι
šœžœ˜šžœ"žœžœ
ž˜8K˜
Kšžœ˜
——Kš
œ˜Kš
œ˜K™—šŸœžœžœ˜6Kš
œΛ
™Λ
šœžœ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kšžœžœ
žœ˜+š
œ˜Kšœžœ˜,Kš
œ˜—Kš
œ˜K™—šŸœžœ˜&Kš
œ=™=Kšœžœ
˜
Kš
œ˜Kšžœžœ
žœ˜+Kš
œ'˜'šžœžœ˜Kš
œ0˜0Kšœžœ
˜K˜—Kš
œ˜K™—Kšœžœžœ
˜šŸœžœ	žœžœžœžœ˜PKš
œ;™;šžœ=žœžœ
ž˜SKšžœžœ	žœžœ˜LKšžœ
˜—Kšžœ
žœžœžœ
žœ
žœ˜1Kš
œ˜—K˜—š
œ™K˜šŸ
œžœžœ
žœžœžœ	˜PK˜—šŸ	œžœ
žœ˜1Kš
œ˜Kš
œ!˜!Kš
œ&˜&Kš
œ˜K˜—šŸœžœ
žœ˜$Kš
œ-˜-Kš
œ˜K˜—šŸœžœ
žœ˜2šžœžœ
ž˜Kšœ
žœ
žœžœ˜7Kšžœžœ˜—Kš
œ-˜-Kš
œ˜K˜—šŸœžœ
žœ>˜SKšœžœ˜Kšœžœ
žœ˜šžœ
žœ
ž˜Kšœžœ˜Kš
œ˜Kšœ%žœ˜+Kšœ)žœ˜/Kšœ,žœ˜2Kšžœžœ˜—K˜
Kšœ"žœžœ˜<Kš
œ˜K˜—šŸœžœ
žœ˜/Kš
œ˜Kš
œ!˜!Kš
œ"˜"Kš
œ˜K˜—šŸ	œžœ
žœ'˜>Kš
œ˜šžœžœ
ž˜Kšœ
žœ
žœžœ˜7Kšžœžœ˜—Kš
œ!˜!Kš
œ"˜"Kš
œ˜K˜—šŸœžœ
žœ(˜>Kš
œ™Kšœžœžœ
˜Kšœžœžœ
˜Kšœžœ˜%šžœžœ
ž˜Kšœžœ˜'Kšœžœ˜'Kšœ+žœ˜1Kšœ(žœ˜.Kšœžœ˜Kšžœ
˜—šžœžœ
ž˜Kšœžœ˜'Kšœžœ˜'Kšœžœ˜Kšœ(žœ˜.Kšœ+žœ˜1Kšžœ
˜—šžœžœ
ž˜Kšœžœ˜'Kšœžœ˜'Kšœžœ˜Kšœ(žœ˜.Kšœ+žœ˜1Kšžœ
˜—šžœžœ˜Kšžœžœ
žœ˜ Kšœžœ
˜K˜—K˜
Kšœžœ˜4Kš
œ˜K˜—šŸ	œžœ
žœA˜WKšœžœ˜&Kšœžœ
žœ˜šžœ
žœ
ž˜Kš
œ˜Kšœžœ˜+Kšœžœ˜Kšœ)žœ˜/Kšœ,žœ˜2Kšžœ
˜—K˜
K˜Kšœž
œ˜4Kš
œ˜K˜—šŸ	œžœ
žœ˜1Kš
œ˜Kš
œ!˜!Kš
œ˜K˜K˜—šŸ
œžœ
žœ.˜FKš
œ˜Kšœžœ˜'K˜
Kš
œ˜šžœ	žœ
ž˜Kš
œ˜Kš
œ˜Kšžœžœ˜—šžœ	žœ
ž˜Kš
œ˜Kš
œ˜Kšžœžœ˜—Kšœžœ˜4Kš
œ˜K˜—šŸ	œžœ
žœ(˜>Kšœžœ˜&K˜
K˜K˜Kšœžœ˜4K˜K˜——š
œ>™>K˜šŸœžœ
žœžœžœžœ˜>K™Kšžœžœ
žœ˜+Kšžœ˜Kš
œ˜K˜—š
Ÿœžœ
žœžœžœ˜9K™Kšœžœ
˜Kš
œ˜Kšžœžœ
žœ˜+Kš
œ'˜'šžœžœ˜Kš
œ(™(Kš
œ0˜0Kšœžœ
˜K˜—Kš
œ˜Kš
œ'˜'Kš
œ˜K˜—šŸ	œžœ
žœžœ˜-K™<Kšœžœ
˜Kš
œ˜Kšžœžœ
žœ˜+Kš
œ'˜'šžœž˜K˜?K˜,K˜Kšžœ˜—Kš
œ˜K˜—šŸœžœ
žœ	žœžœžœžœ˜OK™Kšœžœ
˜
Kšžœžœ
žœ˜+Kš
œ˜Kš
œ$˜$Kš
œ˜Kš
œ˜Kš
œ9˜9Kšœžœ˜#šžœž˜Kš
œ-˜-Kšœžœ˜#K˜Kšžœ
˜—Kš
œ˜Kš
œ˜K˜—šŸ
œžœ
žœ˜4K™2Kšœžœ
˜Kš
œ˜Kšžœžœ
žœ˜+Kš
œ'˜'šžœ
žœžœ˜Kš
œ1˜1Kšœžœ
˜Kš
œ˜—Kšžœ,˜4Kš
œ$˜$šžœžœ˜ Kš
œ0˜0Kšœžœ
˜Kš
œ˜—Kš
œ˜K™—šŸ
œžœ
žœ˜7Kš
œB™BKš
œ'˜'Kš
œ˜K™—šŸœžœ
žœ˜9Kš
œ
™
Kšžœžœ
žœ˜+Kšœžœ
˜&Kšœžœžœ˜(Kš
œ˜K™—šŸœžœ
žœ˜CKš
œ₯
™₯
Kšžœžœ
žœ˜+Kš
œ'˜'Kš
œ'˜'Kš
œ'˜'Kš
œ'˜'Kš
œ˜K™—š
Ÿ
œžœ
žœ!žœžœ˜IKš
œI™IKšœžœ
˜Kš
œ˜Kšžœžœ
žœ˜+Kš
œ'˜'šžœžœ˜Kš
œ0˜0Kšœžœ
˜K˜—šžœ
žœ
ž˜˜Kš
œ$˜$Kš
œ$˜$K˜—˜
Kš
œ&˜&Kš
œ<˜<Kš
œ˜—šžœ˜
Kš
œ+˜+——Kš
œ˜K˜——šœJžœ
™NK˜šŸœžœ'žœžœ˜JK™Kšœžœ
˜Kšœžœ
˜Kš
œ'˜'šžœ
ž˜šžœ
žœžœ˜Kš
œ1˜1Kšœžœ
˜Kš
œ˜—Kšžœ4˜<K˜K˜šžœžœ˜Kš
œ0˜0Kšœžœ
˜K˜K˜
K˜—Kšžœ
˜—Kš
œ&˜&Kš
œ˜K˜—šŸœžœžœžœ	žœžœ˜OK™.Kš
œ:˜:Kš
œ>˜>Kš
œ*˜*Kš
œ˜K˜—K˜—Kšžœ
˜K˜K˜—…—&J;Φ