

<<FILE:  RandomCodeDragonOpsImpl.mesa>>
<<Last Edited by: Sturgis, January 20, 1986 3:40:56 pm PST>>
<<McCreight, December 13, 1985 2:22:31 pm PST>>


DIRECTORY
Basics USING[HighByte, LowByte],
DragOpsCross,
IO USING[card, int, PutF, rope, STREAM],
RandomCodeTypes USING[ArgSeqTypeCheck, GetArgsResultsOfProcedureType, GetLength, GetOrdinaryWordType, GetSeqTypeOfPointerType, 
GetWordTypeFromOffset, ResultSeqTypeCheck, SeqType, WordStorableAs, WordType],
RandomCodeTypedProgramGraphs USING[BasicNodeTypeCheck, CheckRelativeJump, GetFrameVarType, GetNextFrameVarType, GetNextOfNextStack, 
GetNextOfStack, GetNextStack, GetStack, GetTopOfNextStack, GetTopOfStack, GetTypeSet, OpDescriptor, OpDescriptorBody, OpKind, 
OpKindBody, OpTypeClass, PGNode, TooFar, TypeCheckEPNode, TypeCheckRETNode],
RandomCodeDragonOps USING[],
Rope USING[ROPE];

RandomCodeDragonOpsImpl: CEDAR PROGRAM IMPORTS Basics, IO, RandomCodeTypes, RandomCodeTypedProgramGraphs EXPORTS 
RandomCodeDragonOps =

BEGIN
OPEN RandomCodeTypes, RandomCodeTypedProgramGraphs;

<<Comment: May 2, 1984 4:45:38 pm PDT: At the moment we have no way of requesting PopWPushW or PopWWPushW, so I have not 
implemented them (using RR), but when I construct a way to request them, I will generate them.  (reduce a dummy node will have to 
find these as a special case before doing a source or target reduction directly?)>>

DragonOpTable: ARRAY OpTypeClass OF REF DragonOpTableBody;
DragonOpTableBody: TYPE = RECORD[
SEQUENCE nOps: CARDINAL OF GetOpProc];
GetOpProc: TYPE = PROCEDURE[
class: OpTypeClass,
random: PROCEDURE RETURNS[CARDINAL],
selectLocalIndex: PROCEDURE RETURNS[CARDINAL],
selectRemoteIndex: PROCEDURE RETURNS[CARDINAL],
selectLocalRemoteIndices: PROCEDURE RETURNS[l,r: CARDINAL]]
RETURNS[OpDescriptor];
dragonOpPrelimTable: ARRAY OpTypeClass OF REF DragonOpPrelimTableBody;
DragonOpPrelimTableBody: TYPE = RECORD[
nOps: CARDINAL _ 0,
first: REF PrelimTableEntryBody];
PrelimTableEntryBody: TYPE = RECORD[
getProc: GetOpProc,
next: REF PrelimTableEntryBody];

RefODBOpKindDataBody: TYPE = REF ODBOpKindDataBody;


InitDragonOpTables: PROCEDURE =
BEGIN
FOR class: OpTypeClass IN OpTypeClass DO
dragonOpPrelimTable[class] _ NEW[DragonOpPrelimTableBody];
ENDLOOP;
END;

RegisterDragonOpBuilder: PROCEDURE[
class: OpTypeClass,
getProc: PROCEDURE[
class: OpTypeClass,
random: PROCEDURE RETURNS[CARDINAL],
selectLocalIndex: PROCEDURE RETURNS[CARDINAL],
selectRemoteIndex: PROCEDURE RETURNS[CARDINAL],
selectLocalRemoteIndices: PROCEDURE RETURNS[l,r: CARDINAL]]
RETURNS[OpDescriptor]] =

BEGIN
cell: REF PrelimTableEntryBody _
NEW[PrelimTableEntryBody _ [getProc, dragonOpPrelimTable[class].first]];
dragonOpPrelimTable[class].nOps _ dragonOpPrelimTable[class].nOps + 1;
dragonOpPrelimTable[class].first _ cell;
END;

CloseDragonOpTables: PROCEDURE =
BEGIN
FOR class: OpTypeClass IN OpTypeClass DO
body: REF DragonOpTableBody _
NEW[DragonOpTableBody[dragonOpPrelimTable[class].nOps]];
item: REF PrelimTableEntryBody _ dragonOpPrelimTable[class].first;
FOR I: CARDINAL IN [0..body.nOps) DO
body[I] _ item.getProc;
item _ item.next;
ENDLOOP;
DragonOpTable[class] _ body;
ENDLOOP;
END;

GetDragonOp: PUBLIC PROCEDURE[
class: OpTypeClass,
random: PROCEDURE RETURNS[CARDINAL],
selectLocalIndex: PROCEDURE RETURNS[CARDINAL],
selectRemoteIndex: PROCEDURE RETURNS[CARDINAL],
selectLocalRemoteIndices: PROCEDURE RETURNS[l,r: CARDINAL]]
RETURNS[OpDescriptor] =
BEGIN
body: REF DragonOpTableBody _ DragonOpTable[class];
IF body.nOps = 0 THEN RETURN[NIL];
RETURN[body[random[] MOD body.nOps][class, random, selectLocalIndex, selectRemoteIndex, selectLocalRemoteIndices]];
END;


