
    <<GenerateTables.Mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Bill Jackson (bj) June 11, 1987 1:21:51 am PDT>>
    <<>>
    DIRECTORY
        Convert,
        FS USING [StreamOpen],
        IO USING [card, int, rope, Close, GetCedarTokenRope, PutF, PutFR, STREAM, TokenKind],
        Rope USING [ROPE, Concat, Equal, Length, Substr],
        SiroccoCGDef USING [Generic],
        SiroccoPrivate USING [AquireState, CComponent, CComponentBody, CType, CTypeBody, Handle, InterfaceItem, TABLES],
        SymTab USING [Create, EachPairAction, Fetch, Insert, Pairs, Ref];

    GenerateTables: CEDAR PROGRAM
        IMPORTS Convert, FS, IO, Rope, SiroccoPrivate, SymTab ~ {
        OPEN SiroccoPrivate;
        ROPE: TYPE ~ Rope.ROPE;

        Scope: TYPE ~ RECORD [
            name: ROPE,
            cedarIR: ROPE,
            itemTable: SymTab.Ref,
            typeTable: SymTab.Ref,
            fcnTable: SymTab.Ref
            ];

        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];
            };
        }.