RoseTranslateWrite.Mesa
Last Edited by: Spreitzer, May 10, 1984 5:07:25 pm PDT PDT PDT PDT PDT PDT
Last Edited by: Barth, March 8, 1983 10:45 am
DIRECTORY Ascii, Basics, BasicTime, Convert, FS, IO, OrderedSymbolTableRef, Rope, RoseTranslateTypes, RoseTranslateInsides, TiogaFileOps, TiogaStreams;
RoseTranslateWrite:
CEDAR
PROGRAM
IMPORTS Ascii, BasicTime, Convert, FS, IO, OSTR: OrderedSymbolTableRef, Rope, TiogaFileOps, TS: TiogaStreams, RoseTranslateTypes, RoseTranslateInsides
EXPORTS RoseTranslateInsides =
BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;
WriteInterfaceDecls:
PROC [job: Job, name:
ROPE, di: DigestedInterface]
RETURNS [iCount:
CARDINAL] =
BEGIN
interface: InterfaceEltList ← di.asList;
toIO, toDrive, toPortFile, portConsts: IO.STREAM;
firstWord: CARDINAL ← 0;
dest: TiogaFileOps.Ref;
portFileName: ROPE ← job.rootName.Cat[".", name, ".rosePorts"];
iCount ← 0;
toPortFile ← FS.StreamOpen[portFileName, create];
TS.EndNode[job.to];
job.to.PutF["Create%gPorts: PROC = {%gPorts ← RoseCreate.PortsFromFile[\"%q\"]};", IO.rope[name], IO.rope[name], IO.rope[portFileName]];
TS.EndNode[job.to];
TS.EndNode[job.to];
toPortFile.PutF["%g", IO.int[di.asTable.Size[]]];
job.to.PutF["%gIORef: TYPE = REF %gIORec;", IO.rope[name], IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["%gIORec: TYPE = MACHINE DEPENDENT RECORD [", IO.rope[name]];
TS.EndNode[job.to];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
toIO ← TS.CreateOutput[dest, "code"];
job.to.PutRope["-- port indices:"];
TS.EndNode[job.to];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
portConsts ← TS.CreateOutput[dest, "code"];
job.to.PutF["%gDrive: TYPE = MACHINE DEPENDENT RECORD [", IO.rope[name]];
TS.EndNode[job.to];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
toDrive ← TS.CreateOutput[dest, "code"];
FOR interface ← interface, interface.rest
WHILE interface #
NIL
DO
Finish:
PROC [s:
IO.
STREAM] =
{IF interface.rest # NIL THEN {s.PutRope[","]; TS.EndNode[s]}};
ie: InterfaceElt ← interface.first;
iename: ROPE ← ie.name;
bitWidth, wordWidth, bitRem: CARDINAL;
mesaType: Mesa;
xPhobic, special: BOOLEAN ← FALSE;
UseSignalType[job, ie.sti.st];
bitWidth ← ie.sti.st.procs.Bits[ie.sti.st];
mesaType ← ie.sti.st.procs.MesaUse[ie.sti.st];
AddMesa[job, mesaType];
wordWidth ← (bitWidth + 15)/16;
bitRem ← bitWidth MOD 16;
IF bitRem # 0
THEN
BEGIN
toIO.PutF["fill%g(%g:0..%g): [0..%g],", IO.card[iCount], IO.card[firstWord], IO.int[15 - bitRem], IO.card[uppers[16 - bitRem]]];
TS.EndNode[toIO];
END;
toIO.PutF["%g(%g:%g..%g): %g", IO.rope[iename], IO.card[firstWord], IO.card[(16-bitRem) MOD 16], IO.card[16*wordWidth - 1], IO.rope[mesaType.mesa]];
Finish[toIO];
toDrive.PutF["fill%g(%g:0..14): [0 .. 32768),", IO.card[iCount], IO.card[iCount]];
TS.EndNode[toDrive];
toDrive.PutF["%g(%g:15..15): BOOLEAN", IO.rope[iename], IO.card[iCount]];
Finish[toDrive];
FOR rl: RopeList ← ie.switches, rl.rest
WHILE rl #
NIL
DO
IF rl.first.Equal["X"] THEN xPhobic ← TRUE
ELSE IF rl.first.Equal["S"] THEN special ← TRUE
ELSE Whimper[job, "Unkown switch %g to port %g of %g", IO.rope[rl.first], IO.rope[iename], IO.rope[name]];
ENDLOOP;
toPortFile.PutF[" %g %g %g ", IO.card[firstWord], IO.card[wordWidth], IO.rope[Convert.RopeFromRope[iename]]];
WriteInvocation[toPortFile, ie.sti.invocation];
toPortFile.PutF["!! %g", IO.card[(IF ie.input THEN 1 ELSE 0) + (IF ie.output THEN 2 ELSE 0) + (IF xPhobic THEN 4 ELSE 0) + (IF special THEN 8 ELSE 0)]];
IF
NOT ie.sti.st.simple
THEN {
portConsts.PutF["%g%gPortIndex: CARDINAL = %g;", IO.rope[name], IO.rope[InitialCap[iename]], IO.card[iCount]];
TS.EndNode[portConsts]};
firstWord ← firstWord + wordWidth;
iCount ← iCount + 1;
ENDLOOP;
toIO.PutRope["];"]; toIO.Close[];
toDrive.PutRope["];"]; toDrive.Close[];
toPortFile.Close[];
END;
InitialCap:
PROC [r:
ROPE]
RETURNS [
R:
ROPE] = {
l: INT = r.Length[];
IF l = 0 THEN RETURN [r];
R ← Rope.FromChar[Ascii.Upper[r.Fetch[0]]].Concat[r.Substr[start: 1, len: l-1]]};
TranslatePiece:
PROC [job: Job, asAny:
REF
ANY] =
BEGIN
IF asAny # error
THEN
WITH asAny
SELECT
FROM
b: Binding => TranslateCellDef[b, job];
cs: CedarSource => InjectCedar[job, cs];
ENDCASE => [] ← Complain[job, "Got %g when expecting CEDAR or a CELL", IO.refAny[asAny]];
END;
Close:
PUBLIC
PROC [job: Job] =
BEGIN
IF job.errCount < 1
THEN
BEGIN
WITH job.parseTree
SELECT
FROM
s: Statements => FOR l: LORA ← s.statements, l.rest WHILE l # NIL DO TranslatePiece[job, l.first] ENDLOOP;
ENDCASE => TranslatePiece[job, job.parseTree];
END
ELSE job.log.PutRope["Translation aborted due to errors\n"];
job.log.PutF["%g error%g, %g warning%g", IO.card[job.errCount], IO.rope[IF job.errCount = 1 THEN "" ELSE "s"], IO.card[job.warnCount], IO.rope[IF job.warnCount = 1 THEN "" ELSE "s"]];
job.log.PutF["; source tokens: %g, time: %g\n", IO.card[job.tokenCount], IO.real[BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - job.start]]];
job.directoryStream.PutRope[";"];
job.directoryStream.Close[];
job.importsStream.PutRope[" ="];
job.importsStream.Close[];
job.openStream.PutRope[";"];
job.openStream.Close[];
job.regStream.PutRope["END;"];
job.regStream.Close[];
job.typeStream.Close[];
TS.EndNode[job.to];
job.to.PutRope["RegisterCells[];"];
TS.EndNode[job.to];
TS.EndNode[job.to];
job.to.PutRope["END."];
job.to.Close[];
IF job.errCount < 1
THEN
TRUSTED
BEGIN
destName: ROPE;
TiogaFileOps.Store[job.outRoot, destName ← job.rootName.Concat[".Mesa"]];
--DoMesaFormatting[destName];--
--UserExecExtras.DoIt[job.exec, Rope.Cat["compile ", job.rootName]];--
TiogaFileOps.Store[job.symbolsRoot, job.rootName.Concat[".RoseSymbols"]];
WriteDeps[job];
END;
END;
TranslateCellDef:
PROC [b: Binding, job: Job] =
BEGIN
name: ROPE ← b.name;
cellDef: CellDef ← NARROW[b.value];
IF b.initial # NIL THEN [] ← Complain[job, "Cell Class %g given initial value --- that's nonsense", IO.rope[name]];
RationalizeInitData[job, name, cellDef];
AddInterfaceNodes[job, cellDef];
WriteInterfaceSpec[job, name, cellDef];
WriteRegistration[job, name, cellDef];
IF cellDef.interface.asList # NIL THEN cellDef.portCount ← WriteInterfaceDecls[job, name, cellDef.interface];
IF cellDef.initDataGiven THEN WriteInitData[job, name, cellDef.initDataSource];
IF cellDef.defaultInitDataGiven THEN WriteDefaultInitData[job, name, cellDef.defaultInitDataSource];
IF cellDef.stateGiven THEN WriteState[job, name, cellDef.stateSource];
IF cellDef.expandGiven THEN WriteExpand[job, name, cellDef.expandCode.statements, cellDef];
IF cellDef.interface.asList # NIL THEN WriteIOCreator[job, name, cellDef];
IF cellDef.stateGiven OR cellDef.initializerGiven THEN WriteInitializer[job, name, cellDef.initializerSource, cellDef];
FOR et: EvalType
IN EvalType
DO
IF cellDef.evalsGiven[et] THEN WriteEval[job, name, et, cellDef.evalSources[et], cellDef];
ENDLOOP;
IF cellDef.bbTestGiven THEN WriteTest[job, name, FALSE, cellDef.bbTestSource, cellDef];
IF cellDef.stTestGiven THEN WriteTest[job, name, TRUE, cellDef.stTestSource, cellDef];
WritePorts[job, name, cellDef.portCount];
RemoveNodes[job];
AddCellClass[job, NEW [SymbolTableEntryRep[cellClass] ← [name: name, value: cellClass[definedIn: job.rootName, cd: cellDef]]]];
END;
RationalizeInitData:
PROC [job: Job, className:
ROPE, cellDef: CellDef] =
BEGIN
IF cellDef.defaultInitDataGiven
AND cellDef.defaultInitExprGiven
THEN
Whimper[job, "%g's default init data expression given both implicitly and explicitly", IO.rope[className]]
ELSE
IF cellDef.defaultInitDataGiven
THEN
BEGIN
cellDef.defaultInitExprGiven ← TRUE;
cellDef.defaultInitExpr ← IO.PutFR["%g.default%gInitRef", IO.rope[job.rootName], IO.rope[className]];
END;
END;
RemoveNodes:
PROC [job: Job] =
BEGIN
DeleteNode:
PROC [asAny:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
BEGIN
ste: SymbolTableEntry ← NARROW[asAny];
IF ste.type = node THEN [] ← job.things.Delete[ste];
stop ← FALSE;
END;
job.things.EnumerateIncreasing[DeleteNode];
END;
AddInterfaceNodes:
PROC [job: Job, cellDef: CellDef] =
BEGIN
FOR iel: InterfaceEltList ← cellDef.interface.asList, iel.rest
WHILE iel #
NIL
DO
ne: nodeEntry ← NEW [SymbolTableEntryRep[node] ← [name: iel.first.name, value: node[iel.first.sti.st]]];
job.things.Insert[ne];
ENDLOOP;
END;
WriteInterfaceSpec:
PROC [job: Job, name:
ROPE, cellDef: CellDef] =
BEGIN
job.symbolsStream.PutF["%g %g %g %g ", IO.rope[name], IO.rope[job.rootName], IO.card[(IF cellDef.defaultInitExprGiven THEN 1 ELSE 0) + (IF cellDef.initializerGiven THEN 2 ELSE 0) + (IF cellDef.initDataGiven THEN 4 ELSE 0)], IO.refAny[cellDef.defaultInitExpr]];
IF cellDef.interface.asList # NIL THEN WriteInterface[job.symbolsStream, cellDef.interface] ELSE job.symbolsStream.PutRope["NULL"];
job.symbolsStream.PutRope[" !!\n"];
TS.EndNode[job.symbolsStream];
END;
WriteInterface:
PROC [to:
IO.
STREAM, interface: DigestedInterface] =
BEGIN
first: BOOLEAN ← TRUE;
to.PutRope["["];
FOR iel: InterfaceEltList ← interface.asList, iel.rest
WHILE iel #
NIL
DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
to.PutF["%g%g", IO.rope[iel.first.name], IO.rope[ways[iel.first.input][iel.first.output]]];
WriteInvocation[to, iel.first.sti.invocation];
ENDLOOP;
to.PutRope["]"];
END;
ways: ARRAY BOOLEAN OF ARRAY BOOLEAN OF ROPE ← [["??", ">"], ["<", "="]];
WriteInvocation:
PROC [to:
IO.
STREAM, i: Invocation] =
BEGIN
to.PutRope[i.name];
IF i.parms #
NIL
THEN
BEGIN
to.PutRope["["];
WITH i.parms
SELECT
FROM
bl: BindingList => WriteBindingList[to, bl];
a: Args => WriteArgs[to, a];
ENDCASE => ERROR;
to.PutRope["]"];
END;
END;
WriteBindingList:
PROC [to:
IO.
STREAM, bl: BindingList] =
BEGIN
first: BOOLEAN ← TRUE;
FOR bl ← bl, bl.rest
WHILE bl #
NIL
DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
to.PutF["%g:", IO.rope[bl.first.name]];
WriteValue[to, bl.first.value];
ENDLOOP;
END;
WriteArgs:
PROC [to:
IO.
STREAM, args: Args] =
BEGIN
first: BOOLEAN ← TRUE;
FOR l:
LIST
OF Arg ← args.args, l.rest
WHILE l #
NIL
DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
WriteValue[to, l.first];
ENDLOOP;
END;
WriteValue:
PROC [to:
IO.
STREAM, value:
REF
ANY] =
BEGIN
WITH value
SELECT
FROM
r: ROPE => to.Put[IO.rope[r]];
q: Quoted => to.Put[IO.rope[Convert.RopeFromRope[q.rope]]];
ri: REF INT => to.Put[IO.int[ri^]];
ENDCASE => ERROR;
END;
uppers: ARRAY [1..15] OF CARDINAL ← [1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767];
WriteSTI: PROC [to: IO.STREAM, sti: SignalTypeInvocation] =
BEGIN
to.PutRope[sti.invocation.name];
IF sti.invocation.parms # NIL THEN
BEGIN
to.PutChar['[];
WriteParms[to, sti.invocation.parms];
to.PutChar[']];
END;
to.PutRope["!!"];
END;
WriteParms: PROC [to: IO.STREAM, parms: REF ANY] =
BEGIN
WITH parms SELECT FROM
bl: BindingList => BEGIN
FOR l: BindingList ← bl, l.rest WHILE l # NIL DO
to.PutF["%q: ", IO.rope[l.first.name]];
WriteArg[to, l.first.value];
IF l.rest # NIL THEN to.PutRope[", "];
ENDLOOP;
END;
args: Args => BEGIN
FOR l: LIST OF Arg ← args.args, l.rest WHILE l # NIL DO
WriteArg[to, l.first];
IF l.rest # NIL THEN to.PutRope[", "];
ENDLOOP;
END;
ENDCASE => ERROR;
END;
WriteArg: PROC [to: IO.STREAM, arg: Arg] =
BEGIN
WITH arg SELECT FROM
rope: ROPE => to.PutF["%q", IO.rope[rope]];
quoted: Quoted => to.PutF["%q", IO.rope[Convert.RopeFromRope[quoted.rope]]];
ri: REF INT => to.Put[IO.int[ri^]];
ENDCASE => ERROR;
END;
WriteInitData:
PROC [job: Job, name:
ROPE, cs: CedarSource] =
BEGIN
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["%gInitRef: TYPE = REF %gInitRec;", IO.rope[name], IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["%gInitRec: PUBLIC TYPE = RECORD [", IO.rope[name]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutF["];"]; TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
END;
WriteDefaultInitData:
PROC [job: Job, name:
ROPE, cs: CedarSource] =
BEGIN
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["default%gInitRef: PUBLIC %gInitRef ← NEW [%gInitRec ← [", IO.rope[name], IO.rope[name], IO.rope[name]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutF["]];"]; TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
END;
WriteState:
PROC [job: Job, name:
ROPE, cs: CedarSource] =
BEGIN
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["%gStateRef: TYPE = REF %gStateRec;", IO.rope[name], IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["%gStateRec: TYPE = RECORD [", IO.rope[name]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutF["];"]; TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
END;
WriteIOCreator:
PROC [job: Job, name:
ROPE, cellDef: CellDef] =
BEGIN
TS.EndNode[job.to];
job.to.PutF["Create%gIO: IOCreator = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.interface.hasSwitchElt
THEN {
job.to.PutF["cell.realCellStuff.switchIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
};
job.to.PutF["cell.realCellStuff.newIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["cell.realCellStuff.oldIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteInitializer:
PROC [job: Job, name:
ROPE, cs: CedarSource, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
opend: ROPE ← "";
TS.EndNode[job.to];
job.to.PutF["Initialize%g: Initializer = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["IF leafily THEN"];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"];
TS.EndNode[job.to];
IF cellDef.initializerGiven
THEN
BEGIN
job.to.PutF["ioRec: %gIORef ← NARROW[cell.realCellStuff.newIO];", IO.rope[name]];
TS.EndNode[job.to];
opend ← opend.Cat["ioRec"];
IF cellDef.initDataGiven
THEN
BEGIN
job.to.PutF["narrowedInitData: %gInitRef ← NARROW[initData];", IO.rope[name]];
TS.EndNode[job.to];
opend ← opend.Cat[", narrowedInitData"];
END;
IF cellDef.stateGiven THEN opend ← opend.Cat[", state"];
END;
IF cellDef.stateGiven
THEN
BEGIN
job.to.PutF["state: %gStateRef ← NEW [%gStateRec", IO.rope[name], IO.rope[name]];
IF cellDef.stateInittable THEN job.to.PutRope[" ← []"];
job.to.PutRope["];"];
TS.EndNode[job.to];
job.to.PutRope["cell.realCellStuff.state ← state;"];
TS.EndNode[job.to];
END;
IF cellDef.initializerGiven
THEN
BEGIN
job.to.PutF["BEGIN OPEN %g;", IO.rope[opend]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
END;
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteEval:
PROC [job: Job, name:
ROPE, et: EvalType, cs: CedarSource, cellDef: CellDef] =
BEGIN
opend: ROPE ← NIL;
AddOpen:
PROC [o:
ROPE] = {
opend ← IF opend = NIL THEN o ELSE (opend.Cat[", ", o])};
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["%g%g: %g =",
IO.rope[name],
IO.rope[etNames[et]],
IO.rope[
IF et = FindVicinity
THEN "PROC [cell: Cell, index: CARDINAL]"
ELSE "CellProc"]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TS.EndNode[job.to];
SELECT et
FROM
FindVicinity => NULL;
InitQ, PropQ, InitUD, PropUD, FinalUD, ValsChanged => {
AddOpen["sw"];
IF NOT cellDef.interface.hasSwitchElt THEN Whimper[job, "Cell class %g has a %g, but no switch-level interface elements!", IO.rope[name], IO.rope[etNames[et]]];
};
EvalSimple => AddOpen["newIO"];
ENDCASE => ERROR;
IF cellDef.interface.hasSwitchElt
THEN {
job.to.PutF["sw: %gIORef ← NARROW[cell.realCellStuff.switchIO];", IO.rope[name]];
TS.EndNode[job.to];
};
job.to.PutF["newIO: %gIORef ← NARROW[cell.realCellStuff.newIO];", IO.rope[name]];
IF cellDef.stateGiven
THEN
BEGIN
TS.EndNode[job.to];
job.to.PutF["state: %gStateRef ← NARROW[cell.realCellStuff.state];", IO.rope[name]];
AddOpen["state"];
END;
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"];
IF opend # NIL THEN job.to.PutF[" OPEN %g;", IO.rope[opend]];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
WriteTest:
PROC [job: Job, name:
ROPE, stateToo:
BOOL, cs: CedarSource, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["%g%gTest: CellTestProc =", IO.rope[name], IO.rope[IF stateToo THEN "ST" ELSE "BB"]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TS.EndNode[job.to];
job.to.PutF["instructions: %gIORef ← NARROW[io];", IO.rope[name]];
TS.EndNode[job.to];
IF stateToo THEN {
job.to.PutF["state: %gStateRef ← NARROW[stateAsAny];", IO.rope[name]];
TS.EndNode[job.to]};
job.to.PutF["drive: REF %gDrive ← NARROW[driveAsAny];", IO.rope[name]];
IF cellDef.initDataGiven
THEN
BEGIN
TS.EndNode[job.to];
job.to.PutF["initRef: %gInitRef ← NARROW[initData];", IO.rope[name]];
END;
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN OPEN "];
IF cellDef.initDataGiven THEN job.to.PutRope["initRef, "];
IF stateToo THEN job.to.PutRope["state, "];
job.to.PutRope["instructions;"];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
WriteExpand:
PROC [job: Job, name:
ROPE, ec:
LORA, cellDef: CellDef] =
BEGIN
TS.EndNode[job.to];
job.to.PutF["%gExpand: ExpandProc = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.initDataGiven
THEN
BEGIN
job.to.PutF["initRef: %gInitRef ← NARROW[initData];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN OPEN initRef;"];
TS.EndNode[job.to];
END;
IF cellDef.interface.asList #
NIL
THEN {
job.to.PutRope["PrivateLookupNode: PROC [name: ROPE] RETURNS [node: Node] = {node ← RoseCreate.LookupNode[from: thisCell, path: LIST[name]]};"];
TS.EndNode[job.to];
};
FOR iel: InterfaceEltList ← cellDef.interface.asList, iel.rest
WHILE iel #
NIL
DO
job.to.PutF[
"%g: Node ← PrivateLookupNode[\"%g\"];",
IO.rope[iel.first.name], IO.rope[iel.first.name]];
TS.EndNode[job.to];
ENDLOOP;
job.nodeCreateHacks ← OSTR.CreateTable[CompareNCHs];
job.nchCount ← 0;
job.previewing ← TRUE;
FOR lora:
LORA ← ec, lora.rest
WHILE lora #
NIL
DO
WriteBinding:
PROC [b: Binding] =
BEGIN
WITH b.value
SELECT
FROM
sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.initial];
a: Application => WriteCellInstance[job, b.name, a];
r: ROPE => WriteWhateverInstance[job, b.name, r, b.initial];
ENDCASE => ERROR;
END;
WITH lora.first
SELECT
FROM
cs: CedarSource => NULL;
bl: BindingList => FOR bl ← bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
b: Binding => WriteBinding[b];
ENDCASE => ERROR;
ENDLOOP;
job.previewing ← FALSE;
FOR lora:
LORA ← ec, lora.rest
WHILE lora #
NIL
DO
WriteBinding:
PROC [b: Binding] =
BEGIN
WITH b.value
SELECT
FROM
sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.initial];
a: Application => WriteCellInstance[job, b.name, a];
r: ROPE => WriteWhateverInstance[job, b.name, r, b.initial];
ENDCASE => ERROR;
END;
WITH lora.first
SELECT
FROM
cs: CedarSource => InjectCedar[job, cs];
bl: BindingList => FOR bl ← bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
b: Binding => WriteBinding[b];
ENDCASE => ERROR;
ENDLOOP;
IF cellDef.initDataGiven
THEN
BEGIN
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
job.to.PutRope["};"]; TS.ChangeDepth[job.to, -1];
END;
InjectCedar:
PROC [job: Job, cs: CedarSource] =
BEGIN
where: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutRope["--explicitly requested CEDAR:"];
TS.EndNode[job.to];
where ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
TS.CopyChildren[from: cs.parent, to: where];
END;
NodeCreateHack: TYPE = REF NodeCreateHackRep;
NodeCreateHackRep:
TYPE =
RECORD [
key, name: ROPE,
callCount: CARDINAL];
CompareNCHs:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] =
BEGIN
Key:
PROC [r:
REF
ANY]
RETURNS [k:
ROPE] = {k ←
WITH r
SELECT
FROM
x: ROPE => x,
nch: NodeCreateHack => nch.key,
ENDCASE => ERROR};
c ← Key[r1].Compare[Key[r2]];
END;
WriteNodeInstance:
PROC [job: Job, name:
ROPE, st: NodeType, initialValue:
ROPE] =
BEGIN
IF job.previewing
THEN
BEGIN
roseType: Mesa ← st.procs.MesaDescription[st];
key: ROPE ← IO.PutFR["\"%q\" ← %g", IO.rope[roseType.mesa], IO.refAny[initialValue]];
nch: NodeCreateHack ← NARROW[job.nodeCreateHacks.Lookup[key]];
IF nch =
NIL
THEN job.nodeCreateHacks.Insert[nch ←
NEW [NodeCreateHackRep ← [
key: key,
name: NIL,
callCount: 0]]];
nch.callCount ← nch.callCount + 1;
END
ELSE
BEGIN
roseType: Mesa ← st.procs.MesaDescription[st];
key: ROPE ← IO.PutFR["\"%q\" ← %g", IO.rope[roseType.mesa], IO.refAny[initialValue]];
nch: NodeCreateHack ← NARROW[job.nodeCreateHacks.Lookup[key]];
ne: nodeEntry ← NEW [SymbolTableEntryRep[node] ← [name: name, value: node[st]]];
IF job.things.Lookup[name] = NIL THEN job.things.Insert[ne]
ELSE Whimper[job, "node %g multiply defined", IO.rope[name]];
AddMesa[job, roseType];
IF nch.callCount >= nodeCreateHackThreshold
THEN
BEGIN
IF nch.name =
NIL
THEN
BEGIN
nch.name ← IO.PutFR["NodeCreateHack%g", IO.card[job.nchCount ← job.nchCount + 1]];
job.to.PutF["%g: PROC [name: ROPE] RETURNS [node: Node] = {node ← RoseCreate.CreateNode[within: thisCell, name: name, type: %g", IO.rope[nch.name], IO.rope[roseType.mesa]];
IF initialValue # NIL THEN job.to.PutF[", initialValue: \"%q\"", IO.rope[initialValue]];
job.to.PutRope["]};"]; TS.EndNode[job.to];
END;
job.to.PutF["%g: Node ← %g[\"%g\"", IO.rope[name], IO.rope[nch.name], IO.rope[name]];
END
ELSE
BEGIN
job.to.PutF["%g: Node ← RoseCreate.CreateNode[within: thisCell, name: \"%g\", type: %g", IO.rope[name], IO.rope[name], IO.rope[roseType.mesa]];
IF initialValue # NIL THEN job.to.PutF[", initialValue: \"%q\"", IO.rope[initialValue]];
END;
job.to.PutRope["];"];
TS.EndNode[job.to];
END;
END;
nodeCreateHackThreshold: CARDINAL ← 3;
UseSignalType:
PROC [job: Job, st: NodeType] =
BEGIN
c: REF ANY ← st;
ce: REF ANY ← NARROW[job.used.Lookup[c]];
IF ce =
NIL
THEN
BEGIN
m: Mesa ← IF st.procs.MesaDefinition # NIL THEN st.procs.MesaDefinition[st] ELSE [NIL];
job.used.Insert[c];
IF m # [
NIL]
THEN
{job.typeStream.PutRope[m.mesa];
job.typeStream.PutRope[";"];
TS.EndNode[job.typeStream];
AddMesa[job, m];};
END;
END;
WriteCellInstance:
PROC [job: Job, instanceName:
ROPE, a: Application] =
BEGIN
ste: SymbolTableEntry ← NARROW[job.things.Lookup[a.fn]];
cd: CellDef;
definedIn: ROPE;
fromSelf: BOOLEAN;
IF job.previewing THEN RETURN;
IF ste =
NIL
THEN
BEGIN
[] ← Complain[job, "Cell Class %g undefined!", IO.rope[a.fn]];
cd ← NEW [CellDefRep ← []]; definedIn ← NIL;
IF a.fn # NIL THEN AddCellClass[job, NEW [SymbolTableEntryRep[cellClass] ← [name: a.fn, value: cellClass[definedIn: definedIn, cd: cd]]]];
END
ELSE
WITH ste
SELECT
FROM
cce: ccEntry => {definedIn ← cce.definedIn; cd ← cce.cd};
ENDCASE =>
BEGIN
[] ← Complain[job, "Can't instantiate %g like a Cell Class", IO.refAny[ste]];
definedIn ← NIL;
cd ← NEW [CellDefRep ← []];
END;
fromSelf ← definedIn.Equal[job.rootName, FALSE];
job.to.PutF["[] ← RoseCreate.CreateCell[within: thisCell, instanceName: \"%g\", className: \"%g\", interfaceNodes: ", IO.rope[instanceName], IO.rope[a.fn]];
IF definedIn # NIL THEN TypeCheck[job, a.args, cd.interface, instanceName];
IF a.args #
NIL
THEN
BEGIN
job.to.PutRope["\""];
WITH a.args
SELECT
FROM
bl: BindingList => WriteBindingList[job.to, bl];
a: Args => WriteArgs[job.to, a];
ENDCASE => ERROR;
job.to.PutRope["\""];
END
ELSE job.to.PutRope["NIL"];
IF a.initData # NIL THEN job.to.PutF[", initData: %g", IO.rope[a.initData]]
ELSE
IF cd.initDataGiven
AND cd.initializerGiven
THEN
BEGIN
IF cd.defaultInitExprGiven
THEN
BEGIN
job.to.PutF[", initData: %g", IO.rope[cd.defaultInitExpr]];
END
ELSE Whimper[job, "%g must be given init data", IO.rope[instanceName]];
END;
job.to.PutRope["];"];
TS.EndNode[job.to];
IF definedIn # NIL AND NOT fromSelf THEN AddImport[job, definedIn];
END;
WriteWhateverInstance:
PROC [job: Job, name, class, initialValue:
ROPE] =
BEGIN
sti: SignalTypeInvocation ← InstantiateSignalType[job, class, NIL];
IF sti # NIL THEN WriteNodeInstance[job, name, sti.st, initialValue];
END;
WritePorts:
PROC [job: Job, name:
ROPE, count:
CARDINAL] =
BEGIN
TS.EndNode[job.to];
job.to.PutF["%gPorts: Ports ← NEW [PortsRep[%g]];", IO.rope[name], IO.card[count]];
TS.EndNode[job.to];
END;
WriteRegistration:
PROC [job: Job, name:
ROPE, cellDef: CellDef] =
BEGIN
evalGiven: BOOLEAN ← FALSE;
IF cellDef.interface.asList #
NIL
THEN
BEGIN
job.regStream.PutF["Create%gPorts[];", IO.rope[name]];
TS.EndNode[job.regStream];
END;
job.regStream.PutF["[] ← RoseCreate.RegisterCellClass[className: \"%g\",", IO.rope[name]];
TS.ChangeDepth[job.regStream, 1];
IF cellDef.expandGiven THEN job.regStream.PutF["expandProc: %gExpand,", IO.rope[name]] ELSE job.regStream.PutRope["expandProc: NIL,"];
TS.EndNode[job.regStream];
IF cellDef.interface.asList # NIL THEN job.regStream.PutF["ioCreator: Create%gIO, ", IO.rope[name]] ELSE job.regStream.PutRope["ioCreator: NIL, "];
IF cellDef.stateGiven OR cellDef.initializerGiven THEN job.regStream.PutF["initializer: Initialize%g,", IO.rope[name]] ELSE job.regStream.PutRope["initializer: NIL,"];
TS.EndNode[job.regStream];
job.regStream.PutRope["evals: ["];
FOR et: EvalType
IN EvalType
DO
IF cellDef.evalsGiven[et]
THEN {
IF evalGiven THEN job.regStream.PutRope[", "] ELSE evalGiven ← TRUE;
job.regStream.PutF["%g: %g%g", IO.rope[etNames[et]], IO.rope[name], IO.rope[etNames[et]]]};
ENDLOOP;
job.regStream.PutRope["],"];
TS.EndNode[job.regStream];
IF cellDef.bbTestGiven THEN job.regStream.PutF["blackBox: %gBBTest, ", IO.rope[name]] ELSE job.regStream.PutRope["blackBox: NIL, "];
IF cellDef.stTestGiven THEN job.regStream.PutF["stateToo: %gSTTest,", IO.rope[name]] ELSE job.regStream.PutRope["stateToo: NIL,"];
TS.EndNode[job.regStream];
job.regStream.PutF["ports: %gPorts,", IO.rope[name]];
TS.EndNode[job.regStream];
IF cellDef.interface.asList #
NIL
THEN job.regStream.PutF["drivePrototype: NEW [%gDrive]];", IO.rope[name]]
ELSE job.regStream.PutRope["drivePrototype: NIL];"];
TS.ChangeDepth[job.regStream, -1];
END;
etNames: ARRAY EvalType OF ROPE = ["ValsChanged", "InitQ", "PropQ", "InitUD", "PropUD", "FinalUD", "EvalSimple", "FindVicinity"];
WriteDeps:
PROC [job: Job] =
BEGIN
WriteLoad:
PROC [asAny:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
BEGIN
depName: ROPE ← NARROW[asAny];
cmFile.PutF["@%g.roseLoad\n", IO.rope[depName]];
stop ← FALSE;
END;
cmFile: IO.STREAM ← FS.StreamOpen[fileName: job.rootName.Concat[".roseLoad"], accessOptions: create];
job.libbed.EnumerateIncreasing[WriteLoad];
cmFile.PutF["Run %g\n", IO.rope[job.rootName]];
cmFile.Close[];
END;
END.