<<assorted dragon op classes, this concept of class is unrelated to OpTypeClass, but is organized according to the Dragon ops 
document.>>

NoteNullOpInstallation: PROCEDURE[OpDescriptor, PGNode] = {NULL};
NullOpInstallationRelease: PROCEDURE[OpDescriptor, PGNode] = {NULL};
NullOpGetDummyOpShape: PROCEDURE[OpDescriptor] RETURNS[nArgs, nResults: CARDINAL] = {ERROR};
NullSetRelativeJump: PROCEDURE[OpDescriptor, INT];

<<following is tentative>>
OpName: TYPE = {JEBB, JEBBJ, JNEBB, JNEBBJ, RADD, RAND, RFU, ROR, RRX, RSUB, RUADD, RUSUB, RVADD, RVSUB, RXOR, EP, RET, JB, JDB, 
SFC, LRI0, LRI1, LRI2, LRI3, LRI4, LRI5, LRI6, LRI7, LRI8, LRI9, LRI10, LRI11, LRI12, LRI13, LRI14, LRI15, SRI0,  SRI1, SRI2, SRI3, 
SRI4, SRI5, SRI6, SRI7, SRI8, SRI9, SRI10, SRI11, SRI12, SRI13, SRI14, SRI15, StopTrap};

RopeFromOpName: PROCEDURE[name: OpName] RETURNS[Rope.ROPE] =
BEGIN
RETURN[SELECT name FROM
JEBB => "JEBB",
JEBBJ => "JEBBJ",
JNEBB => "JNEBB",
JNEBBJ => "JNEBBJ",
RADD => "RADD",
RAND => "RAND",
RFU => "RFU",
ROR => "ROR",
RRX => "RRX",
RSUB => "RSUB",
RUADD => "RUADD",
RUSUB => "RUSUB",
RVADD => "RVADD",
RVSUB => "RVSUB",
RXOR => "RXOR",
EP => "EP",
RET => "RET",
JB => "JB",
JDB => "JDB",
SFC => "SFC",
LRI0 => "LRI0",
LRI1 => "LRI1",
LRI2 => "LRI2",
LRI3 => "LRI3",
LRI4 => "LRI4",
LRI5 => "LRI5",
LRI6 => "LRI6",
LRI7 => "LRI7",
LRI8 => "LRI8",
LRI9 => "LRI9",
LRI10 => "LRI10",
LRI11 => "LRI11",
LRI12 => "LRI12",
LRI13 => "LRI13",
LRI14 => "LRI14",
LRI15 => "LRI15",
SRI0 => "SRI0",
SRI1 => "SRI1",
SRI2 => "SRI2",
SRI3 => "SRI3",
SRI4 => "SRI4",
SRI5 => "SRI5",
SRI6 => "SRI6",
SRI7 => "SRI7",
SRI8 => "SRI8",
SRI9 => "SRI9",
SRI10 => "SRI10",
SRI11 => "SRI11",
SRI12 => "SRI12",
SRI13 => "SRI13",
SRI14 => "SRI14",
SRI15 => "SRI15",
StopTrap => "StopTrap",
ENDCASE => ERROR]
END;

