GenDefs:
PUBLIC
PROC ~ {
allTheTables: TABLES;
defStream: IO.STREAM;
failure: BOOLEAN;
h: Handle;
initStream: IO.STREAM;
programKey: ROPE;
programKeyWD: ROPE;
GenerateCondensedFcn: HashTable.EachPairAction ~ {
fcn: ROPE ~ NARROW[value];
IO.PutF[initStream, Nest["%g", 1], IO.rope[fcn]];
};
GenerateType:
PROC [type: CType, name:
ROPE] ~ {
SELECT type.class
FROM
array => {
IO.PutF[defStream, "TYPE ~ ARRAY [0..%g) OF %g;",
IO.int[type.bound],
IO.rope[UnDo[type.children.type, programKeyWD]]
];
};
boolean => {
IO.PutF[defStream, "TYPE ~ BOOLEAN;"]
};
cardinal => {
IO.PutF[defStream, "TYPE ~ CARDINAL;"]
};
choice => {
list: CComponent ← type.children;
IO.PutF[defStream, Nest["TYPE ~ RECORD [", 2]];
IO.PutF[defStream, Nest["SELECT type: %g FROM", 3],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
WHILE (list.sibling #
NIL)
DO
IO.PutF[defStream, Nest["%g => [%g: %g],", 3],
IO.rope[list.name],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, Nest["%g => [%g: %g]", 3],
IO.rope[list.name],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
IO.PutF[defStream, Nest["ENDCASE", 2]];
IO.PutF[defStream, "];"];
};
enumeration => {
list: CComponent ← Sort[type.children];
type.children ← list;
IO.PutF[defStream, Nest["TYPE ~ MACHINE DEPENDENT {", 2]];
WHILE (list.sibling #
NIL)
DO
IO.PutF[defStream, Nest["%g(%g),", 2],
IO.rope[list.name],
IO.int[list.val]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, Nest["%g(%g)", 2],
IO.rope[list.name],
IO.int[list.val]
];
IO.PutF[defStream, "};"];
};
error => { NULL }; -- always a constant!
integer => {
IO.PutF[defStream, "TYPE ~ INTEGER;"]
};
longCardinal => {
IO.PutF[defStream, "TYPE ~ CARD;"]
};
longInteger => {
IO.PutF[defStream, "TYPE ~ INT;"]
};
procedure => { NULL }; -- always a constant!
record => {
list: CComponent ← type.children;
IO.PutF[defStream, "TYPE ~ RECORD"];
IF (list =
NIL)
THEN {
IO.PutF[defStream, " [];"];
}
ELSE {
IO.PutF[defStream, Nest[" [", 2]];
WHILE (list.sibling #
NIL)
DO
IO.PutF[defStream, Nest["%g: %g, ", 2],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, Nest["%g: %g", 2],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
IO.PutF[defStream, "];"];
}
};
sequence => {
obj: ROPE ← MakeUpName[name, "Object", allTheTables];
IO.PutF[defStream, Nest["TYPE ~ REF %g;", 1], IO.rope[obj]];
IO.PutF[defStream, Nest["%g: TYPE ~ MACHINE DEPENDENT RECORD [", 2], IO.rope[obj]];
IO.PutF[defStream, Nest["body: PACKED SEQUENCE length: CARDINAL OF %g", 2],
IO.rope[UnDo[type.children.type, programKeyWD]]
];
IO.PutF[defStream, "];"];
};
string => {
IO.PutF[defStream, "TYPE ~ ROPE;"]
};
unspecified => {
IO.PutF[defStream, "TYPE ~ CARDINAL;"]
};
ENDCASE => {
IO.PutF[defStream, "TYPE ~ UNKNOWN;"];
ERROR;
};
};
GenerateInterfaceConstant:
PROC [type: CType, name:
ROPE, entry:
REF DirectoryEntry] ~ {
SELECT type.class
FROM
array => {
IF (type.variable # constant)
THEN {
IO.PutF[defStream, "READONLY %g;", IO.rope[UnDo[entry.type, programKeyWD]]];
RETURN;
};
IO.PutF[defStream, "%g ~ %g;",
IO.rope[UnDo[entry.type, programKeyWD]],
IO.rope[entry.constant]
];
};
boolean => {
IO.PutF[defStream, "BOOLEAN ~ %g;", IO.rope[entry.constant]];
};
bulkDataSink => {
IO.PutF[defStream, "READONLY CrRPC.BulkDataSink;"];
};
bulkDataSource => {
IO.PutF[defStream, "READONLY CrRPC.BulkDataSource;"];
};
cardinal => {
IO.PutF[defStream, "CARDINAL ~ %g;", IO.rope[entry.constant]];
};
choice => {
list: CComponent ← type.children;
IF (type.variable # constant)
THEN {
IO.PutF[defStream, "READONLY %g;", IO.rope[UnDo[entry.type, programKeyWD]]];
RETURN;
};
IO.PutF[defStream, "%g ~ %g;",
IO.rope[UnDo[entry.type, programKeyWD]],
IO.rope[entry.constant]
];
};
enumeration => {
IO.PutF[defStream, "%g ~ %g;",
IO.rope[UnDo[entry.type, programKeyWD]],
IO.rope[entry.constant]
];
};
error => {
list: CComponent ← type.children;
IF (list =
NIL)
THEN {
IO.PutF[defStream, "ERROR;"];
RETURN;
};
IO.PutF[defStream, "ERROR ["];
WHILE (list.sibling #
NIL)
DO
IO.PutF[defStream, "%g: %g, ",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, "%g: %g",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
IO.PutF[defStream, "];"];
};
integer => {
IO.PutF[defStream, "INTEGER ~ %g;", IO.rope[entry.constant]];
};
longCardinal => {
IO.PutF[defStream, "CARD ~ %g;", IO.rope[entry.constant]];
};
longInteger => {
IO.PutF[defStream, "INT ~ %g;", IO.rope[entry.constant]];
};
procedure => {
list: CComponent ← type.children;
IF (list =
NIL)
THEN {
IO.PutF[defStream, "PROC [h: CrRPC.Handle];"];
}
ELSE {
IO.PutF[defStream, "PROC [h: CrRPC.Handle"];
FOR loopindex:
CARD
IN [0..type.bound)
DO
IO.PutF[defStream, ", %g: %g",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, "]"];
IF (list =
NIL)
THEN {
IO.PutF[defStream, ";"];
}
ELSE {
IO.PutF[defStream, " RETURNS ["];
WHILE (list.sibling #
NIL)
DO
IO.PutF[defStream,"%g: %g, ",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[defStream, "%g: %g",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
IO.PutF[defStream, "];"];
};
};
};
record => {
list: CComponent ← type.children;
IF (type.variable # constant)
THEN {
IO.PutF[defStream, "READONLY %g;", IO.rope[UnDo[entry.type, programKeyWD]]];
RETURN;
};
IO.PutF[defStream, "%g ~ %g;",
IO.rope[UnDo[entry.type, programKeyWD]],
IO.rope[entry.constant]
];
};
sequence => {
IO.PutF[defStream, "READONLY %g;", IO.rope[UnDo[entry.type, programKeyWD]]];
};
string => {
IO.PutF[defStream, "READONLY ROPE;"];
};
unspecified => {
IO.PutF[defStream, "CARDINAL ~ %g;", IO.rope[entry.constant]];
};
ENDCASE => {
IO.PutF[defStream, "TYPE; -- UNKNOWN"];
ERROR;
};
};
GenerateInitializedConstant:
PROC [type: CType, name:
ROPE, entry:
REF DirectoryEntry]
RETURNS [wroteItem:
BOOL ←
FALSE] ~ {
SELECT type.class
FROM
array => {
wroteItem ← TRUE;
IF (type.variable # constant)
THEN {
IO.PutF[initStream, " %g: PUBLIC ARRAY [0..%g) OF %g ← %g;",
IO.rope[name],
IO.int[type.bound],
IO.rope[UnDo[type.children.type, programKeyWD]],
IO.rope[entry.constant]
];
};
};
boolean => { NULL }; -- Interface item
bulkDataSink => { NULL }; -- Interface item
bulkDataSource => { NULL }; -- Interface item
cardinal => { NULL }; -- Interface item
choice => {
list: CComponent ← type.children;
wroteItem ← TRUE;
IF (type.variable # constant)
THEN {
IO.PutF[initStream, " %g: PUBLIC RECORD [",
IO.rope[name]
];
list ← type.children;
IO.PutF[initStream, "SELECT type: %g FROM",
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
IO.PutF[initStream,"%g => [%g: %g]",
IO.rope[list.name],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
WHILE (list #
NIL)
DO
IO.PutF[initStream,",%g => [%g: %g]",
IO.rope[list.name],
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[initStream, "ENDCASE"];
IO.PutF[initStream, "] ← %g;",
IO.rope[entry.constant]
];
};
};
enumeration => { NULL }; -- Interface item
error => { NULL }; -- Interface item
integer => { NULL }; -- Interface item
longCardinal => { NULL }; -- Interface item
longInteger => { NULL }; -- Interface item
procedure => { NULL }; -- Interface item
record => {
list: CComponent ← type.children;
wroteItem ← TRUE;
IF (type.variable # constant)
THEN {
IO.PutF[initStream, " %g RECORD [",
IO.rope[name]
];
list ← type.children;
IF (list =
NIL)
THEN {
IO.PutF[initStream, "] ~ %g ;",
IO.rope[entry.constant]
];
}
ELSE {
IO.PutF[initStream," %g: %g",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
WHILE (list #
NIL)
DO
IO.PutF[initStream,",%g: %g",
IO.rope[list.name],
IO.rope[UnDo[list.type, programKeyWD]]
];
list ← list.sibling;
ENDLOOP;
IO.PutF[initStream, "] ~ %g;",
IO.rope[entry.constant]
];
};
};
};
sequence => {
obj: ROPE ← MakeUpName[name, "Object", allTheTables];
this name was already made up! -- (bj)
FIX ME
wroteItem ← TRUE;
IO.PutF[initStream, "%g: PUBLIC REF %g ← %g;",
IO.rope[name],
IO.rope[obj],
IO.rope[entry.constant]
];
};
string => {
wroteItem ← TRUE;
IO.PutF[initStream, "%g: PUBLIC ROPE ← %g;",
IO.rope[name],
IO.rope[entry.constant]
];
};
unspecified => { NULL }; -- Interface item
ENDCASE => {
IO.PutF[initStream, "--UNKNOWN--"];
ERROR;
};
};
GenerateInterfaceItem: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: REF DirectoryEntry ← NARROW [value];
successful: BOOLEAN;
tempRope: ROPE;
type: CType;
undid: BOOLEAN;
value1: Value;
IO.PutF[defStream, "%g: ",
IO.rope[name]];
[tempRope, undid] ← UnDoable[entry.type, programKeyWD];
IF (undid
AND (
NOT Rope.Equal[name, tempRope]))
THEN {
IF (Rope.Equal[entry.constant, ""])
THEN {
IO.PutF[defStream, "TYPE ~ %g;", IO.rope[tempRope]];
}
ELSE {
[successful, value1] ← HashTable.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
IF (type.variable = variable)
THEN {
IO.PutF[defStream, "READONLY %g;",
IO.rope[tempRope]
];
}
ELSE {
IO.PutF[defStream, "%g ~ %g;",
IO.rope[tempRope],
IO.rope[entry.constant]
];
};
};
}
ELSE {
[successful, value1] ← HashTable.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
SELECT
TRUE
FROM
(type.class = bulkDataSink) => { GenerateInterfaceConstant[type, name, entry]; };
(type.class = bulkDataSource) => { GenerateInterfaceConstant[type, name, entry]; };
Rope.Equal[entry.constant, ""] => { GenerateType[type, name]; };
ENDCASE => { GenerateInterfaceConstant[type, name, entry]; };
};
IO.PutF[defStream, Nest["", 1]];
IO.PutF[defStream, Nest["", 1]];
};
GenerateInitializedItem: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: REF DirectoryEntry ← NARROW [value];
successful: BOOLEAN;
tempRope: ROPE;
type: CType;
undid: BOOLEAN;
value1: Value;
[tempRope, undid] ← UnDoable[entry.type, programKeyWD];
IF (undid
AND (
NOT Rope.Equal[name, tempRope]))
THEN {
IF ~ (Rope.Equal[entry.constant, ""])
THEN {
[successful, value1] ← HashTable.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
IF (type.variable = variable)
THEN {
IO.PutF[initStream, "%g: PUBLIC %g ← %g;",
IO.rope[name],
IO.rope[tempRope],
IO.rope[entry.constant]
];
};
};
}
ELSE {
[successful, value1] ← HashTable.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
SELECT
TRUE
FROM
Rope.Equal[entry.constant, ""] => { NULL; };
ENDCASE => {
IF (GenerateInitializedConstant[type, name, entry].wroteItem =
TRUE)
THEN {
IO.PutF[initStream, Nest["", 1]];
IO.PutF[initStream, Nest["", 1]];
};
};
};
};
Heading:
PROC [out:
IO.
STREAM] ~ {
PutDirectory: HashTable.EachPairAction ~ {
interface: ROPE ~ NARROW [value];
IO.PutF[out, Nest["%g,", 1],
IO.rope[interface]
];
};
SiroccoPrivate.FileHeader[out, Rope.Cat[programKeyWD, ".Mesa"]];
IO.PutF[out, Nest["DIRECTORY", 1]];
IO.PutF[out, Nest["CrRPC,", 1]];
failure ← HashTable.Pairs[allTheTables.directory, PutDirectory];
IO.PutF[out, Nest["Rope;", 0]];
IO.PutF[out, Nest["", 0]];
IO.PutF[out, Nest["%g: CEDAR DEFINITIONS ~ {", 1], IO.rope[programKeyWD]];
};
InitHeading:
PROC [out:
IO.
STREAM] ~ {
PutDirectory: HashTable.EachPairAction ~ {
interface: ROPE ~ NARROW [value];
IO.PutF[out, Nest["%g,", 1],
IO.rope[interface]
];
};
SiroccoPrivate.FileHeader[out, Rope.Cat[programKeyWD, "Init.Mesa"]];
IO.PutF[out, Nest["DIRECTORY", 1]];
IO.PutF[out, Nest["CrRPC,", 1]];
IO.PutF[out, Nest["Rope,", 1]];
failure ← HashTable.Pairs[allTheTables.directory, PutDirectory];
IO.PutF[out, Nest["%g;", 0], IO.rope[programKeyWD]];
IO.PutF[out, Nest["", 0]];
IO.PutF[out, Nest["%gInit: CEDAR PROGRAM", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["EXPORTS %g ~ {", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["OPEN %g;", 0], IO.rope[programKeyWD]];
};
GenDefs MAIN
h ← SIGNAL AquireState[];
allTheTables ← h.allTheTables;
programKey ← h.programKey;
programKeyWD ←
IO.PutFR["%gP%gV%g",
IO.rope[h.programName],
IO.int[h.programNo],
IO.int[h.versionNo]
];
HashTable.Erase[allTheTables.workTable];
Generate Interface
defStream ← FS.StreamOpen[Rope.Cat[programKeyWD, ".Mesa"], $create];
Heading[defStream];
IO.PutF[defStream, Nest["", 1]];
IO.PutF[defStream, Nest["ROPE: TYPE ~ Rope.ROPE;", 1]];
IO.PutF[defStream, Nest["", 1]];
failure ← HashTable.Pairs[allTheTables.localTable, GenerateInterfaceItem];
IO.PutF[defStream, Nest["", 0]];
IO.PutF[defStream, Nest["}...", 0]];
IO.Close[defStream];
Generated Constant Initialization Module
initStream ← FS.StreamOpen[Rope.Cat[programKeyWD, "Init.Mesa"], $create];
InitHeading[initStream];
IO.PutF[initStream, Nest["", 1]];
IO.PutF[initStream, Nest["ROPE: TYPE ~ Rope.ROPE;", 1]];
IO.PutF[initStream, Nest["", 1]];
failure ← HashTable.Pairs[allTheTables.localTable, GenerateInitializedItem];
IO.PutF[initStream, Nest["", 1]];
failure ← HashTable.Pairs[allTheTables.condensedFunctionTable, GenerateCondensedFcn];
IO.PutF[initStream, Nest["", 0]];
IO.PutF[initStream, Nest["}...", 0]];
IO.Close[initStream];
};