RoseTranslateRandoms.Mesa
Last Edited by: Spreitzer, September 19, 1985 8:36:50 pm PDT
DIRECTORY AMBridge, AMTypes, Ascii, Asserting, AssertingIO, Atom, Basics, BasicTime, BitTwiddling, Commander, CommandTool, Convert, FS, IO, IOClasses, PrintTV, PutGet, RedBlackTree, Rope, RoseTranslateTypes, RoseTranslateInsides, RoseTypes, RuntimeError, SignalTypeRegistration, StructuredStreams, TEditMesaOps, TextNode, TiogaFileOps, TiogaOps, TiogaStreams, UndoEvent, UnparserBuffer, UserCredentials, ViewerClasses, ViewerIO, ViewerOps, ViewerTools;
RoseTranslateRandoms:
CEDAR
PROGRAM
IMPORTS AMBridge, Ascii, Asserting, AssertingIO, BasicTime, Commander, CommandTool, Convert, FS, IO, IOClasses, PrintTV, PutGet, RedBlackTree, Rope, RoseTranslateInsides, RoseTypes, RuntimeError, SignalTypeRegistration, SS: StructuredStreams, TEditMesaOps, TextNode, TFO: TiogaFileOps, TS: TiogaStreams, UnparserBuffer, UserCredentials, ViewerIO
EXPORTS RoseTranslateTypes, RoseTranslateInsides =
BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;
TypeConstructionError: PUBLIC ERROR [msg: ROPE] = CODE;
Circularity: PUBLIC ERROR = CODE;
viewerLog: PUBLIC IO.STREAM ← ViewerIO.CreateViewerStreams["RoseTranslate.Log"].out;
translateCommandShort: ROPE = "RoseTranslate";
translateCommandName: PUBLIC ROPE;
versionString: PUBLIC ROPE;
commandDate: PUBLIC BasicTime.GMT;
omitted: PUBLIC REF ANY ← NEW [ROPE ← "omitted"];
error: PUBLIC REF ANY ← NEW [ROPE ← "error"];
noDefault: PUBLIC REF ANY ← NEW [ROPE ← "no default"];
DriveLevelsPerWord: NAT = 480/SIZE[PACKED ARRAY [0 .. 480) OF RoseTypes.DriveLevel];
partsAssertionsExtension: ROPE ← ".partsAssertions";
AddOpen:
PUBLIC
PROC [job: Job, name:
ROPE] =
BEGIN
IF job.opened.Lookup[name] # NIL THEN RETURN;
job.opened.Insert[name, name];
IF NOT job.emptyOpen THEN job.openStream.PutRope[", "];
job.openStream.PutRope[name]; job.emptyOpen ← FALSE;
AddDirectory[job, name];
END;
AddImport:
PUBLIC
PROC [job: Job, name:
ROPE] =
BEGIN
IF job.imports.Lookup[name] # NIL THEN RETURN;
job.imports.Insert[name, name];
IF NOT job.emptyImports THEN job.importsStream.PutRope[", "];
job.importsStream.PutRope[name]; job.emptyImports ← FALSE;
AddDirectory[job, name];
END;
AddExport:
PUBLIC
PROC [job: Job, name:
ROPE] =
BEGIN
IF job.exports.Lookup[name] # NIL THEN RETURN;
job.exports.Insert[name, name];
IF NOT job.emptyExports THEN job.exportsStream.PutRope[", "];
job.exportsStream.PutRope[name]; job.emptyExports ← FALSE;
AddDirectory[job, name];
END;
AddDirectory:
PUBLIC
PROC [job: Job, name:
ROPE] =
BEGIN
IF job.directory.Lookup[name] # NIL THEN RETURN;
job.directory.Insert[name, name];
job.directoryStream.PutRope[", "];
job.directoryStream.PutRope[name];
END;
AddMesa:
PUBLIC
PROC [job: Job, m: Mesa] = {rl: RopeList;
FOR rl ← m.directory, rl.rest WHILE rl # NIL DO AddDirectory[job, rl.first] ENDLOOP;
FOR rl ← m.imports, rl.rest WHILE rl # NIL DO AddImport[job, rl.first] ENDLOOP;
};
GetParm:
PUBLIC
PROC [n: [1..
LAST[
INTEGER]], name:
ROPE, parms:
REF
ANY, default:
REF
ANY ← noDefault]
RETURNS [it:
REF
ANY] =
BEGIN
IF parms =
NIL
THEN
BEGIN
IF default # noDefault THEN it ← default
ELSE ERROR TypeConstructionError[IO.PutFR["parm %g not found", IO.rope[name]]];
END
ELSE
WITH parms
SELECT
FROM
bl: BindingList =>
BEGIN
FOR bl ← bl, bl.rest
WHILE bl #
NIL
DO
IF bl.first.name.Equal[name, FALSE] THEN RETURN [bl.first.value];
ENDLOOP;
IF default # noDefault THEN it ← default
ELSE ERROR TypeConstructionError[IO.PutFR["parm %g not found", IO.rope[name]]];
END;
a: Args =>
BEGIN
i: INT ← n;
FOR l:
LIST
OF Arg ← a.args, l.rest
WHILE l #
NIL
DO
IF i = 1 THEN RETURN [l.first];
i ← i - 1;
ENDLOOP;
IF default # noDefault THEN it ← default
ELSE ERROR TypeConstructionError[IO.PutFR["no %g'th parm", IO.int[i]]];
END;
ENDCASE => ERROR;
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.Close[];
job.exportsStream.Close[];
job.openStream.PutRope[";"];
job.openStream.Close[];
job.regStream.PutRope["END;"];
job.regStream.Close[];
job.typeStream.Close[];
job.partsAssertionsStream.Close[];
TSNodeBreak[job.to];
job.to.PutRope["RegisterCells[];"];
TSNodeBreak[job.to];
TSNodeBreak[job.to];
TSNodeBreak[job.intfStream];
job.bothStream.PutRope["END."];
job.bothStream.Close[];
IF job.errCount < 1
THEN
TRUSTED
BEGIN
destName: ROPE;
DoMesaFormatting[job.outRoot];
TFO.Store[job.outRoot, destName ← job.rootName.Concat["Impl.Mesa"]];
DoMesaFormatting[job.intfRoot];
TFO.Store[job.intfRoot, destName ← job.rootName.Concat[".Mesa"]];
TFO.Store[job.symbolsRoot, job.rootName.Concat[".RoseSymbols"]];
WriteDeps[job];
END;
END;
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 %gImpl\n", IO.rope[job.rootName]];
cmFile.Close[];
END;
TranslateCmd: Commander.CommandProc
--PROC [cmd: Handle] RETURNS [result: REF ← NIL, msg: Rope.ROPE ← NIL]-- =
BEGIN
commandLineStream: IO.STREAM ← IO.RIS[cmd.commandLine];
[] ← commandLineStream.SkipWhitespace[flushComments: FALSE];
WHILE
NOT commandLineStream.EndOf[]
DO
name: ROPE ← commandLineStream.GetTokenRope[IO.IDProc].token;
errs: CARDINAL ← 1;
errs ← Translate[cmd, name, NIL, TranslateJob !Circularity => CONTINUE];
IF errs > 0 THEN RETURN [$Failure];
[] ← commandLineStream.SkipWhitespace[flushComments: FALSE];
ENDLOOP;
END;
Translate:
PUBLIC
PROC [exec: Commander.Handle, rootName:
ROPE, pathIn:
LIST
OF
ROPE, type: JobType]
RETURNS [errCount:
CARDINAL] =
TRUSTED
BEGIN
inRoot: TextNode.Ref ← NIL;
job: Job ←
NEW [JobRep ← [
exec: exec,
rootName: rootName,
path: CONS[rootName, pathIn],
outRoot: TFO.CreateRoot[],
intfRoot: TFO.CreateRoot[],
symbolsRoot: TFO.CreateRoot[],
directory: RedBlackTree.Create[GetIDKey, CompareRopes],
imports: RedBlackTree.Create[GetIDKey, CompareRopes],
exports: RedBlackTree.Create[GetIDKey, CompareRopes],
opened: RedBlackTree.Create[GetIDKey, CompareRopes],
libbed: RedBlackTree.Create[GetIDKey, CompareRopes],
things: RedBlackTree.Create[SignalTypeRegistration.GetSymbolTableEntryKey, SignalTypeRegistration.CompareSymbolTableEntries],
used: RedBlackTree.Create[GetIDKey, CompareRefAnies],
type: type,
start: BasicTime.GetClockPulses[]]];
logFile: IO.STREAM;
sourceName, logName: ROPE;
ubh: UnparserBuffer.Handle;
inRoot ← PutGet.FromFile[sourceName ← rootName.Concat[".Rose"] !
FS.Error =>
BEGIN
viewerLog.PutF["\nOpen failed on %g\n", IO.rope[sourceName]];
inRoot ← NIL;
CONTINUE;
END];
IF inRoot = NIL THEN RETURN [1];
job.from ← TS.CreateInput[inRoot];
job.to ← TS.CreateOutput[to: job.outRoot, defaultFormat: "code"];
job.intfStream ← TS.CreateOutput[to: job.intfRoot, defaultFormat: "code"];
job.bothStream ← IOClasses.CreateDribbleOutputStream[job.to, job.intfStream];
job.symbolsStream ← TS.CreateOutput[job.symbolsRoot];
ubh ← UnparserBuffer.NewHandle[[stream[ FS.StreamOpen[rootName.Cat[partsAssertionsExtension], create] ]]];
ubh.margin ← 55;
job.partsAssertionsStream ← SS.Create[ubh];
logFile ← FS.StreamOpen[fileName: logName ← rootName.Concat[".log"], accessOptions: create];
job.log ← IOClasses.CreateDribbleOutputStream[logFile, viewerLog];
Open[job, sourceName];
job.parseTree ← ParseExpression[job];
Close[job];
logFile.Close[];
viewerLog.PutRope["Done.\n\n"];
errCount ← job.errCount;
END;
Open:
PROC [job: Job, sourceName:
ROPE] =
BEGIN
WriteHeader:
PROC [dest:
IO.
STREAM, which: MesaFlavor]
RETURNS [directoryStream:
IO.
STREAM] = {
dest.PutF["--%g%g.Mesa", IO.rope[job.rootName], IO.rope[SELECT which FROM impl => "Impl", intf => "", ENDCASE => ERROR]];
TSNodeBreak[dest];
dest.PutF["--created by RoseTranslate %g", IO.rope[versionString]];
TSNodeBreak[dest];
dest.PutF["--created from %g of %g", IO.rope[sourceName], IO.time[FS.FileInfo[sourceName].created]];
TSNodeBreak[dest];
dest.PutF["--created for %g", IO.rope[UserCredentials.Get[].name]];
TSNodeBreak[dest];
dest.PutF["--created at %g", IO.time[]];
TSNodeBreak[dest];
TSNodeBreak[dest];
TSNodeBreak[dest];
dest.PutRope["DIRECTORY"];
directoryStream ← TS.CreateOutput[to: TS.CurOutNode[dest], defaultFormat: "code"];
TSNodeBreak[dest];
TSNodeBreak[dest];
directoryStream.PutRope["RoseTypes"];
SELECT which
FROM
impl => directoryStream.PutF[", %g", IO.rope[job.rootName]];
intf => NULL;
ENDCASE => ERROR;
};
intfDirStream, implDirStream: IO.STREAM;
goddamCompiler: ROPE = "RoseTypes";
job.log.PutF["\nTranslating %g into %g.Mesa and %gImpl.Mesa, log on %g.Log\n", IO.rope[sourceName], IO.rope[job.rootName], IO.rope[job.rootName], IO.rope[job.rootName]];
implDirStream ← WriteHeader[job.to, impl];
job.to.PutF["%l%gImpl%l: CEDAR PROGRAM", IO.rope["lb"], IO.rope[job.rootName], IO.rope["LB"]];
job.importsStream ← TS.CreateOutput[to: TS.CurOutNode[job.to], defaultFormat: "code"];
job.importsStream.PutRope["IMPORTS "];
job.exportsStream ← TS.CreateOutput[to: TS.CurOutNode[job.to], defaultFormat: "code"];
job.exportsStream.PutRope["EXPORTS "];
TSNodeBreak[job.to];
TSNodeBreak[job.to];
job.to.PutRope["= BEGIN OPEN"];
job.openStream ← TS.CreateOutput[to: TS.CurOutNode[job.to], defaultFormat: "code"];
TSNodeBreak[job.to];
TSNodeBreak[job.to];
job.to.PutRope["--Signal Type decls"];
job.typeStream ← TS.CreateOutput[to: TS.CurOutNode[job.to], defaultFormat: "code"];
TSNodeBreak[job.to];
TSNodeBreak[job.to];
job.to.PutRope["RegisterCells: PROC ="];
job.regStream ← TS.CreateOutput[to: TS.CurOutNode[job.to], defaultFormat: "code"];
TSNodeBreak[job.to];
job.regStream.PutRope["BEGIN"]; TSNodeBreak[job.regStream];
job.to.PutF["otherss: SymbolTable ← RoseCreate.GetOtherss[%g];", IO.refAny[job.rootName.Cat[partsAssertionsExtension]]];
TSNodeBreak[job.to];
intfDirStream ← WriteHeader[job.intfStream, intf];
job.intfStream.PutF["%l%g%l: CEDAR DEFINITIONS", IO.rope["xb"], IO.rope[job.rootName], IO.rope["XB"]];
TSNodeBreak[job.intfStream];
TSNodeBreak[job.intfStream];
job.intfStream.PutRope["= BEGIN"];
TSNodeBreak[job.intfStream];
TSNodeBreak[job.intfStream];
job.directoryStream ← IOClasses.CreateDribbleOutputStream[intfDirStream, implDirStream];
job.directory.Insert[goddamCompiler, goddamCompiler];
job.directory.Insert[job.rootName, job.rootName];
AddOpen[job, "RoseTypes"];
AddImport[job, "RoseCreate"];
AddExport[job, job.rootName];
AddOpen[job, job.rootName];
END;
TypeCheck:
PUBLIC
PROC [job: Job, defName:
ROPE, args:
REF
ANY, interface: DigestedInterface, instanceName:
ROPE] =
BEGIN
cName: ROPE ← defName.Cat[".", instanceName];
Check:
PROC [sr: SourceRange, keyword:
ROPE, match: InterfaceElt, value:
REF
ANY] =
BEGIN
Descr:
PROC
RETURNS [r:
ROPE] = {
r ←
IF keyword =
NIL
THEN IO.PutFR["%g#%g", IO.rope[cName], IO.card[index]]
ELSE IO.PutFR["%g.%g", IO.rope[cName], IO.rope[keyword]]};
ste: SymbolTableEntry;
valName: ROPE;
valNode: nodeEntry;
IF match =
NIL
AND keyword #
NIL
THEN
BEGIN
match ← NARROW[interface.asTable.Lookup[keyword]];
IF match = NIL THEN Whimper[sr, job, "%g not a valid port on cell %g", IO.rope[keyword], IO.rope[cName]];
END;
WITH value
SELECT
FROM
id: ID => {valName ← id.rope; IF sr = nullSR THEN sr ← id.sr};
ENDCASE => {Whimper[sr, job, "%g should be bound to an ID, not %g", IO.rope[Descr[]], IO.refAny[value]]; RETURN};
ste ← NARROW[job.things.Lookup[valName]];
WITH ste
SELECT
FROM
ne: nodeEntry => valNode ← ne;
ENDCASE => {Whimper[sr, job, "%g was bound to %g, which should have been a node, rather than %g", IO.rope[Descr[]], IO.rope[valName], IO.refAny[ste]]; RETURN};
IF match = NIL THEN RETURN;
IF match.spare THEN Whimper[sr, job, "%g.%g specified twice", IO.rope[cName], IO.rope[match.name]]
ELSE match.spare ← TRUE;
IF
NOT RoseTypes.Conforming[match.sti.st, valNode.nodeType]
THEN
BEGIN
Whimper[sr, job,
"Type mismatch for %g: got %g when expecting %g",
IO.rope[Descr[]],
IO.rope[valNode.nodeType.procs.UserDescription[valNode.nodeType]],
IO.rope[match.sti.st.procs.UserDescription[match.sti.st]]];
END;
END;
toMatch: InterfaceEltList ← interface.asList;
index: CARDINAL ← 0;
FOR iel: InterfaceEltList ← interface.asList, iel.rest
WHILE iel #
NIL
DO
iel.first.spare ← FALSE;
ENDLOOP;
WITH args
SELECT
FROM
bl: BindingList =>
FOR bl ← bl, bl.rest
WHILE bl #
NIL
DO
index ← index + 1;
Check[bl.first.sr, bl.first.name, NIL, bl.first.value];
ENDLOOP;
a: Args =>
BEGIN
l: LIST OF Arg;
FOR l ← a.args, l.rest
WHILE l #
NIL
AND toMatch #
NIL
DO
index ← index + 1;
Check[nullSR, NIL, toMatch.first, l.first];
toMatch ← toMatch.rest;
ENDLOOP;
IF l # NIL --OR toMatch # NIL-- THEN Whimper[a.sr, job, "too many parameters to %g", IO.rope[cName]];
END;
ENDCASE => ERROR;
index ← 0;
FOR iel: InterfaceEltList ← interface.asList, iel.rest
WHILE iel #
NIL
DO
index ← index + 1;
IF
NOT iel.first.spare
THEN
old: Whimper[job, "%g.%g never specified", IO.rope[cName], IO.rope[iel.first.name]];--
--new:-- Check[nullSR, iel.first.name, iel.first, NEW [IDRep ← [nullSR, iel.first.name]] ];
ENDLOOP;
END;
DoMesaFormatting:
PROC [tfor: TiogaFileOps.Ref] =
BEGIN
tnr: TextNode.Ref;
TRUSTED {tnr ← LOOPHOLE[tfor]};
[] ← TEditMesaOps.SetSpanMesaLooks[
span: [[tnr, 0], TextNode.LastLocWithin[tnr]],
event: NIL
];
END;
Complain:
PUBLIC
PROC [sr: SourceRange, context:
REF
ANY, complaint:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]]]
RETURNS [reduced:
REF
ANY] =
BEGIN
job: Job ← NARROW[context];
IF sr # nullSR THEN job.log.PutF["At [%g..%g]: ", IO.int[sr.first], IO.int[sr.last]]
ELSE IF NOT job.from.EndOf[] THEN job.log.PutF["Somewhere before %g: ", IO.int[job.from.GetIndex[]]];
job.log.PutF[complaint.Concat["\n"], v1, v2, v3, v4, v5];
job.errCount ← job.errCount + 1;
reduced ← error;
END;
Whimper:
PUBLIC
PROC [sr: SourceRange, context:
REF
ANY, complaint:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]]] =
BEGIN
job: Job ← NARROW[context];
IF sr # nullSR THEN job.log.PutF["At [%g..%g]: ", IO.int[sr.first], IO.int[sr.last]]
ELSE IF NOT job.from.EndOf[] THEN job.log.PutF["Somewhere before %g: ", IO.int[job.from.GetIndex[]]];
job.log.PutF[complaint.Concat["\n"], v1, v2, v3, v4, v5];
job.warnCount ← job.warnCount + 1;
END;
GetIDKey:
PROC [data:
REF
ANY]
RETURNS [key:
REF
ANY]
--RedBlackTree.GetKey-- =
{key ← data};
CompareRopes:
PROC [k, data:
REF
ANY]
RETURNS [Basics.Comparison]
--RedBlackTree.Compare-- =
BEGIN
k1: ROPE ← NARROW[k];
k2: ROPE ← NARROW[data];
RETURN [k1.Compare[k2]];
END;
CompareRefAnies:
PROC [k, data:
REF
ANY]
RETURNS [Basics.Comparison]
--RedBlackTree.Compare-- =
BEGIN
c1: LONG CARDINAL ← LOOPHOLE[k];
c2: LONG CARDINAL ← LOOPHOLE[data];
RETURN [IF c1 < c2 THEN less ELSE IF c1 > c2 THEN greater ELSE equal];
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]]};
uppers: ARRAY [1..15] OF CARDINAL ← [1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767];
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.MesaRepAux # NIL THEN st.procs.MesaRepAux[st] ELSE [NIL];
job.used.Insert[c, c];
IF m # [
NIL]
THEN
{job.typeStream.PutRope[m.mesa];
job.typeStream.PutRope[";"];
TSNodeBreak[job.typeStream];
AddMesa[job, m];};
END;
END;
WriteRegistration:
PUBLIC
PROC [to:
IO.
STREAM, result, name:
ROPE, cellDef: CellDef] =
BEGIN
evalGiven: BOOLEAN ← FALSE;
to.PutRope[result];
to.PutRope[" ← RoseCreate.RegisterCellType[name: "];
IF cellDef.nameIsLiteral
THEN to.PutF["\"%g\",", IO.rope[cellDef.literalName]]
ELSE to.PutF["%gName[%g],", IO.rope[name], IO.rope[IF cellDef.forFn # NIL THEN "args" ELSE ""]];
TS.ChangeDepth[to, 1];
IF cellDef.expandCode # NIL THEN to.PutF["expandProc: %gExpand,", IO.rope[name]] ELSE to.PutRope["expandProc: NIL,"];
TSNodeBreak[to];
IF AuxKnown[name, cellDef, SwitchIO, Val] AND AuxKnown[name, cellDef, SimpleIO, Val] THEN to.PutF["ioCreator: Create%gIO, ", IO.rope[name]];
IF AuxKnown[name, cellDef, Drive, Val] THEN to.PutF["driveCreator: Create%gDrive, ", IO.rope[name]];
IF AuxKnown[name, cellDef, State, Val] OR cellDef.initializerSource # NIL THEN to.PutF["initializer: Initialize%g,", IO.rope[name]];
TSNodeBreak[to];
to.PutRope["evals: ["];
FOR et: EvalType
IN EvalType
DO
IF cellDef.evals[et] #
NIL
THEN {
IF evalGiven THEN to.PutRope[", "] ELSE evalGiven ← TRUE;
to.PutF["%g: %g%g", IO.rope[etNames[et]], IO.rope[name], IO.rope[etNames[et]]]};
ENDLOOP;
to.PutRope["],"];
TSNodeBreak[to];
to.PutRope["tests: LIST["];
FOR tl: TestList ← cellDef.tests, tl.rest
WHILE tl #
NIL
DO
to.PutF[
"[name: %g, proc: %g, stateToo: %g]",
IO.refAny[tl.first.name],
IO.rope[TestName[name, tl.first, cellDef]],
IO.bool[tl.first.stateToo]];
IF tl.rest # NIL THEN to.PutRope[", "];
ENDLOOP;
to.PutRope["],"];
TSNodeBreak[to];
to.PutRope["ports: "];
IF cellDef.interfaceLiteral #
NIL
AND cellDef.interfaceLiteral.asList =
NIL
THEN to.PutRope["NEW [PortsRep[0]]"]
ELSE to.PutF["Create%gPorts[%g]", IO.rope[name], IO.rope[IF cellDef.forFn # NIL THEN "args" ELSE ""]];
TSNodeBreak[to];
IF cellDef.forFn #
NIL
THEN {
to.PutRope[","];
TSNodeBreak[to];
to.PutF["typeData: NEW [%gArgs ← args]", IO.rope[name]]};
IF cellDef.initCTPropsSource #
NIL
OR (cellDef.assertions #
NIL)
THEN {
to.PutRope[","];
TSNodeBreak[to];
to.PutF["other: Initial%gProps[%g]", IO.rope[name], IO.rope[IF cellDef.forFn # NIL THEN "args" ELSE ""]]};
to.PutRope["];"];
TS.ChangeDepth[to, -1];
END;
etNames: PUBLIC ARRAY EvalType OF ROPE ← ["ValsChanged", "InitQ", "PropQ", "InitUD", "PropUD", "FinalUD", "EvalSimple", "EnumerateVicinity"];
auxClassNames: PUBLIC ARRAY AuxClass OF ROPE ← [SwitchIO: "SwitchIO", SimpleIO: "SimpleIO", State: "State", Drive: "Drive"];
auxValNames: PUBLIC ARRAY AuxVal OF ROPE ← [Ref: "Ref", Rec: "Rec", Val: "Val"];
WriteInterfaceDecls:
PUBLIC
PROC [job: Job, name, switchIORefTypeName, simpleIORefTypeName:
ROPE, cellDef: CellDef, function:
BOOL]
RETURNS [iCount:
CARDINAL] =
BEGIN
di: DigestedInterface ← cellDef.interfaceLiteral;
interface: InterfaceEltList ← di.asList;
toSwitchIO, toSimpleIO, toPortType, toPortFile, portConsts: IO.STREAM;
firstSimpleBit, firstSwitchBit: CARDINAL ← 0;
hasASwitchPort, someSimple, someSwitch: BOOL ← FALSE;
dest: TFO.Ref;
portFileName: ROPE ← job.rootName.Cat[".", name, ".rosePorts"];
FOR iel: InterfaceEltList ← interface, iel.rest
WHILE iel #
NIL
DO
IF NOT iel.first.sti.st.simple THEN {hasASwitchPort ← TRUE; EXIT};
ENDLOOP;
iCount ← 0;
toPortFile ← SS.Create[ UnparserBuffer.NewHandle[ [stream[ FS.StreamOpen[portFileName, create] ]] ] ];
TSNodeBreak[job.to];
job.to.PutF["Create%gPorts: PROC ", IO.rope[name]];
IF function THEN job.to.PutF["[args: %gArgs] ", IO.rope[name]];
job.to.PutF["RETURNS [ports: Ports] = {ports ← RoseCreate.PortsFromFile[\"%q\"]};", IO.rope[portFileName]];
TSNodeBreak[job.to];
TSNodeBreak[job.to];
toPortFile.PutF["%g", IO.int[di.asTable.Size[]]];
job.to.PutF["%g: TYPE = REF %gSwitchIORec;", IO.rope[switchIORefTypeName], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%gSwitchIORec: TYPE = RECORD [", IO.rope[name]];
TSNodeBreak[job.to];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
toSwitchIO ← TS.CreateOutput[to: dest, defaultFormat: "code"];
job.to.PutF["%g: TYPE = REF %gSimpleIORec;", IO.rope[simpleIORefTypeName], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%gSimpleIORec: TYPE = RECORD [", IO.rope[name]];
TSNodeBreak[job.to];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
toSimpleIO ← TS.CreateOutput[to: dest, defaultFormat: "code"];
IF hasASwitchPort
AND cellDef.evals[EnumerateVicinity] #
NIL
THEN {
job.to.PutRope["-- port indices:"];
TSNodeBreak[job.to];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
portConsts ← TS.CreateOutput[to: dest, defaultFormat: "code"];
};
job.to.PutF["%gDriveRef: TYPE = REF %gDriveRec;", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%gDriveRec: TYPE = RECORD [driveRecordInitialPadding: DriveTagType, drive: PACKED ARRAY %gPort OF DriveLevel];", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%gPort: TYPE = {", IO.rope[name]];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
toPortType ← TS.CreateOutput[to: dest, defaultFormat: "code"];
FOR interface ← interface, interface.rest
WHILE interface #
NIL
DO
ie: InterfaceElt ← interface.first;
iename: ROPE ← ie.name;
simpleBitWidth, switchBitWidth: CARDINAL ← 0;
mesaType: Mesa;
simpleType, switchType: NodeType;
xPhobic: BOOL ← TRUE;
instructionsSimple: BOOL ← TRUE;
portTypeStream: IO.STREAM ← IO.ROS[];
otherAssertions: Asserting.Assertions ← NIL;
toPortFile.PutRope["\n "];
[simpleType, switchType] ← RoseTypes.BothTypes[ie.sti.st];
IF simpleType #
NIL
THEN {
padBits: NAT ← 0;
UseSignalType[job, simpleType];
simpleBitWidth ← simpleType.procs.Bits[simpleType].container;
mesaType ← simpleType.procs.MesaRepresentation[simpleType];
AddMesa[job, mesaType];
[firstSimpleBit, padBits] ← Layout[firstSimpleBit, simpleBitWidth];
IF someSimple THEN toSimpleIO.PutRope[","] ELSE someSimple ← TRUE;
IF padBits # 0
THEN {
toSimpleIO.PutF[
"fill%g: [0 .. %g],",
IO.int[iCount],
IO.int[BitTwiddling.oneLessThanTwoToThe[padBits]]];
TSNodeBreak[toSimpleIO];
};
toSimpleIO.PutF["%g: %g", IO.rope[iename], IO.rope[mesaType.mesa]];
TSNodeBreak[toSimpleIO];
toPortFile.PutF["%g %g ", IO.card[firstSimpleBit], IO.card[simpleBitWidth]];
}
ELSE toPortFile.PutRope["65535 65535 "];
IF switchType #
NIL
THEN {
padBits: NAT ← 0;
UseSignalType[job, switchType];
switchBitWidth ← switchType.procs.Bits[switchType].container;
mesaType ← switchType.procs.MesaRepresentation[switchType];
AddMesa[job, mesaType];
[firstSwitchBit, padBits] ← Layout[firstSwitchBit, switchBitWidth];
IF someSwitch THEN toSwitchIO.PutRope[","] ELSE someSwitch ← TRUE;
IF padBits # 0
THEN {
toSwitchIO.PutF[
"fill%g: [0 .. %g],",
IO.int[iCount],
IO.int[BitTwiddling.oneLessThanTwoToThe[padBits]]];
TSNodeBreak[toSwitchIO];
};
toSwitchIO.PutF["%g: %g", IO.rope[iename], IO.rope[mesaType.mesa]];
TSNodeBreak[toSwitchIO];
toPortFile.PutF["%g %g ", IO.card[firstSwitchBit], IO.card[switchBitWidth]];
}
ELSE toPortFile.PutRope["65535 65535 "];
toPortFile.PutF["%g ", IO.rope[Convert.RopeFromRope[iename]]];
WriteInvocation[portTypeStream, ie.sti.invocation];
toPortFile.PutF["\"%q\" %g ",
IO.rope[IO.RopeFromROS[portTypeStream]],
IO.card[(IF ie.input THEN 1 ELSE 0) + (IF ie.output THEN 2 ELSE 0) + (IF xPhobic THEN 4 ELSE 0) + (IF instructionsSimple THEN 8 ELSE 0)]];
FOR ll: Asserting.Assertions ← ie.assertions, ll.rest
WHILE ll #
NIL
DO
key: ATOM ← NARROW[Asserting.RelnOf[ll.first]];
SELECT key
FROM
$XPhobic => xPhobic ← TRUE;
$XPhillic => xPhobic ← FALSE;
$SimpleInstructions => instructionsSimple ← TRUE;
$SwitchInstructions => instructionsSimple ← FALSE;
$Special, $General => Whimper[ie.sr, job, "Found old assertion (Special or General)"];
ENDCASE => otherAssertions ← CONS[ll.first, otherAssertions];
ENDLOOP;
AssertingIO.Write[to: toPortFile, assertions: otherAssertions];
IF iCount > 0 THEN toPortType.PutRope[", "];
toPortType.PutRope[iename];
IF (
NOT ie.sti.st.simple)
AND (cellDef.evals[EnumerateVicinity] #
NIL)
THEN {
portConsts.PutF["%g%gPortIndex: CARDINAL = %g;", IO.rope[name], IO.rope[InitialCap[iename]], IO.card[iCount]];
TSNodeBreak[portConsts]};
firstSimpleBit ← firstSimpleBit + simpleBitWidth;
firstSwitchBit ← firstSwitchBit + switchBitWidth;
iCount ← iCount + 1;
ENDLOOP;
toSimpleIO.PutRope["];"]; toSimpleIO.Close[];
toSwitchIO.PutRope["];"]; toSwitchIO.Close[];
FOR n:
NAT ← iCount, n+1
WHILE (n
MOD DriveLevelsPerWord) # 0
DO
toPortType.PutF[", %gPortTypePad%g", IO.rope[name], IO.int[n]];
ENDLOOP;
toPortType.PutRope["};"]; toPortType.Close[];
SS.CloseThrough[toPortFile];
END;
bpw: NAT = Basics.bitsPerWord;
Layout:
PROC [firstAvail, width:
NAT]
RETURNS [firstUsed, padBits:
NAT] = {
rem: NAT ← (firstAvail+width) MOD bpw;
IF firstAvail MOD bpw # 0 THEN ERROR;
padBits ← IF rem # 0 THEN bpw-rem ELSE 0;
firstUsed ← firstAvail + padBits;
};
InstantiateSignalType:
PUBLIC
PROC [context:
REF
ANY, name:
ROPE, parms:
REF
ANY]
RETURNS [sti: SignalTypeInvocation] =
BEGIN
job: Job ← NARROW[context];
stce: stcEntry ← NARROW[SignalTypeRegistration.signalTypes.Lookup[name]];
IF stce = NIL THEN {[] ← Complain[nullSR, context, "Signal Type %g Undefined", IO.rope[name]]; RETURN [NIL]};
sti ← NEW [SignalTypeInvocationRep ← [nullSR, NIL, [nullSR, name, parms]]];
sti.st ← stce.stc[parms !
TypeConstructionError =>
BEGIN
[] ← Complain[nullSR, context, msg];
sti ← NIL;
CONTINUE;
END;
RuntimeError.
UNCAUGHT =>
BEGIN
msg: IO.STREAM ← IO.ROS[];
stv: AMTypes.TV;
TRUSTED {stv ← AMBridge.TVForSignal[signal]};
PrintTV.Print[tv: stv, put: msg, verbose: TRUE];
[] ← Complain[nullSR, context,
"Signal Type construction %g[%g] died horribly (uncaught signal or error: %g)",
IO.rope[name],
IO.refAny[parms],
IO.rope[IO.RopeFromROS[msg]]];
sti ← NIL;
CONTINUE;
END];
END;
TSNodeBreak: PUBLIC PROC [s: IO.STREAM] = {TS.EndNode[s, same]};
Setup:
PROC =
BEGIN
versionStream: IO.STREAM ← FS.StreamOpen["RoseTranslator.Version"];
[] ← versionStream.SkipWhitespace[];
versionString ← versionStream.GetLineRope[];
versionStream.Close[];
commandDate ← FS.FileInfo["RoseTranslator.Version"].created;
Commander.Register[translateCommandShort, TranslateCmd, "Translates rosemary sources (.Rose) into Mesa files"];
translateCommandName ← CommandTool.CurrentWorkingDirectory[].Cat[translateCommandShort];
END;
Setup[];
END.