ByteCodeFromOpName: PROCEDURE[name: OpName] RETURNS[[0..255]] =
BEGIN
RETURN[SELECT name FROM
JEBB => DragOpsCross.Inst[dJEBB].ORD,
JEBBJ => DragOpsCross.Inst[dJEBBJ].ORD,
JNEBB => DragOpsCross.Inst[dJNEBB].ORD,
JNEBBJ => DragOpsCross.Inst[dJNEBBJ].ORD,
RADD => DragOpsCross.Inst[dRADD].ORD,
RAND => DragOpsCross.Inst[dRAND].ORD,
RFU => DragOpsCross.Inst[dRFU].ORD,
ROR => DragOpsCross.Inst[dROR].ORD,
RRX => DragOpsCross.Inst[dRRX].ORD,
RSUB => DragOpsCross.Inst[dRSUB].ORD,
RUADD => DragOpsCross.Inst[dRUADD].ORD,
RUSUB => DragOpsCross.Inst[dRUSUB].ORD,
RVADD => DragOpsCross.Inst[dRVADD].ORD,
RVSUB => DragOpsCross.Inst[dRVSUB].ORD,
RXOR => DragOpsCross.Inst[dRXOR].ORD,
EP => DragOpsCross.Inst[dALS].ORD,
RET => DragOpsCross.Inst[dRET].ORD,
JB => DragOpsCross.Inst[dJB].ORD,
JDB => DragOpsCross.Inst[dJDB].ORD,
SFC => DragOpsCross.Inst[dSFC].ORD,
LRI0 => DragOpsCross.Inst[dLRI0].ORD,
LRI1 => DragOpsCross.Inst[dLRI1].ORD,
LRI2 => DragOpsCross.Inst[dLRI2].ORD,
LRI3 => DragOpsCross.Inst[dLRI3].ORD,
LRI4 => DragOpsCross.Inst[dLRI4].ORD,
LRI5 => DragOpsCross.Inst[dLRI5].ORD,
LRI6 => DragOpsCross.Inst[dLRI6].ORD,
LRI7 => DragOpsCross.Inst[dLRI7].ORD,
LRI8 => DragOpsCross.Inst[dLRI8].ORD,
LRI9 => DragOpsCross.Inst[dLRI9].ORD,
LRI10 => DragOpsCross.Inst[dLRI10].ORD,
LRI11 => DragOpsCross.Inst[dLRI11].ORD,
LRI12 => DragOpsCross.Inst[dLRI12].ORD,
LRI13 => DragOpsCross.Inst[dLRI13].ORD,
LRI14 => DragOpsCross.Inst[dLRI14].ORD,
LRI15 => DragOpsCross.Inst[dLRI15].ORD,
SRI0 => DragOpsCross.Inst[dSRI0].ORD,
SRI1 => DragOpsCross.Inst[dSRI1].ORD,
SRI2 => DragOpsCross.Inst[dSRI2].ORD,
SRI3 => DragOpsCross.Inst[dSRI3].ORD,
SRI4 => DragOpsCross.Inst[dSRI4].ORD,
SRI5 => DragOpsCross.Inst[dSRI5].ORD,
SRI6 => DragOpsCross.Inst[dSRI6].ORD,
SRI7 => DragOpsCross.Inst[dSRI7].ORD,
SRI8 => DragOpsCross.Inst[dSRI8].ORD,
SRI9 => DragOpsCross.Inst[dSRI9].ORD,
SRI10 => DragOpsCross.Inst[dSRI10].ORD,
SRI11 => DragOpsCross.Inst[dSRI11].ORD,
SRI12 => DragOpsCross.Inst[dSRI12].ORD,
SRI13 => DragOpsCross.Inst[dSRI13].ORD,
SRI14 => DragOpsCross.Inst[dSRI14].ORD,
SRI15 => DragOpsCross.Inst[dSRI15].ORD,
StopTrap => DragOpsCross.Inst[x377b].ORD,
ENDCASE => ERROR]
END;


<<RR ops>>

RROpKind: OpKind _ NEW[OpKindBody _ [
"RROp",
CopyRROp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetRROpSize,
NullSetRelativeJump,
TypeCheckRROp,
PrintRROpDetails,
GenRROpBytes]];

RROpKindDataBody: TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE,
c,a: [0..15],
aOpt, cOpt, bOpt, aux: BOOLEAN,
b: [0..15]];

RROps: ARRAY [0..11) OF OpName = [RADD, RAND, RFU, ROR, RRX, RSUB, RUADD, RUSUB, RVADD, RVSUB, RXOR];

CopyRROp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF RROpKindDataBody _ NARROW[op.data];
outData: REF RROpKindDataBody _ NEW[RROpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [RROpKind,  outData]]];
END;

GetRROpForPopWW: GetOpProc =    
BEGIN
local: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
data: REF RROpKindDataBody;
r1, r2: CARDINAL;
data _ NEW[RROpKindDataBody _ [
op: RROps[random[] MOD 11],
purpose: "PopWW",
c: 0,
a: 0,
aOpt: TRUE, cOpt: FALSE, bOpt: TRUE, aux: FALSE,
b: 0]];
SELECT r1 _ (random[] MOD 2) FROM
0 => {data.a _ 14; data.b _ 15};
1 => {data.a _ 15; data.b _ 14};
ENDCASE => ERROR;
IF local = LAST[CARDINAL] THEN
SELECT r2 _ (random[] MOD 2) FROM
0 => {data.c _ 12; data.cOpt _ TRUE};
1 => {data.c _ 13; data.cOpt _ TRUE};
ENDCASE => ERROR
ELSE
SELECT r2 _ (random[] MOD 3) FROM
0 => {data.c _ local; data.cOpt _ FALSE};
1 => {data.c _ 12; data.cOpt _ TRUE};
2 => {data.c _ 13; data.cOpt _ TRUE};
ENDCASE => ERROR;
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpForPopWWPushW: GetOpProc =    
BEGIN
kind: OpKind _ RROpKind;
data: REF RROpKindDataBody;
r: CARDINAL;
data _ NEW[RROpKindDataBody _ [
op: RROps[random[] MOD 11],
purpose: "PopWWPushW",
c: 0,
a: 0,
aOpt: TRUE, cOpt: TRUE, bOpt: TRUE, aux: FALSE,
b: 0]];
SELECT r _ (random[] MOD 4) FROM
0 => {data.a _ 12; data.b _ 15; data.c _ 12};
1 => {data.a _ 15; data.b _ 12; data.c _ 12};
2 => {data.a _ 13; data.b _ 14; data.c _ 12};
3 => {data.a _ 14; data.b _ 13; data.c _ 12};
ENDCASE => ERROR;
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpForPopW: GetOpProc =    
BEGIN
local1: CARDINAL _ selectLocalIndex[];
local2: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
data: REF RROpKindDataBody;
r1, r2: CARDINAL;
data _ NEW[RROpKindDataBody _ [
op: RROps[random[] MOD 11],
purpose: "PopW",
c: 0,
a: 0,
aOpt: FALSE, cOpt: FALSE, bOpt: FALSE, aux: FALSE,
b: 0]];
IF local2 = LAST[CARDINAL] THEN
{data.c _ 12; data.cOpt _ TRUE}
ELSE
SELECT r1 _ (random[] MOD 2) FROM
0 => {data.c _ local2; data.cOpt _ FALSE};
1 => {data.c _ 12; data.cOpt _ TRUE};
ENDCASE => ERROR;
IF local1 = LAST[CARDINAL] THEN
SELECT r2 _ (random[] MOD 2) FROM
0 => {data.aOpt _ TRUE; data.a _ 12; data.bOpt _ TRUE; data.b _ 14};
1 => {data.aOpt _ TRUE; data.a _ 14; data.bOpt _ TRUE; data.b _ 12};
ENDCASE => ERROR
ELSE
SELECT r2 _ (random[] MOD 2) FROM
0 => {data.aOpt _ TRUE; data.a _ 14; data.b _ local1};
1 => {data.bOpt _ TRUE; data.a _ local1; data.b _ 14};
ENDCASE => ERROR;
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpForPopWPushW: GetOpProc =    
BEGIN
local: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
data: REF RROpKindDataBody;
r: CARDINAL;
data _ NEW[RROpKindDataBody _ [
op: RROps[random[] MOD 11],
purpose: "PopWPushW",
c: 0,
a: 0,
aOpt: TRUE, cOpt: FALSE, bOpt: TRUE, aux: FALSE,
b: 0]];
IF local = LAST[CARDINAL] THEN
{data.aOpt _ TRUE; data.a _ 12; data.bOpt _ TRUE; data.b _ 12} 
ELSE
SELECT r _ (random[] MOD 2) FROM
0 => {data.aOpt _ FALSE; data.a _ local; data.bOpt _ TRUE; data.b _ 12};
1 => {data.aOpt _ TRUE; data.a _ 12; data.bOpt _ FALSE; data.b _ local};
ENDCASE => ERROR;
{data.cOpt _ TRUE; data.c _ 12};
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;


