ClassToRope:
PROC [class: SiroccoCGDef.Generic]
RETURNS [rope:
ROPE] ~ {
SELECT class
FROM
array => rope ← "$ARRAY";
bool => rope ← "$BOOL";
card16 => rope ← "$CARD16";
card32 => rope ← "$CARD32";
choice => rope ← "$CHOICE";
enum => rope ← "$ENUM";
error => rope ← "$ERROR";
int16 => rope ← "$INT16";
int32 => rope ← "$INT32";
proc => rope ← "$PROC";
record => rope ← "$RECORD";
seq => rope ← "$SEQ";
sink => rope ← "$SINK";
source => rope ← "$SOURCE";
string => rope ← "$STRING";
unspec => rope ← "$UNSPEC";
ENDCASE => ERROR;
};
RopeToClass:
PROC [rope:
ROPE]
RETURNS [class: SiroccoCGDef.Generic] ~ {
SELECT
TRUE
FROM
Rope.Equal[rope, "$ARRAY"] => class ← array;
Rope.Equal[rope, "$BOOL"] => class ← bool;
Rope.Equal[rope, "$CARD16"] => class ← card16;
Rope.Equal[rope, "$CARD32"] => class ← card32;
Rope.Equal[rope, "$CHOICE"] => class ← choice;
Rope.Equal[rope, "$ENUM"] => class ← enum;
Rope.Equal[rope, "$ERROR"] => class ← error;
Rope.Equal[rope, "$INT16"] => class ← int16;
Rope.Equal[rope, "$INT32"] => class ← int32;
Rope.Equal[rope, "$PROC"] => class ← proc;
Rope.Equal[rope, "$RECORD"]=> class ← record;
Rope.Equal[rope, "$SEQ"] => class ← seq;
Rope.Equal[rope, "$SINK"] => class ← sink;
Rope.Equal[rope, "$SOURCE"] => class ← source;
Rope.Equal[rope, "$STRING"] => class ← string;
Rope.Equal[rope, "$UNSPEC"] => class ← unspec;
ENDCASE => ERROR;
};
DiskToTable:
PROC [interface:
ROPE, pgm:
INT, version:
INT]
RETURNS [ir:
REF Scope ←
NIL] ~ {
ProgramFile:
PROC
RETURNS [name:
ROPE] ~ {
name ← IO.PutFR["%gP%gV%g", IO.rope[interface], IO.int[pgm], IO.int[version] ];
};
s: IO.STREAM ~ FS.StreamOpen[Rope.Concat[ProgramFile[], ".coke"]];
TokenToInt:
PROC [arg:
ROPE]
RETURNS [res:
INT] ~ {
len: INT ~ Rope.Length[arg];
res ←
IF ( len = 1 )
THEN 0
ELSE Convert.IntFromRope[Rope.Substr[arg, 0, len.PRED]];
};
GetItemTable:
PROC
RETURNS [ref: SymTab.Ref ←
NIL] ~ {
tokenKind: IO.TokenKind; token: ROPE; charsSkipped: INT;
ref ← SymTab.Create[];
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- {
IF ( ( tokenKind # tokenSINGLE ) AND ( NOT Rope.Equal[token, "{"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- LocalTables
IF ( ( tokenKind # tokenROPE ) AND ( NOT Rope.Equal[token, "LocalTables"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
WHILE ( ( tokenKind # tokenSINGLE )
AND (
NOT Rope.Equal[token, "}"] ) )
DO
GetFcns:
PROC
RETURNS [list:
LIST
OF
ROPE ←
NIL] ~ {
IF ( ( tokenKind # tokenSINGLE ) AND ( NOT Rope.Equal[token, "{"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
WHILE ( ( tokenKind # tokenSINGLE )
AND (
NOT Rope.Equal[token, "}"] ) )
DO
list ← CONS[token, list];
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
ENDLOOP;
};
item: REF InterfaceItem ~ NEW[InterfaceItem];
item.name ← token;
item.type ← IO.GetCedarTokenRope[s].token;
item.constant ← IO.GetCedarTokenRope[s].token;
item.value ← NIL;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- xx ???
IF ( ( tokenKind # tokenROPE ) AND ( NOT Rope.Equal[token, "xx"] ) )
THEN ERROR;
item.functions ← GetFcns[];
IF ( NOT SymTab.Insert[ref, item.name, item] ) THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
ENDLOOP;
};
GetTypeTable:
PROC
RETURNS [ref: SymTab.Ref ←
NIL] ~ {
tokenKind: IO.TokenKind; token: ROPE; charsSkipped: INT;
ref ← SymTab.Create[];
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- {
IF ( ( tokenKind # tokenSINGLE ) AND ( NOT Rope.Equal[token, "{"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- TypeTables
IF ( ( tokenKind # tokenROPE ) AND ( NOT Rope.Equal[token, "TypeTables"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
WHILE ( ( tokenKind # tokenSINGLE )
AND (
NOT Rope.Equal[token, "}"] ) )
DO
GetTypeConstruction:
PROC
RETURNS [canon:
REF CComponentBody ←
NIL] ~ {
canon ← NEW [CComponentBody];
canon.name ← NIL;
canon.sibling ← NIL;
canon.type ← NIL;
canon.val ← 0;
};
ctype: REF CTypeBody ~ NEW[CTypeBody];
name: ROPE ~ token;
ctype.class ← RopeToClass[IO.GetCedarTokenRope[s].token];
ctype.bound← Convert.CardFromRope[IO.GetCedarTokenRope[s].token];
ctype.children ← GetTypeConstruction[];
IF ( NOT SymTab.Insert[ref, name, ctype] ) THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
ENDLOOP;
};
GetFcnTable:
PROC
RETURNS [ref: SymTab.Ref ←
NIL] ~ {
tokenKind: IO.TokenKind; token: ROPE; charsSkipped: INT;
ref ← SymTab.Create[];
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- {
IF ( ( tokenKind # tokenSINGLE ) AND ( NOT Rope.Equal[token, "{"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- Functions
IF ( ( tokenKind # tokenROPE ) AND ( NOT Rope.Equal[token, "Functions"] ) )
THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
WHILE ( ( tokenKind # tokenSINGLE )
AND (
NOT Rope.Equal[token, "}"] ) )
DO
item: REF InterfaceItem ~ NEW[InterfaceItem];
item.name ← token;
item.type ← IO.GetCedarTokenRope[s].token;
item.constant ← IO.GetCedarTokenRope[s].token;
item.functions ← NIL;
item.value ← NIL;
IF ( NOT SymTab.Insert[ref, item.name, item] ) THEN ERROR;
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s]; -- } ???
ENDLOOP;
};
ir ← NEW[Scope];
ir.name ← interface;
ir.cedarIR ← ProgramFile[];
ir.itemTable ← GetItemTable[];
ir.typeTable ← GetTypeTable[];
ir.fcnTable ← GetFcnTable[];
};
Bottle:
PUBLIC
PROC ~ {
h: SiroccoPrivate.Handle ~ SIGNAL SiroccoPrivate.AquireState;
out: IO.STREAM ~ FS.StreamOpen[Rope.Concat[h.programKey,"coke"], $create];
AddUsedTypes: SymTab.EachPairAction ~ {
entry: REF InterfaceItem ~ NARROW[val];
condensed: SymTab.Ref ~ h.allTheTables.condensedTypeTable;
typeTable: SymTab.Ref ~ h.allTheTables.typeTable;
TraverseCType:
PUBLIC
PROC [type: CType] ~ {
FOR list: CComponent ← type.children, list.sibling
WHILE ( list #
NIL )
DO
IF ( ( list.type #
NIL )
AND (
NOT Rope.Equal["", list.type] ) )
THEN {
WITH SymTab.Fetch[typeTable, list.type].val
SELECT
FROM
ctype: CType => {
IF ( SymTab.Insert[condensed, list.type, ctype] ) THEN TraverseCType[ctype];
};
ENDCASE => { ERROR };
};
ENDLOOP;
};
WITH SymTab.Fetch[typeTable, entry.type].val
SELECT
FROM
ctype: CType => {
IF ( SymTab.Insert[condensed, entry.type, ctype] ) THEN TraverseCType[ctype];
};
ENDCASE => { ERROR };
};
PutItemEntry: SymTab.EachPairAction ~ {
entry: REF InterfaceItem ← NARROW[val];
IO.PutF[out, "\t{ %g %g %g %g\n",
IO.rope[entry.name],
IO.rope[entry.type],
IO.rope[entry.constant],
IO.rope["xx"] -- entry.value
];
IO.PutF[out, "\t\t{"];
FOR list:
LIST
OF
ROPE ← entry.functions, list.rest
WHILE ( list #
NIL )
DO
name: ROPE ~ list.first;
IO.PutF[out, " %g",
IO.rope[name]
];
ENDLOOP;
IO.PutF[out, " }\n"];
IO.PutF[out, "\t\t}\n"];
};
PutTypeEntry: SymTab.EachPairAction ~ {
ctype: CType ← NARROW[val];
IO.PutF[out, "\t{ ctype %g %g %g\n",
IO.rope[key],
IO.rope[ClassToRope[ctype.class]],
IO.card[ctype.bound]
];
IO.PutF[out, "\t\t{\n"];
FOR list: CComponent ← ctype.children, list.sibling
WHILE ( list #
NIL )
DO
IO.PutF[out, "\t\t\t%g %g %g\n",
IO.rope[list.name],
IO.int[list.val],
IO.rope[list.type]
];
ENDLOOP;
IO.PutF[out, "\t\t\t}\n"];
IO.PutF[out, "\t\t}\n"];
};
PutFcnEntry: SymTab.EachPairAction ~ {
fcn: ROPE ~ NARROW[val];
IO.PutF[out, "\t%g %g\n",
IO.rope[key],
IO.rope[fcn]
]
};
[] ← SymTab.Pairs[h.allTheTables.localTable, AddUsedTypes];
IO.PutF[out, "{ LocalTables\n"];
[] ← SymTab.Pairs[h.allTheTables.localTable, PutItemEntry];
IO.PutF[out, "\t}\n"];
IO.PutF[out, "{ TypeTables\n"];
[] ← SymTab.Pairs[h.allTheTables.condensedTypeTable, PutTypeEntry];
IO.PutF[out, "\t}\n"];
IO.PutF[out, "{ Functions\n"];
[] ← SymTab.Pairs[h.allTheTables.functionTable, PutFcnEntry];
IO.PutF[out, "\t}\n"];
IO.Close[out];
};