
<<SiroccoPrivateImpl.mesa>>
    <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
    <<Bhargava, August 11, 1986 10:48:02 am PDT>>
    <<Bill Jackson (bj) June 6, 1987 10:15:00 pm PDT>>
    <<Demers, January 6, 1987 4:07:02 pm PST>>
    <<>>
DIRECTORY
    BasicTime USING [GMT],
    Convert USING [IntFromRope, RopeFromInt],
    Loader USING [BCDBuildTime],
    IO USING [int, rope, time, PutF, PutFR, PutRope, STREAM],
    Rope USING [ROPE, Cat, Concat, Equal, Fetch, Flatten, Index, InlineFetch, IsEmpty, Length, Substr],
    RopeList USING [DAppend],
    SiroccoPrivate USING [CComponent, CType, Handle, UMProcNameProc, TABLES],
    SymTab USING [EachPairAction, Fetch, Pairs, Store, Val],
    UserCredentials USING [Get];

SiroccoPrivateImpl: CEDAR PROGRAM
IMPORTS Convert, IO, Loader, Rope, RopeList, SymTab, UserCredentials
EXPORTS SiroccoPrivate ~ {
OPEN SiroccoPrivate;
ROPE: TYPE ~ Rope.ROPE;
<<>>
Version: PUBLIC ROPE;

AquireState: PUBLIC SIGNAL RETURNS [Handle] ~ CODE;
EndItAll: PUBLIC ERROR ~ CODE;

    MakeUpName: PUBLIC PROC [base: ROPE, suffix: ROPE, tables: TABLES]
    RETURNS [madeUpName: ROPE] ~ {
        <<Return a unique name constructed from base and suffix.>>
        <<Check that the standard construction method  concatentation  doesn't cause collisions.>>
        successful: BOOLEAN;
        value: SymTab.Val;
        madeUpName _  Rope.Concat[base, suffix];
        [successful, value] _ SymTab.Fetch[tables.localTable, madeUpName];
        IF successful THEN ERROR; -- ????
        };

    MadeUpName: PUBLIC PROC [base: ROPE, suffix: ROPE]
    RETURNS [madeUpName: ROPE] ~ {
        madeUpName _  Rope.Concat[base, suffix];
        };

    MakeUpUniqueID: PROC [h: Handle, prefix: ROPE] RETURNS [uniqueID: ROPE] ~ {
        found: BOOL _ TRUE;
        WHILE found DO
            h.uniqueNo _ h.uniqueNo + 1;
            uniqueID _ Rope.Concat[prefix, Convert.RopeFromInt[h.uniqueNo]];
            [found: found] _ SymTab.Fetch[h.allTheTables.localTable, uniqueID];
            ENDLOOP;
        };

    Merge: PROC [list1, list2: CComponent] RETURNS [comp: CComponent] ~ {
        IF (list1 = NIL) THEN { comp _ list2; RETURN };
        IF (list2 = NIL) THEN { comp _ list1; RETURN };
        IF (list1.val > list2.val) THEN { comp _ Merge[list2, list1]; RETURN };
        list2 _ Merge[list1.sibling, list2];
        list1.sibling _ list2;
        comp _ list1;
        };
    Nest: PUBLIC PROC [in: ROPE, level: NAT] RETURNS [out: ROPE] ~ {
    INDENT: ROPE ~ "\n\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t";
        out _ Rope.Concat[in, Rope.Substr[INDENT, 0, (level+1)]];
        };
    Sort: PUBLIC PROC [list: CComponent] RETURNS [comp: CComponent] ~ {
        longComp: CComponent;
        shortComp: CComponent;
        [longComp, shortComp] _ Split[list];
        IF (longComp # NIL) AND (longComp.sibling # NIL) THEN longComp _ Sort[longComp];
        IF (shortComp # NIL) THEN shortComp _ Sort[shortComp];
        comp _ Merge[longComp, shortComp];
        };

    Split: PROC [list: CComponent] RETURNS [longComp: CComponent _ NIL, shortComp: CComponent _ NIL] ~ {
        IF (list = NIL) THEN RETURN;
        [shortComp, longComp] _ Split[list.sibling];
        list.sibling _ longComp;
        longComp _ list; 
        };
    UnDo: PUBLIC PROC [in: ROPE, programKey: ROPE] RETURNS [out: ROPE] ~ {
        <<It doesn't matter whether programKey has a trailing dot or not ... but it's faster if it does.>>
        len1: INT ~ Rope.Length[in];
        len2: INT _ Rope.Length[programKey];
        IF (len2 > 0) AND (Rope.Fetch[programKey, len2-1] # '.) THEN {
            len2 _ len2 + 1;
            programKey _ Rope.Concat[programKey, "."] };
        IF (len1 >= len2) AND Rope.Equal[Rope.Substr[in, 0, len2], programKey] THEN
            RETURN[out~Rope.Substr[in, len2, len1]];
        RETURN[out: (SELECT TRUE FROM
            Rope.Equal[in, "LONGCARDINAL"]  => "CARD32",
            Rope.Equal[in, "LONGINTEGER"] => "INT32",
            Rope.Equal[in, "SINK"] => "CrRPC.BulkDataSink",
            Rope.Equal[in, "SOURCE"] => "CrRPC.BulkDataSource",
            Rope.Equal[in, "STRING"] => "ROPE",
            Rope.Equal[in, "INTEGER"] => "INT16",
            Rope.Equal[in, "CARDINAL"] => "CARD16",
            Rope.Equal[in, "UNSPECIFIED"] => "CARD16",
            ENDCASE => in)];
        };
    UnDoable: PUBLIC PROC [in: ROPE, programKey: ROPE]
    RETURNS [out: ROPE, yes: BOOLEAN] ~ {
        <<It doesn't matter whether programKey has a trailing dot or not ... but it's faster if it does.>>
        len1: INT ~ Rope.Length[in];
        len2: INT _ Rope.Length[programKey];

        IF (len2 > 0) AND (Rope.Fetch[programKey, len2-1] # '.) THEN {
            len2 _ len2 + 1;
            programKey _ Rope.Concat[programKey, "."] };

        IF (len1 >= len2) AND Rope.Equal[Rope.Substr[in, 0, len2], programKey] THEN
            RETURN[out: Rope.Substr[in, len2, len1], yes: TRUE];
    RETURN[out: in, yes: FALSE];
        };

    ConstExp: PUBLIC PROC [h: Handle, const: ROPE, type: CType, typeName: ROPE, level: NAT] RETURNS [constExp: ROPE, setup: LIST OF 
    ROPE _ NIL, runtime: BOOL _ FALSE] ~ {
        token: ROPE;
        input: ROPE _ Rope.Flatten[const];
        inputLen: NAT ~ Rope.Length[const];
        inputCol: NAT _ 0;
        GetToken: PROC RETURNS [ok: BOOL] ~ {
            endCol: INT;
            DO
                IF inputCol >= inputLen THEN RETURN [FALSE];
            SELECT Rope.InlineFetch[input, inputCol] FROM
            '  => {
            NULL };
            '" => {
            endCol _ Rope.Index[input, inputCol+1, "\""] + 1;
            EXIT };
            ENDCASE => {
            endCol _ Rope.Index[input, inputCol, " "];
            EXIT };
                inputCol _ inputCol.SUCC;
                ENDLOOP;
            token _ Rope.Substr[input, inputCol, (endCol-inputCol)];
            inputCol _ endCol + 1;
            RETURN [TRUE];
            };
        MesaConst: PROC [type: CType, typeName: ROPE]
        RETURNS [mesaConst: ROPE _ NIL, setup: LIST OF ROPE _ NIL] ~ {
            SELECT type.class FROM
                array =>  {
                    childType: CType;
                    value: SymTab.Val;
                    childTypeName: ROPE;
                    i, bound: INT;
                    IF GetToken[] THEN bound _ Convert.IntFromRope[token] ELSE ERROR;
                    IF bound # INT[type.bound] THEN ERROR;
                    childTypeName _ type.children.type;
                    [val: value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, childTypeName];
                    childType _ NARROW[value];
                    mesaConst _ "[";
                    i _ 0;
                    WHILE i < bound DO
                        tConst: ROPE;
                        tSetup: LIST OF ROPE;
                    [tConst, tSetup] _ MesaConst[childType, childTypeName];
                    IF i > 0 THEN mesaConst _ Rope.Concat[mesaConst, ", "];
                    mesaConst _ Rope.Concat[mesaConst, tConst];
                    IF tSetup # NIL THEN setup _ RopeList.DAppend[tSetup, setup];
                    i _ i + 1;
                    ENDLOOP;
                mesaConst _ Rope.Concat[mesaConst, "]"];
                    RETURN;
                    };
                bool => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                card16 => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                card32 => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                choice => {
                    tag, tConst: ROPE;
                    unionTypeName: ROPE;
                    value: SymTab.Val;
                    unionTypeName _ MadeUpName[UnDo[typeName, h.programKey], "Object"];
                    IF GetToken[] THEN tag _ token ELSE ERROR;
                    FOR child: CComponent _ type.children.sibling, child.sibling DO
                        IF Rope.Equal[child.name, tag] THEN {
                            [val: value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, child.type];
                            [tConst, setup] _ MesaConst[type: NARROW[value], typeName: child.type];
                            EXIT };
                        ENDLOOP;
                    mesaConst _ IO.PutFR["NEW [%g.%g _ [%g[%g~%g]]]", IO.rope[unionTypeName], IO.rope[tag], IO.rope[tag], IO.rope[tag], 
                    IO.rope[tConst]];
                    runtime _ TRUE;
                RETURN;
                };
                enum => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                int16 => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                int32 => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                record => {
                    numFields: NAT _ 0;
                    FOR list: CComponent _ type.children, list.sibling WHILE list # NIL DO
                        numFields _ numFields.SUCC;
                        ENDLOOP;
                    mesaConst _ "[";
                    FOR i: NAT IN [1..numFields] DO
                        fieldName: ROPE;
                        tConst: ROPE;
                        tSetup: LIST OF ROPE;
                        IF GetToken[] THEN fieldName _ token ELSE ERROR;
                        FOR child: CComponent _ type.children, child.sibling DO
                            IF Rope.Equal[child.name, fieldName] THEN {
                                value: SymTab.Val;
                                [val: value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, child.type];
                                [tConst, tSetup] _ MesaConst[type: NARROW[value], typeName: child.type];
                                EXIT };
                            ENDLOOP;
                        IF i > 1 THEN mesaConst _ Rope.Concat[mesaConst, ", "];
                        mesaConst _ Rope.Cat[mesaConst, fieldName, "~", tConst];
                        IF tSetup # NIL THEN setup _ RopeList.DAppend[tSetup, setup];
                        ENDLOOP;
                    mesaConst _ Rope.Concat[mesaConst, "]"];
                    RETURN;
                    };
                seq => { 
                    objTypeName: ROPE _ MadeUpName[UnDo[typeName, h.programKey], "Object"];
                    eltTypeName: ROPE;
                    value: SymTab.Val;
                    eltType: CType;
                    uniqueProcName: ROPE _ MakeUpUniqueID[h, "InitProc"];
                    procText: ROPE;
                    procBody: LIST OF ROPE _ NIL;
                    i, length: INT;
                    eltTypeName _ type.children.type;
                    [val: value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, eltTypeName];
                    eltType _ NARROW[value];
                    IF NOT GetToken[] THEN ERROR;
                    length _ Convert.IntFromRope[token];
                    procText _ Rope.Concat[Nest[NIL, level+1], "};"];
                    procBody _ CONS[procText, NIL];
                    i _ 0;
                    WHILE i < length DO
                        tConst: ROPE;
                        tSetup: LIST OF ROPE;
                        [tConst, tSetup] _ MesaConst[eltType, eltTypeName];
                        IF tSetup # NIL THEN setup _ RopeList.DAppend[tSetup, setup];
                        procText _ IO.PutFR["%gresult.body[%g] _ %g;",
                            IO.rope[Nest[NIL, level+1]],
                            IO.int[i],
                            IO.rope[tConst]
                            ];
                        procBody _ CONS[procText, procBody];
                        i _ i + 1;
                        ENDLOOP;
                    procText _ IO.PutFR["%gresult _ NEW[%g[%g]];",
                    IO.rope[Nest[NIL, level+1]],
                        IO.rope[objTypeName],
                        IO.int[length]
                        ];
                    procBody _ CONS[procText, procBody];

                    procText _ IO.PutFR["%g%g: PROC RETURNS [result: %g] ~ {",
                        IO.rope[Nest[NIL, level]],
                        IO.rope[uniqueProcName],
                        IO.rope[UnDo[typeName, h.programKey]]
                        ];
                    procBody _ CONS[procText, procBody];
                    IF setup = NIL
                        THEN setup _ procBody
                        ELSE setup _ RopeList.DAppend[setup, procBody];
                    mesaConst _ Rope.Concat[uniqueProcName, "[]"];
                    runtime _ TRUE;
                    RETURN;
                    };
                sink => { ERROR; };
                source => { ERROR; };
                string => {
                    IF GetToken[] THEN NULL ELSE ERROR;
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    runtime _ TRUE;
                    RETURN;
                    };
                unspec => {
                    IF GetToken[] THEN mesaConst _ token ELSE ERROR;
                    RETURN;
                    };
                ENDCASE => { ERROR; };
            };
        [constExp, setup] _ MesaConst[type, typeName];
        };

    TypeExp: PUBLIC PROC [h: Handle, type: CType, typeName: ROPE, level: NAT]
    RETURNS [typeExp: ROPE, objTypeDecls: LIST OF ROPE _ NIL] ~ {
        SELECT type.class FROM
            array =>  {
                typeExp _ Rope.Cat[
                    "ARRAY [0..",
                    Convert.RopeFromInt[type.bound],
                    ") OF ",
                    UnDo[type.children.type, h.programKey]
                    ];
                };
            bool => { typeExp _ "BOOLEAN"; };
            card16 => { typeExp _ "CARD16"; };
            card32 => { typeExp _ "CARD32"; };
            choice => {
                list: CComponent _ type.children;
                obj: ROPE _ MakeUpName[UnDo[typeName, h.programKey], "Object", h.allTheTables];
                objDeclText: ROPE;
                typeExp _ Rope.Concat["REF ", obj];
                objDeclText _ IO.PutFR["%g%g: TYPE ~ RECORD [%gSELECT type: %g FROM",
                    IO.rope[Nest[NIL, level]],
                    IO.rope[obj],
                    IO.rope[Nest[NIL, level+1]],
                    IO.rope[UnDo[list.type, h.programKey]]
                    ];
                objTypeDecls _ CONS[objDeclText, NIL];
                list _ list.sibling;
                WHILE list # NIL DO
                    objDeclText _ IO.PutFR["%g%g => [%g: %g]",
                        IO.rope[Nest[NIL, level+2]],
                        IO.rope[list.name], IO.rope[list.name],
                        IO.rope[UnDo[list.type, h.programKey]]
                        ];
                    IF list.sibling # NIL THEN objDeclText _ Rope.Concat[objDeclText, ","];
                    objTypeDecls _ RopeList.DAppend[objTypeDecls, CONS[objDeclText, NIL]];
                    list _ list.sibling;
                    ENDLOOP;
                objDeclText _ IO.PutFR["%gENDCASE%g];",
                    IO.rope[Nest[NIL, level+2]],
                    IO.rope[Nest[NIL, level+1]]
                    ];
                objTypeDecls _ RopeList.DAppend[objTypeDecls, CONS[objDeclText, NIL]];
                };
            enum =>  {
                typeExp _ "MACHINE DEPENDENT { ";
                type.children _ Sort[type.children];
                FOR child: CComponent _ type.children, child.sibling WHILE child # NIL DO
                    typeExp _ Rope.Cat[typeExp, child.name, "(", Convert.RopeFromInt[child.val], ")"];
                    IF child.sibling # NIL THEN typeExp _ Rope.Concat[typeExp, ", "];
                    ENDLOOP;

                typeExp _ Rope.Concat[typeExp, "}"];
                };
            error => {
                typeExp _ "ERROR [";
                FOR child: CComponent _ type.children, child.sibling WHILE child # NIL DO
                    typeExp _ Rope.Cat[typeExp, child.name, ": ",
                    UnDo[child.type, h.programKey]];
                    IF child.sibling # NIL THEN typeExp _ Rope.Concat[typeExp, ", "];
                    ENDLOOP;
                typeExp _ Rope.Concat[typeExp, "]"];
                };
            int16 => { typeExp _ "INT16"; };
            int32 => { typeExp _ "INT32"; };
            proc => {
                child: CComponent _ type.children;
                typeExp _ "PROC [h: CrRPC.Handle";
                THROUGH [0..type.bound) DO
                    IF child = NIL THEN ERROR;
                    typeExp _ Rope.Cat[typeExp, ", ", child.name, ": ", UnDo[child.type, h.programKey]];
                    child _ child.sibling;
                    ENDLOOP;
                IF child # NIL THEN {
                    typeExp _ Rope.Cat[typeExp, "] RETURNS [", child.name, ": ",
                    UnDo[child.type, h.programKey]];
                    child _ child.sibling;
                    };
                WHILE child # NIL DO
                    typeExp _ Rope.Cat[typeExp, ", ", child.name, ": ",
                    UnDo[child.type, h.programKey]];
                    child _ child.sibling;
                    ENDLOOP;
                typeExp _ Rope.Concat[typeExp,  "]"];
                };
            record => {
                typeExp _ "RECORD [";
                IF type.children = NIL THEN
                    <<Avoid compiler bug for empty records.>>
                    typeExp _ Rope.Concat[typeExp, "null: CARDINAL _ 0"];
                FOR child: CComponent _ type.children, child.sibling WHILE child # NIL DO
                    typeExp _ Rope.Cat[
                        typeExp,
                        Nest[NIL, level+1],
                        child.name,
                        ": ",
                        UnDo[child.type, h.programKey]
                        ];
                    IF child.sibling # NIL THEN typeExp _ Rope.Concat[typeExp, ","];
                    ENDLOOP;
                typeExp _ Rope.Concat[typeExp, "]"];
                };
            seq => {
                obj: ROPE _ MakeUpName[typeName, "Object", h.allTheTables];
                objDeclText: ROPE;
                typeExp _ Rope.Concat["REF ", obj];
                objDeclText _ IO.PutFR["%g%g: TYPE ~ MACHINE DEPENDENT RECORD [%gbody: PACKED SEQUENCE length: CARDINAL OF %g%g];",
                    IO.rope[Nest[NIL, level]],
                    IO.rope[obj],
                    IO.rope[Nest[NIL, level+1]],
                    IO.rope[UnDo[type.children.type, h.programKey]],
                    IO.rope[Nest[NIL, level+1]]
                    ];
                objTypeDecls _ CONS[objDeclText, NIL];
                };
            string => { typeExp _ "ROPE"; };
            unspec => { typeExp _ "CARD16"; };
            ENDCASE => { ERROR; };
        };

    UMProcKind: TYPE ~ { unMarshal, marshal };
    UMProcEntry: TYPE ~ REF UMProcEntryObject;
    UMProcEntryObject: TYPE ~ RECORD [
        kind: UMProcKind,
        generated: BOOL,
        procName: ROPE,
        type: CType,
        typeName: ROPE
        ];

    GetUProcName: PUBLIC UMProcNameProc
        <<[h: Handle, type: CType, typeName: ROPE] RETURNS [procName: ROPE]>>
        ~ {
        key: ROPE;
        value: SymTab.Val;
        successful: BOOL;
        SELECT type.class FROM
            choice => NULL;
            seq => NULL;
            ENDCASE => RETURN [NIL];
        key _ Rope.Concat["<", typeName];
        [successful, value] _ SymTab.Fetch[h.allTheTables.workTable, key];
        IF NOT successful THEN {
            value _ NEW[UMProcEntryObject _ [
                kind: unMarshal, generated: FALSE,
                procName: MakeUpUniqueID[h, "UProc"],
                type: type, typeName: typeName]];
            [] _ SymTab.Store[h.allTheTables.workTable, key, value] };
        RETURN [NARROW[value, UMProcEntry].procName];
        };

    GetMProcName: PUBLIC UMProcNameProc
        <<[h: Handle, type: CType, typeName: ROPE] RETURNS [procName: ROPE]>>
        ~ {
        key: ROPE;
        value: SymTab.Val;
        successful: BOOL;
        SELECT type.class FROM
            choice => NULL;
            seq => NULL;
            ENDCASE => RETURN [NIL];
        key _ Rope.Concat[">", typeName];
        [successful, value] _ SymTab.Fetch[h.allTheTables.workTable, key];
        IF NOT successful THEN {
            value _ NEW[UMProcEntryObject _ [
                kind: marshal, generated: FALSE,
                procName: MakeUpUniqueID[h, "MProc"],
                type: type, typeName: typeName]];
            [] _ SymTab.Store[h.allTheTables.workTable, key, value] };
        RETURN [NARROW[value, UMProcEntry].procName];
        };
    GenerateUMProcs: PUBLIC PROC [h: Handle, s: IO.STREAM, level: NAT] ~ {
        generatedAProc: BOOL;
        GenerateAProc: SymTab.EachPairAction ~ {
            procEntry: UMProcEntry ~ NARROW [val];
            IF procEntry.generated THEN RETURN;
            generatedAProc _ procEntry.generated _ TRUE;
            IO.PutRope[s, Nest[NIL, level]];
            SELECT procEntry.kind FROM
                unMarshal => {
                    IO.PutF[s, "%g: PROC [h: CrRPC.Handle, s: CrRPC.STREAM] RETURNS [res: %g] ~ {%g",
                        IO.rope[procEntry.procName],
                        IO.rope[UnDo[procEntry.typeName, h.programKey]],
                        IO.rope[Nest[NIL, level+1]]
                        ];
                    UnMarshal[h, s, "res", procEntry.type, procEntry.typeName, GetUProcName, FALSE, (level+1)];
                    };
                marshal => {
                    IO.PutF[s, "%g: PROC [h: CrRPC.Handle, s: CrRPC.STREAM, val: %g] ~ {%g",
                        IO.rope[procEntry.procName],
                        IO.rope[UnDo[procEntry.typeName, h.programKey]],
                        IO.rope[Nest[NIL, level+1]]
                        ];
                    Marshal[h, s, "val", procEntry.type, procEntry.typeName, GetMProcName, FALSE, level+1];
                    };
                ENDCASE => ERROR;
            IO.PutF[s, "%g};%g",
                IO.rope[Nest[NIL, level+1]],
                IO.rope[Nest[NIL, level]]
                ];
            };
        DO
            generatedAProc _ FALSE;
            [] _ SymTab.Pairs[h.allTheTables.workTable, GenerateAProc];
            IF ( NOT generatedAProc ) THEN EXIT;
            ENDLOOP;
        };

    Marshal: PUBLIC PROC [h: Handle, s: IO.STREAM, varName: ROPE, type: CType, typeName: ROPE, getProcName: UMProcNameProc, useProc: 
    BOOL, level: NAT] ~ {
        successful: BOOLEAN;
        value: SymTab.Val;
        IF ( useProc ) THEN {
            specialProcName: ROPE ~ 
            IF ( getProcName = NIL ) THEN NIL ELSE getProcName[h, type, typeName];
            IF ( NOT Rope.IsEmpty[specialProcName] ) THEN {
                IO.PutF[s, "%g[h, s, %g];",
                    IO.rope[specialProcName],
                    IO.rope[varName]
                    ];
                RETURN;
                };
            };
        SELECT type.class FROM
            array =>  {
                uniqueLoopIndex: ROPE _ MakeUpUniqueID[h, "i"];
                IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g) DO", (level+1)],
                    IO.rope[uniqueLoopIndex],
                    IO.int[type.bound]
                    ];
                [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
                Marshal[h, s, Rope.Cat[varName, "[", uniqueLoopIndex, "]"],
                NARROW [value], type.children.type, getProcName, TRUE,
                (level+1)];
                IO.PutRope[s, Nest[NIL, (level+1)]];
                IO.PutRope[s, "ENDLOOP;"];
                };
            bool => { IO.PutF[s, "CrRPC.PutBool[s, %g];", IO.rope[varName] ]; };
            card16 => { IO.PutF[s, "CrRPC.PutCard16[s, %g];", IO.rope[varName] ]; };
            card32 => { IO.PutF[s, "CrRPC.PutCard32[s, %g];", IO.rope[varName] ]; };
            choice => {
                tag: ROPE _ MakeUpUniqueID[h, "tag"];
                unionTypeName: ROPE _ MadeUpName[UnDo[typeName, h.programKey], "Object"];
                IO.PutF[s, Nest["CrRPC.PutCard16[s, ORD[%g.type]];", level],
                    IO.rope[varName]
                    ];
                IO.PutF[s, Nest["WITH %g SELECT FROM", (level+1)],
                    IO.rope[varName]
                    ];
                FOR list: CComponent _ type.children.sibling, list.sibling WHILE (list # NIL) DO
                    IO.PutF[s, Nest["it: REF %g.%g => {", (level+2)],
                        IO.rope[unionTypeName],
                        IO.rope[list.name]
                        ];
                    [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
                    Marshal[h, s, Rope.Concat["it^.", list.name],
                    NARROW [value], list.type, getProcName, TRUE,
                    (level+2)];
                    IO.PutRope[s, Nest[NIL, (level+2)]];
                    IO.PutRope[s, Nest["};", (level+1)]];
                    ENDLOOP;
                IO.PutRope[s, "ENDCASE;"];
                };
            enum => { IO.PutF[s, "CrRPC.PutCard16[s, ORD[%g]];", IO.rope[varName] ]; };
            int16 => { IO.PutF[s, "CrRPC.PutInt16[s, %g];", IO.rope[varName] ]; };
            int32 => { IO.PutF[s, "CrRPC.PutInt32[s, %g];", IO.rope[varName] ]; };
            record => {
                IF type.children = NIL
                    THEN IO.PutRope[s, "NULL; -- RECORD [] --"]
                    ELSE FOR list: CComponent _ type.children, list.sibling WHILE list # NIL DO
                        [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
                        Marshal[h, s, Rope.Cat[varName, ".", list.name],
                        NARROW [value], list.type, getProcName, TRUE,
                        (level)]; -- a special case! (bj)
                        IF (list.sibling # NIL)
                            THEN IO.PutRope[s, Nest[NIL, (level)]];
                        ENDLOOP;
                };
            seq => {
                uniqueLoopIndex: ROPE _ MakeUpUniqueID[h, "i"];
                IO.PutF[s, Nest["CrRPC.PutCard16[s, %g.length];", level],
                    IO.rope[varName]
                    ];
                IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g.length) DO", (level+1)],
                    IO.rope[uniqueLoopIndex],
                    IO.rope[varName]
                    ];
                [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
                Marshal[h, s, Rope.Cat[varName, ".body[", uniqueLoopIndex, "]"],
                NARROW [value], type.children.type, getProcName, TRUE,
                (level+1)];
                IO.PutRope[s, Nest[NIL, (level+1)]];
                IO.PutRope[s, "ENDLOOP;"];
                };
            sink => { IO.PutF[s, "CrRPC.PutBulkDataSink[h, s, %g];", IO.rope[varName] ]; };
            source => { IO.PutF[s, "CrRPC.PutBulkDataSource[h, s, %g];", IO.rope[varName] ]; };
            string => { IO.PutF[s, "CrRPC.PutRope[s, %g];", IO.rope[varName] ]; };
            unspec => { IO.PutF[s, "CrRPC.PutCard16[s, %g];", IO.rope[varName] ]; };
            ENDCASE => {
                IO.PutRope[s, "--UNKNOWN--"];
                ERROR;
                };
        };

    UnMarshal: PUBLIC PROC [h: Handle, s: IO.STREAM, varName: ROPE, type: CType, typeName: ROPE, getProcName: UMProcNameProc, useProc: 
    BOOL, level: NAT] ~ {
        successful: BOOLEAN;
        value: SymTab.Val;
        IF ( useProc ) THEN {
            specialProcName: ROPE ~ 
            IF getProcName = NIL THEN NIL ELSE getProcName[h, type, typeName];
            IF ( NOT Rope.IsEmpty[specialProcName] ) THEN {
                IO.PutF[s, "%g _ %g[h, s];",
                    IO.rope[varName],
                    IO.rope[specialProcName]
                    ];
                RETURN;
                };
            };
        SELECT type.class FROM
            array =>  {
                uniqueLoopIndex: ROPE _ MakeUpUniqueID[h, "i"];
                IO.PutF[s, "FOR %g: CARDINAL IN [0..%g) DO",
                    IO.rope[uniqueLoopIndex],
                    IO.int[type.bound]
                    ];
                [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
                IO.PutRope[s, Nest[NIL, (level+1)]];
                UnMarshal[h, s, Rope.Cat[varName, "[", uniqueLoopIndex, "]"],
                NARROW [value], type.children.type, getProcName, TRUE,
                (level+1)];
                IO.PutRope[s, Nest[NIL, (level+1)]];
                IO.PutRope[s, "ENDLOOP;"];
                };
            bool => { IO.PutF[s, "%g _ CrRPC.GetBool[s];", IO.rope[varName] ]; };
            card16 => { IO.PutF[s, "%g _ CrRPC.GetCard16[s];", IO.rope[varName] ]; };
            card32 => { IO.PutF[s, "%g _ CrRPC.GetCard32[s];", IO.rope[varName] ]; };
            choice => {
                tag: ROPE _  MakeUpUniqueID[h, "tag"];
                tempVarName: ROPE _ MakeUpUniqueID[h, "temp"];
                tagTypeName: ROPE _ UnDo[type.children.type, h.programKey];
                objTypeName: ROPE _ MadeUpName[UnDo[typeName, h.programKey], "Object"];
                IO.PutRope[s, Nest["{", (level+1)]];
                IO.PutF[s, Nest["%g: %g ~ VAL[CrRPC.GetCard16[s]];", (level+1)],
                    IO.rope[tag],
                    IO.rope[tagTypeName]
                    ];
                IO.PutF[s, Nest["SELECT %g FROM", (level+2)],
                    IO.rope[tag]
                    ];
                FOR list: CComponent _ type.children.sibling, list.sibling WHILE (list # NIL) DO
                    variantType: CType;
                    [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
                    variantType _ NARROW [value];

                    IO.PutF[s, Nest["%g => {", (level+3)],
                        IO.rope[list.name]
                        ];
                    IO.PutF[s, Nest["%g: %g;", (level+3)],
                        IO.rope[tempVarName],
                        IO.rope[UnDo[list.type, h.programKey]]
                        ];
                    UnMarshal[h, s, tempVarName,
                    variantType, list.type, getProcName, TRUE,
                    (level+3)];
                    IO.PutRope[s, Nest[NIL, (level+3)]];
                    IO.PutF[s, Nest["%g _ NEW[%g.%g _ [%g[%g]]] };", (level+2)],
                        IO.rope[varName],
                        IO.rope[objTypeName],
                        IO.rope[list.name],
                        IO.rope[list.name],
                        IO.rope[tempVarName]
                        ];
                    ENDLOOP;
                IO.PutRope[s, Nest["ENDCASE => ERROR;", (level+1)]]; -- make this CrRPC.Error????
                IO.PutRope[s, "};"];
                };
            enum => { IO.PutF[s, "%g _ VAL[CrRPC.GetCard16[s]];", IO.rope[varName] ]; };
            int16 => { IO.PutF[s, "%g _ CrRPC.GetInt16[s];", IO.rope[varName] ]; };
            int32 => { IO.PutF[s, "%g _ CrRPC.GetInt32[s];", IO.rope[varName] ]; };
            record => {
                IF (type.children = NIL) THEN
                    <<Avoid compiler bug for empty records.>>
                    IO.PutRope[s, Rope.Concat[varName, ".null _ 0;"]];
                FOR list: CComponent _ type.children, list.sibling WHILE list # NIL DO
                    [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
                    UnMarshal[h, s, Rope.Cat[varName, ".", list.name],
                    NARROW [value], list.type, getProcName, TRUE,
                    (level)]; -- a special case! (bj)
                    IF (list.sibling # NIL)
                        THEN IO.PutRope[s, Nest[NIL, (level)]];
                    ENDLOOP;
                };
            seq => {  
                uniqueLoopIndex: ROPE _ MakeUpUniqueID[h, "i"];
                uniqueName: ROPE _ MakeUpUniqueID[h, "length"];
                objTypeName: ROPE _ MadeUpName[UnDo[typeName, h.programKey], "Object"];
                IO.PutRope[s, Nest["{", (level+1)]];
                IO.PutF[s, Nest["%g: CARDINAL ~ CrRPC.GetCard16[s];", (level+1)],
                    IO.rope[uniqueName]
                    ];
                IO.PutF[s, Nest["%g _  NEW[%g[%g]];", (level+1)],
                    IO.rope[varName],
                    IO.rope[objTypeName],
                    IO.rope[uniqueName]
                    ];
                IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g) DO", (level+2)],
                    IO.rope[uniqueLoopIndex],
                    IO.rope[uniqueName]
                    ];
                [successful, value] _ SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
                UnMarshal[h, s, Rope.Cat[varName, ".body[", uniqueLoopIndex, "]"],
                NARROW [value], type.children.type, getProcName, TRUE,
                (level+2)];
                IO.PutRope[s, Nest[NIL, (level+2)]];
                IO.PutRope[s, Nest["ENDLOOP;", (level+1)]];
                IO.PutRope[s, "};"];
                };
            sink => { IO.PutF[s, "%g _ CrRPC.GetBulkDataSink[h, s];", IO.rope[varName] ]; };
            source => { IO.PutF[s, "%g _ CrRPC.GetBulkDataSource[h, s];", IO.rope[varName] ]; };
            string => { IO.PutF[s, "%g _ CrRPC.GetRope[s];", IO.rope[varName] ]; };
            unspec => { IO.PutF[s, "%g _ CrRPC.GetCard16[s];", IO.rope[varName] ]; };
            ENDCASE => {
                IO.PutF[s, " -- %g _ CrRPC.GetCard16[s]; (UNKNOWN)--", IO.rope[varName] ];
                ERROR;
                };

        };

    FileHeader: PUBLIC PROC [out: IO.STREAM, filename: ROPE] ~ {
        IO.PutF[out, Nest["-- %g", 1], IO.rope[filename]];
        IO.PutF[out, Nest["-- Copyright Ó 1987 by Xerox Corporation.  All rights reserved.", 1]];
        IO.PutF[out, Nest["-- Generated by %g at %g", 1], IO.rope[UserCredentials.Get[].name], IO.time[]];
        IO.PutF[out, Nest["--  using %g", 1], IO.rope[Version]];
        IO.PutF[out, Nest[NIL, 0]];
        };

    Init: PROC ~ {
        date: BasicTime.GMT ~ Loader.BCDBuildTime[SiroccoPrivateImpl.Init]; -- incest!
        Version _ IO.PutFR["Sirocco [2.1] of %g", IO.time[date] ];
        <<Version 1.0: first try>>
        <<Version 2.0: restructure with ref's for variant records>>
        <<Version 2.1: hack in positional information for pretty interfaces>>
        };
    Init[];
}.