GetRROpForPushW: GetOpProc =    
BEGIN
local1: CARDINAL _ selectLocalIndex[];
local2: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
data: REF RROpKindDataBody;
IF local1 = LAST[CARDINAL] OR local2 = LAST[CARDINAL] THEN RETURN[NIL];
data _ NEW[RROpKindDataBody _ [
op: RROps[random[] MOD 11],
purpose: "PushW",
c: 15,
a: local1,
aOpt: FALSE, cOpt: TRUE, bOpt: FALSE, aux: FALSE,
b: local2]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpForPushT: GetOpProc =    
BEGIN
local: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
r: CARDINAL;
data: REF RROpKindDataBody;
IF local = LAST[CARDINAL] THEN RETURN[NIL];
data _ NEW[RROpKindDataBody _ [
op: SELECT (r _ random[] MOD 2) FROM
0 => RAND,
1 => ROR
ENDCASE => ERROR,
purpose: "PushT",
c: 15,
a: local,
aOpt: FALSE, cOpt: TRUE, bOpt: FALSE, aux: FALSE,
b: local]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpForPopT: GetOpProc =    
BEGIN
local: CARDINAL _ selectLocalIndex[];
SelectLocal: PROCEDURE RETURNS[CARDINAL] = {RETURN[local]};
op: OpDescriptor;
data: REF RROpKindDataBody;
IF local = LAST[CARDINAL] THEN RETURN[NIL];
op _ GetRROpForStoreLocalT[class, random, SelectLocal, NIL, NIL];
data _ NARROW[op.data];
data.purpose _ "PopT";
RETURN[op];
END;

GetRROpForStoreLocalT: GetOpProc =
BEGIN
local: CARDINAL _ selectLocalIndex[];
kind: OpKind _ RROpKind;
r1, r2: CARDINAL;
data: REF RROpKindDataBody;
IF local = LAST[CARDINAL] THEN ERROR;
data _ NEW[RROpKindDataBody _ [
op:  SELECT (r1 _ random[] MOD 2) FROM
0 => RAND,
1 => ROR
ENDCASE => ERROR,
purpose: "StoreLocalT",
c: local,
a: 0,
aOpt: TRUE, cOpt: FALSE, bOpt: TRUE, aux: FALSE,
b: 0]];
SELECT r2 _ (random[] MOD 2) FROM
0 => {data.a _ 14; data.b _ 12};
1 => {data.a _ 12; data.b _ 14};
ENDCASE => ERROR;
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRROpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[3]};

<<this test assumes only ordinary word types in the constant registers.>>
TypeCheckRROp: PROCEDURE[op: OpDescriptor, node: PGNode] =
BEGIN
opData: REF RROpKindDataBody _ NARROW[op.data];
mdt: CARDINAL _ 0; -- maxDepthTouched
aLocal: BOOLEAN _ NOT opData.aOpt;
bLocal: BOOLEAN _ NOT opData.bOpt;
cLocal: BOOLEAN _ NOT opData.cOpt;
aType, bType, sType: WordType;
SE: INTEGER _ 0; -- initial value
IF opData.aux THEN ERROR; -- above local equations would be wrong
IF aLocal THEN aType _ GetFrameVarType[node, opData.a]
ELSE SELECT opData.a FROM
< 12 => aType _ GetOrdinaryWordType[GetTypeSet[node]];
12 => aType _ GetTopOfStack[node];
13 => aType _ GetNextOfStack[node];
14 => {aType _ GetTopOfStack[node]; SE _ SE - 1};
15 => {aType _ GetNextOfStack[node]; SE _ SE - 1};
ENDCASE => ERROR;
IF bLocal THEN bType _ GetFrameVarType[node, opData.b]
ELSE SELECT opData.b FROM
< 12 => bType _ GetOrdinaryWordType[GetTypeSet[node]];
12 => bType _ GetTopOfStack[node];
13 => bType _ GetNextOfStack[node];
14 => {bType _ GetTopOfStack[node]; SE _ SE - 1};
15 => {bType _ GetNextOfStack[node]; SE _ SE - 1};
ENDCASE => ERROR;
IF aType # bType THEN ERROR;
IF aLocal AND bLocal AND opData.a = opData.b AND (opData.op = RAND OR opData.op = ROR) THEN sType _ aType
ELSE IF NOT aLocal AND NOT bLocal AND (opData.op = RAND OR opData.op = ROR) AND 
(opData.a = opData.b OR (opData.a = 12 AND opData.b = 14) OR (opData.a = 14 AND opData.b = 12) OR (opData.a = 13 AND opData.b = 15) 
OR (opData.a = 15 AND opData.b = 13)) THEN sType _ aType
ELSE sType _ GetOrdinaryWordType[GetTypeSet[node]];
IF NOT cLocal AND opData.c = 15 THEN SE _ SE + 1;
IF SE = +1 THEN
BEGIN
IF cLocal THEN ERROR; -- we had better put something on top
IF opData.c # 14 AND opData.c # 15 THEN ERROR; -- again, nothing was put on top;
BasicNodeTypeCheck[node, 0, 1];
IF NOT WordStorableAs[sType, GetTopOfNextStack[node]] THEN ERROR;
END
ELSE IF cLocal THEN
BEGIN
BasicNodeTypeCheck[node, -SE, 0, opData.c];
IF NOT WordStorableAs[sType, GetNextFrameVarType[node, opData.c]] THEN ERROR;
END
ELSE IF opData.c < 12 THEN
ERROR -- we don't allow storing at constants
ELSE
BEGIN
SELECT opData.c FROM
12 => -- storing at old top of stack
SELECT SE FROM
0 => -- no stack size change
BEGIN
BasicNodeTypeCheck[node, 1, 1];
IF NOT WordStorableAs[sType, GetTopOfNextStack[node]] THEN ERROR;
END;
-1 => -- removing one from top of stack
BasicNodeTypeCheck[node, 1, 0];
-2 => -- removing two from top of stack
BasicNodeTypeCheck[node, 2, 0];
ENDCASE => ERROR;
13 => -- storing one down from old top
SELECT SE FROM
0 => -- no stack size change
BEGIN
BasicNodeTypeCheck[node, 2, 2];
IF NOT WordStorableAs[GetTopOfStack[node], GetTopOfNextStack[node]] THEN ERROR;
IF NOT WordStorableAs[sType, GetNextOfNextStack[node]] THEN ERROR;
END;
-1 => -- removing one from top of stack
BEGIN
BasicNodeTypeCheck[node, 2, 1];
IF NOT WordStorableAs[sType, GetTopOfNextStack[node]] THEN ERROR;
END;
-2 => -- removing two from top of stack
BasicNodeTypeCheck[node, 2, 0];
ENDCASE => ERROR;
ENDCASE => ERROR;
END;
END;

PrintRROpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: REF RROpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g), c: %g, a: %g, aOpt: %g, ",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose],
IO.card[opData.c],
IO.card[opData.a],
IO.rope[IF opData.aOpt THEN "1" ELSE "0"]];
on.PutF["cOpt: %g, bOpt: %g, aux: %g, b: %g]",
IO.rope[IF opData.cOpt THEN "1" ELSE "0"],
IO.rope[IF opData.bOpt THEN "1" ELSE "0"],
IO.rope[IF opData.aux THEN "1" ELSE "0"],
IO.card[opData.b]];
on.PutF["\N"];
END;

GenRROpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: REF RROpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
oneByte[
(IF opData.aOpt THEN 128 ELSE 0) +
(IF opData.cOpt THEN 64 ELSE 0) +
(IF opData.bOpt THEN 32 ELSE 0) +
(IF opData.aux THEN 16 ELSE 0) +
opData.b];
oneByte[opData.c*16+opData.a];
END;

<<JBB codes>>

JBBOpKind: OpKind _ NEW[OpKindBody _ [
"JBBOp",
CopyJBBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetJBBOpSize,
SetJBBOpRelativeJump,
TypeCheckJBBOp,
PrintJBBOpDetails,
GenJBBOpBytes]];

JBBOpKindDataBody: TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE,
dist: [-128..127],
lit: [0..255]];

JBBOps: ARRAY[0..4) OF OpName = [JEBB, JEBBJ, JNEBB, JNEBBJ];

CopyJBBOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF JBBOpKindDataBody _ NARROW[op.data];
outData: REF JBBOpKindDataBody _ NEW[JBBOpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [JBBOpKind,  outData]]];
END;

GetJBOpForTestX: GetOpProc =
BEGIN
kind: OpKind _ JBBOpKind;
r: CARDINAL;
data: REF JBBOpKindDataBody _ NEW[JBBOpKindDataBody _ [
op:  SELECT (r _ random[] MOD 4) FROM
0 => JEBB,
1 => JEBBJ,
2 => JNEBB,
3 => JNEBBJ,
ENDCASE => ERROR,
purpose: "TestX",
dist: 0, -- this wil get filled in later, and if the actual jump doesn't fit, then the op will be replaced
lit: 0]]; -- always test for 0
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetJBBOpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[3]};

