[Indigo]<Dragon7.0>RandomCode>RandomCodeDragonOpsImpl.mesa!1

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[

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[

getProc: PROCEDURE[

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[

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;

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.