SetJBBOpRelativeJump: PROCEDURE[op: OpDescriptor, deltaBytes: INT] =
BEGIN
delta: INT;
opData: REF JBBOpKindDataBody _ NARROW[op.data];
IF deltaBytes < -128 OR deltaBytes > 127 THEN SIGNAL TooFar[];
opData.dist _ deltaBytes;
delta _ 25;
delta _ opData.dist;
IF delta # deltaBytes THEN ERROR;
END;

TypeCheckJBBOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
BEGIN
opData: REF JBBOpKindDataBody _ NARROW[op.data];
BasicNodeTypeCheck[node, 1, 0, LAST[CARDINAL], TRUE];
CheckRelativeJump[node, opData.dist];
<<note: we will accept any word type argument, and the op code will just look at the bits >>
END;

PrintJBBOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: REF JBBOpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g), dist: %g, lit: %g]",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose],
IO.int[opData.dist],
IO.int[opData.lit]];
on.PutF["\N"];
END;

GenJBBOpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: REF JBBOpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
oneByte[(opData.lit + 256) MOD 256];
oneByte[opData.dist];
END;

<<OB format op codes>>

EPOpKind: OpKind _ NEW[OpKindBody _ [
"EPOp",
CopyOBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetOBOpSize,
NullSetRelativeJump,
TypeCheckEPOp,
PrintOBOpDetails,
GenOBOpBytes]];

RETOpKind: OpKind _ NEW[OpKindBody _ [
"RETOp",
CopyOBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetOBOpSize,
NullSetRelativeJump,
TypeCheckRETOp,
PrintOBOpDetails,
GenOBOpBytes]];

JBOpKind: OpKind _ NEW[OpKindBody _ [
"JBOp",
CopyOBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetOBOpSize,
SetJBOpRelativeJump,
TypeCheckJBOp,
PrintOBOpDetails,
GenOBOpBytes]];

OBOpKindDataBody: TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE,
lit: [0..255]];

OBOps: ARRAY[0..3) OF OpName = [EP, RET, JB];

CopyOBOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF OBOpKindDataBody _ NARROW[op.data];
outData: REF OBOpKindDataBody _ NEW[OBOpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [op.kind,  outData]]];
END;

GetEPOpForEntry: PUBLIC PROCEDURE[nArgs: CARDINAL] RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ EPOpKind;
data: REF OBOpKindDataBody _ NEW[OBOpKindDataBody _ [
op:  EP,
purpose: "Entry",
lit: (257-nArgs) MOD 256]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetRetOpForReturn: PUBLIC PROCEDURE[nRetWords: CARDINAL] RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ RETOpKind;
data: REF OBOpKindDataBody _ NEW[OBOpKindDataBody _ [
op:  EP,
purpose: "Return",
lit: (255 + nRetWords) MOD 256]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetJBOpForJump: PUBLIC PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ JBOpKind;
data: REF OBOpKindDataBody _ NEW[OBOpKindDataBody _ [
op:  JB,
purpose: "Jump",
lit: deltaBytes]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetOBOpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[2]};

SetJBOpRelativeJump: PROCEDURE[op: OpDescriptor, deltaBytes: INT] =
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
IF deltaBytes < -128 OR deltaBytes > 127 THEN SIGNAL TooFar[];
opData.lit _ (deltaBytes + 256) MOD 256;
END;

TypeCheckEPOp: PROCEDURE[op: OpDescriptor, node: PGNode] =
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
TypeCheckEPNode[node, (257-opData.lit) MOD 256]
END;

TypeCheckRETOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
TypeCheckRETNode[node, (opData.lit+1) MOD 256]
END;

TypeCheckJBOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
BasicNodeTypeCheck[node, 0, 0, LAST[CARDINAL], FALSE, TRUE];
CheckRelativeJump[node, ((opData.lit+128) MOD 256) - 128];
END;

PrintOBOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g), lit: %g]",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose],
IO.card[opData.lit]];
on.PutF["\N"];
END;

GenOBOpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: REF OBOpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
oneByte[opData.lit];
END;


<<LRB format op codes>>

SRInOpKind: OpKind _ NEW[OpKindBody _ [
"SRInOp",
CopyLRBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetLRBOpSize,
NullSetRelativeJump,
TypeCheckSRInOp,
PrintLRBOpDetails,
GenLRBOpBytes]];

LRInOpKind: OpKind _ NEW[OpKindBody _ [
"LRInOp",
CopyLRBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetLRBOpSize,
NullSetRelativeJump,
TypeCheckLRInOp,
PrintLRBOpDetails,
GenLRBOpBytes]];

LRBOpKindDataBody:  TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE,
reg: [0..15],
disp: [0..255]];

SRInOps: ARRAY[0..16) OF OpName = [SRI0,  SRI1, SRI2, SRI3, SRI4, SRI5, SRI6, SRI7, SRI8, SRI9, SRI10, SRI11, SRI12, SRI13, SRI14, 
SRI15];

LRInOps: ARRAY[0..16) OF OpName = [LRI0, LRI1, LRI2, LRI3, LRI4, LRI5, LRI6, LRI7, LRI8, LRI9, LRI10, LRI11, LRI12, LRI13, LRI14, 
LRI15];    

CopyLRBOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF LRBOpKindDataBody _ NARROW[op.data];
outData: REF LRBOpKindDataBody _ NEW[LRBOpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [op.kind,  outData]]];
END;

GetLRBOpForPushFIT: GetOpProc =    
BEGIN
local: CARDINAL;
remote: CARDINAL;
data: REF LRBOpKindDataBody;
kind: OpKind _ LRInOpKind;
[local, remote] _ selectLocalRemoteIndices[];
data _ NEW[LRBOpKindDataBody _ [
op: LRInOps[local],
purpose: "PushFIT",
reg: local,
disp: remote]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetLRBOpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[2]};

TypeCheckSRInOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF LRBOpKindDataBody _ NARROW[op.data];
remoteRecordType: SeqType _ GetSeqTypeOfPointerType[GetFrameVarType[node, opData.reg]];
IF SRInOps[opData.reg] # opData.op THEN ERROR;
BasicNodeTypeCheck[node, 1, 0];
IF NOT WordStorableAs[GetTopOfStack[node], GetWordTypeFromOffset[remoteRecordType, opData.disp]] THEN ERROR;
END;

TypeCheckLRInOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF LRBOpKindDataBody _ NARROW[op.data];
remoteRecordType: SeqType _ GetSeqTypeOfPointerType[GetFrameVarType[node, opData.reg]];
IF LRInOps[opData.reg] # opData.op THEN ERROR;
BasicNodeTypeCheck[node, 0, 1];
IF NOT WordStorableAs[GetWordTypeFromOffset[remoteRecordType, opData.disp], GetTopOfNextStack[node]] THEN ERROR;
END;

PrintLRBOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: REF LRBOpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g), reg: %g, disp: %g]",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose],
IO.card[opData.reg],
IO.card[opData.disp]];
on.PutF["\N"];
END;

GenLRBOpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: REF LRBOpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
oneByte[opData.disp];
END;

<<ODB format op codes>>

JDBOpKind: OpKind _ NEW[OpKindBody _ [
"JDBOp",
CopyODBOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetODBOpSize,
SetJDBOpRelativeJump,
TypeCheckJDBOp,
PrintODBOpDetails,
GenODBOpBytes]];

ODBOpKindDataBody: TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE,
litt: [0..65535]];

ODBOps: ARRAY[0..1) OF OpName = [JDB];

CopyODBOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF ODBOpKindDataBody _ NARROW[op.data];
outData: REF ODBOpKindDataBody _ NEW[ODBOpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [op.kind,  outData]]];
END;


GetJDBOpForJump: PUBLIC PROCEDURE[deltaBytes: INTEGER] RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ JDBOpKind;
data: RefODBOpKindDataBody _ NEW[ODBOpKindDataBody _ [
op:  JDB,
purpose: "Jump",
litt: deltaBytes+3267]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetODBOpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[3]};

SetJDBOpRelativeJump: PROCEDURE[op: OpDescriptor, deltaBytes: INT] =
BEGIN
opData: RefODBOpKindDataBody _ NARROW[op.data];
IF deltaBytes < -32767 OR deltaBytes > 32768 THEN SIGNAL TooFar[];
opData.litt _ deltaBytes+3267;
END;

TypeCheckJDBOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: RefODBOpKindDataBody _ NARROW[op.data];
litt: INT _ opData.litt; -- gets it into right mode
BasicNodeTypeCheck[node, 0, 0, LAST[CARDINAL], FALSE, TRUE];
CheckRelativeJump[node, litt-3267];
END;

PrintODBOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: RefODBOpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g), lit: %g]",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose],
IO.card[opData.litt]];
on.PutF["\N"];
END;    

GenODBOpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: RefODBOpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
oneByte[Basics.HighByte[opData.litt]];
oneByte[Basics.LowByte[opData.litt]];
END;


<<OI format op codes>>

SFCOpKind: OpKind _ NEW[OpKindBody _ [
"SFCOp",
CopyOIOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetOIOpSize,
NullSetRelativeJump,
TypeCheckSFCOp,
PrintOIOpDetails,
GenOIOpBytes]];

StopTrapOpKind: OpKind _ NEW[OpKindBody _ [
"StopTrapOp",
CopyOIOp,
NoteNullOpInstallation,
NullOpInstallationRelease,
NullOpGetDummyOpShape,
GetOIOpSize,
NullSetRelativeJump,
TypeCheckStopTrapOp,
PrintOIOpDetails,
GenOIOpBytes]];

OIOpKindDataBody: TYPE = RECORD[
op: OpName,
purpose: Rope.ROPE];

OIOps: ARRAY[0..1) OF OpName = [SFC];

CopyOIOp: PROCEDURE[op: OpDescriptor] RETURNS[OpDescriptor] =
BEGIN
inData: REF OIOpKindDataBody _ NARROW[op.data];
outData: REF OIOpKindDataBody _ NEW[OIOpKindDataBody _ inData^];
RETURN[NEW[OpDescriptorBody _ [op.kind,  outData]]];
END;


GetSFCOpForSFCall: PUBLIC PROCEDURE RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ SFCOpKind;
data: REF OIOpKindDataBody _ NEW[OIOpKindDataBody _ [
op:  SFC,
purpose: "SFCall"]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;


GetStopTrapOpForStop: PUBLIC PROCEDURE RETURNS[OpDescriptor] =
BEGIN
kind: OpKind _ StopTrapOpKind;
data: REF OIOpKindDataBody _ NEW[OIOpKindDataBody _ [
op:  StopTrap,
purpose: "Stop"]];
RETURN[NEW[OpDescriptorBody _ [kind,  data]]];
END;

GetOIOpSize: PROCEDURE[op: OpDescriptor] RETURNS[INT] = {RETURN[1]};

TypeCheckSFCOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF OIOpKindDataBody _ NARROW[op.data];
proc: WordType _ GetTopOfStack[node];
args, results: SeqType;
IF proc.type # procedure THEN ERROR;
[args, results] _ GetArgsResultsOfProcedureType[proc];
BasicNodeTypeCheck[node, GetLength[args]+1, GetLength[results]];
ArgSeqTypeCheck[GetStack[node], args, TRUE];
ResultSeqTypeCheck[results, GetNextStack[node]];    
END;

TypeCheckStopTrapOp: PROCEDURE[op: OpDescriptor, node: PGNode] =    
BEGIN
opData: REF OIOpKindDataBody _ NARROW[op.data];    
END;

PrintOIOpDetails: PROCEDURE[op: OpDescriptor, node: PGNode, on: IO.STREAM, nested: CARDINAL] =
BEGIN
opData: REF OIOpKindDataBody _ NARROW[op.data];
FOR I: CARDINAL IN [0..nested) DO on.PutF[" "] ENDLOOP;
on.PutF["op: %g(%g)]",
IO.rope[RopeFromOpName[opData.op]],
IO.rope[opData.purpose]];
on.PutF["\N"];
END;

GenOIOpBytes: PROCEDURE[op: OpDescriptor, oneByte: PROC[[0..255]]] =
BEGIN
opData: REF OIOpKindDataBody _ NARROW[op.data];
oneByte[ByteCodeFromOpName[opData.op]];
END;


<<main code>>

<<note: need PushFIT and PopSIT, as they are called upon>>

InitDragonOpTables[];
RegisterDragonOpBuilder[PopWW, GetRROpForPopWW];
RegisterDragonOpBuilder[PopWWPushW, GetRROpForPopWWPushW];
RegisterDragonOpBuilder[PopW, GetRROpForPopW];
RegisterDragonOpBuilder[PopWPushW, GetRROpForPopWPushW];
RegisterDragonOpBuilder[PushW, GetRROpForPushW];
RegisterDragonOpBuilder[PushT, GetRROpForPushT];
RegisterDragonOpBuilder[PopT, GetRROpForPopT];
RegisterDragonOpBuilder[StoreLocalT, GetRROpForStoreLocalT];
RegisterDragonOpBuilder[TestX, GetJBOpForTestX];
RegisterDragonOpBuilder[PushFIT, GetLRBOpForPushFIT];
CloseDragonOpTables[];

END.
MODULE HISTORY

Initial by: Sturgis,   May 1, 1984 2:23:24 pm PDT
RTE: May 17, 1984 11:59:49 am PDT: the alpha, beta, etc bytes are defined by DragOps to be from the low order bits to the high 
orderbits  amongst a given number.  I incorrectly generated the high order bits first.
RTE: May 17, 1984 4:46:47 pm PDT: GetEPOpForEntry and GetRetOpForReturn had off by one errors.  The byte in the instruction had to 
be one less than the number of arguments (or return words). 
RTE: May 17, 1984 5:40:07 pm PDT: JBBOpBytes had an error in the calulation of the displacement byte, I added 128, and should not 
have.
RTE: May 18, 1984 11:46:11 am PDT: still an addressing problem, this time with JB.  Also, noticed that the previously fixed 
JBBOpBytes will be wrong for negative relative jumps, so fixed it. (May 18, 1984 11:56:35 am PDT) This fix used a lot of 
conditional range checks, changed to making appropriate use of MODs.
Change: December 16, 1985 2:51:58 pm PST: literal bytes now generated high byte first, rather than low byte first.  Caused a change 
in only GenODBOpBytes.
Change: January 7, 1986 4:30:05 pm PST: Sturgis: changed the order of the two bytes following a JBB op code, as alphaS is now used 
to define the PC after the jump, rather than betaS.
Change: January 20, 1986 3:37:19 pm PST: Sturgis: changed the order of the two bytes following an RRm op code.