
    <<LogPack.Mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 25, 1986 9:40:06 am PDT>>
        <<Maxwell, August 11, 1983 8:32 am>>
        <<Russ Atkinson (RRA) March 6, 1985 10:21:16 pm PST>>
    <<>>
    DIRECTORY
        Ascii: TYPE USING [ControlZ],
        ComData: TYPE USING [bodyIndex, cedar, nErrors, nWarnings, ownSymbols, switches, textIndex],
        CompilerUtil: TYPE USING [AcquireStream, AcquireTable, ReleaseStream, ReleaseTable],
        ConvertUnsafe: TYPE USING [SubString],
        ErrorTable: TYPE USING [CSRptr],
        IO: TYPE USING [card, char, CR, GetChar, EndOf, int, Put, PutChar, PutF, PutRope, rope, SetIndex, SP, STREAM],
        Literals: TYPE USING [LTIndex, STIndex],
        LiteralOps: TYPE USING [Value, StringValue],
        Log: TYPE USING [ErrorCode, Type],
        Rope: TYPE USING [ROPE],
        SourceMap: TYPE USING [nullLoc],
        Symbols: TYPE USING [Name, ISEIndex, Type, CSEIndex, CTXIndex, TransferMode, nullName, ISENull, nullType, BTNull, codeINT],
        SymbolTable: TYPE USING [Base],
        Tree: TYPE USING [Base, Index, Link, NodeName, Scan, Null],
        TreeOps: TYPE USING [GetLit, GetTag, ScanList];

    LogPack: PROGRAM
        IMPORTS CompilerUtil, IO, LiteralOps, TreeOps, dataPtr: ComData
        EXPORTS Log, SourceMap = {
        OPEN Symbols;

        ErrorCode: TYPE = Log.ErrorCode;
        FileByteIndex: TYPE = INT;

    <<source location encoding>>
    <<>>
        Loc: PUBLIC TYPE = CARD;
            nullLoc: Loc = SourceMap.nullLoc;

        chunkSize: NAT = 256;
        maxChunks: NAT = NAT.LAST/chunkSize + 1;
        IndexChunk: TYPE = ARRAY [0..chunkSize) OF INT;
        ChunkMap: TYPE = ARRAY [0..maxChunks) OF REF IndexChunk;
        map: REF ChunkMap _ NIL;
        next: CARDINAL _ 0;

        Init: PUBLIC PROC = Reset;

        Reset: PUBLIC PROC = {
            IF map # NIL THEN {
                FOR i: NAT IN [0..maxChunks) DO
                    IF map[i] # NIL THEN FREE[@map[i]]
                    ENDLOOP;
                FREE[@map]};
            next _ 0};

        Cons: PUBLIC PROC[index: INT] RETURNS[loc: Loc] = {
            IF index IN [0..NAT.LAST] THEN loc _ index
            ELSE {
                chunk: NAT = next/chunkSize;
                slot: NAT = next MOD chunkSize;
                IF map = NIL THEN map _ NEW[ChunkMap _ ALL[NIL]];
                IF map[chunk] = NIL THEN map[chunk] _ NEW[IndexChunk];
                map[chunk][slot] _ index;
                loc _ next + (NAT.LAST+1);  next _ next + 1;
                IF next > NAT.LAST THEN ERROR};
            RETURN};

        Val: PUBLIC PROC[loc: Loc] RETURNS[index: INT] = {
            IF loc <= NAT.LAST THEN index _ loc
            ELSE {
                d: NAT = loc - CARDINAL[NAT.LAST+1];
                index _ map[d/chunkSize][d MOD chunkSize]};
            RETURN};
         
        <<>>
    <<public interface>>

        Error: PUBLIC PROC[code: ErrorCode] = {
            Enter[]; WriteErrorString[code]; ErrorLog[TRUE]; Exit[]};

        ErrorHti: PUBLIC PROC[code: ErrorCode, name: Name] = {
            ErrorTree[code, [hash[name]]]};

        ErrorN: PUBLIC PROC[code: ErrorCode, n: INTEGER] = {
            Enter[];
            errorStream.Put[IO.int[n]];  errorStream.PutChar[' ];
            WriteErrorString[code]; ErrorLog[TRUE];
            Exit[]};

        ErrorNode: PUBLIC PROC[code: ErrorCode, node: Tree.Index] = {
            ErrorTree[code, [subtree[node]]]};

        ErrorNodeOp: PUBLIC PROC[code: ErrorCode, node: Tree.Index, op: Tree.NodeName] = {
            ErrorTreeOp[code, [subtree[node]], op]};

        ErrorSei: PUBLIC PROC[code: ErrorCode, sei: ISEIndex] = {
            ErrorTree[code, [symbol[sei]]]};

        ErrorTree: PUBLIC PROC[code: ErrorCode, t: Tree.Link] = {
            Enter[];
            PrintOperand[t, 0, 0];  errorStream.PutRope["  "];
            WriteErrorString[code]; ErrorLog[TRUE];
            Exit[]};

        ErrorTreeOp: PUBLIC PROC[code: ErrorCode, t: Tree.Link, op: Tree.NodeName] = {
            Enter[];
            PrintOperand[t, 0, 0];  errorStream.PutRope["  "];
            WriteErrorString[code];  PrintOperator[op];  errorStream.PutRope[" operation"];
            ErrorLog[TRUE];
            Exit[]};

        ErrorType: PUBLIC PROC[code: ErrorCode, t: Tree.Link, type: Log.Type] = {
            Enter[];
            PrintOperand[t, 0, 0];  errorStream.PutRope["  "];
            WriteErrorString[code];  PrintType[type];
            ErrorLog[TRUE];
            Exit[]};

        Warning: PUBLIC PROC[code: ErrorCode] = {
            IF dataPtr.switches['w] THEN {
                Enter[];
                errorStream.PutRope["warning: "];
                WriteErrorString[code];  ErrorLog[FALSE];
                Exit[]}
            };

        WarningNode: PUBLIC PROC[code: ErrorCode, node: Tree.Index] = {
            WarningTree[code, [subtree[node]]]};

        WarningSei: PUBLIC PROC[code: ErrorCode, sei: ISEIndex] = {
            WarningTree[code, [symbol[sei]]]};

        WarningSubString: PUBLIC PROC[code: ErrorCode, s: ConvertUnsafe.SubString] = {
            IF dataPtr.switches['w] THEN {
                Enter[];
                WriteSubString[s];  errorStream.PutChar[' ]; 
                WriteErrorString[code];  ErrorLog[FALSE];
                Exit[]}
            };

        WarningRope: PUBLIC PROC[code: ErrorCode, s: Rope.ROPE] = {
            IF dataPtr.switches['w] THEN {
                Enter[];
                errorStream.Put[IO.rope[s], IO.char[' ]]; 
                WriteErrorString[code];  ErrorLog[FALSE];
                Exit[]}
            };

        WarningTree: PUBLIC PROC[code: ErrorCode, t: Tree.Link] = {
            IF dataPtr.switches['w] THEN {
                Enter[];
                errorStream.PutRope["warning:  "];
                PrintOperand[t, 0, 0];  errorStream.PutRope["  "];
                WriteErrorString[code];  ErrorLog[FALSE];
                Exit[]}
            };

    <<source printing>>

        PrintTextLine: PROC[i: Loc] = {
            start, lineIndex: FileByteIndex;
            char: CHAR;
            n: [1..100];
            sourceStream: IO.STREAM _ CompilerUtil.AcquireStream[$source];
            start _ lineIndex _ Val[i];
            FOR n IN [1..100] UNTIL lineIndex = 0 DO
                lineIndex _ lineIndex - 1;
                sourceStream.SetIndex[lineIndex];
                IF sourceStream.GetChar[] = IO.CR THEN EXIT;
                start _ lineIndex;
                ENDLOOP;
            sourceStream.SetIndex[start];
            FOR n IN [1..100] WHILE ~sourceStream.EndOf[] DO
                SELECT (char _ IO.GetChar[sourceStream]) FROM
                    IO.CR, Ascii.ControlZ => EXIT;
                    ENDCASE => errorStream.PutChar[char];
                ENDLOOP;
            errorStream.PutChar['\n];  
            CompilerUtil.ReleaseStream[$source]};


        <<errorStream, CSRp and desc.base are set by Enter>>

        errorStream: IO.STREAM _ NIL;

        CSRp: ErrorTable.CSRptr;
        ss: ConvertUnsafe.SubString _ [NIL, 0, 0];

        Enter: PROC = {
            errorStream _ CompilerUtil.AcquireStream[$log];
            CSRp _ CompilerUtil.AcquireTable[error];
            ss.base _ @CSRp[CSRp.stringOffset]};

        Exit: PROC = {
            CompilerUtil.ReleaseTable[error];
            CompilerUtil.ReleaseStream[$log];  errorStream _ NIL};


        WriteSubString: PROC[s: ConvertUnsafe.SubString] = {
            FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO
                errorStream.PutChar[s.base[i]]
                ENDLOOP
            };

        WriteId: PROC[stb: SymbolTable.Base, name: Name] = {
            IF name # nullName THEN {
                s: ConvertUnsafe.SubString _ stb.SubStringForName[name]; 
                WriteSubString[s]}
            };


        WriteErrorString: PROC[n: ErrorCode] = {
            ss.offset _ CSRp.ErrorMessages[n].offset;
            ss.length _ CSRp.ErrorMessages[n].length;
            WriteSubString[ss]};

        WriteName: PROC[name: Name] = {
            IF name = nullName THEN errorStream.PutRope["(anonymous)"]
            ELSE WriteId[dataPtr.ownSymbols, name]};

        WriteSei: PROC[sei: ISEIndex] = {
            WriteName[IF sei = ISENull
                THEN nullName
                ELSE dataPtr.ownSymbols.seb[sei].hash]
            };


        WriteLti: PROC[lti: Literals.LTIndex] = {
            errorStream.Put[IO.int[LiteralOps.Value[lti]]]};

        WriteSti: PROC[sti: Literals.STIndex] = {
            s: LONG STRING = LiteralOps.StringValue[sti];
            errorStream.PutChar['"];
            FOR i: CARDINAL IN [0..s.length) DO errorStream.PutChar[s[i]] ENDLOOP;
            errorStream.PutChar['"]};


        <<tables used for printing trees (pending reordering of node names)>>

        <<OpName: ARRAY Tree.NodeName[$assignx..$uparrow] OF STRING = [>>
            <<"_",>>
            <<" OR ", " AND ", "=", "#", "<", ">=", ">", "<=", " IN ", " ~IN ",>>
            <<"+", "-", "*", "/", " MOD ",>>
            <<".", ".", ".",>>
            <<" NEW ", "~", "-", "@", "^"];>>

        OpPrec: ARRAY Tree.NodeName[$assignx..$uparrow] OF CARDINAL = [
            1, 1,
            2, 3, 5, 5, 5, 5, 5, 5, 5, 5,
            6, 6, 7, 7, 7,
            10, 10, 10,
            1, 4, 8, 9, 10];

        WriteOpName: PROC[n: Tree.NodeName[$assignx..$uparrow]] = {
            ss.offset _ CSRp.OpName[n].offset;
            ss.length _ CSRp.OpName[n].length;
            WriteSubString[ss]};


        <<FnName: ARRAY Tree.NodeName[$min..$new] OF STRING = [>>
            <<"MIN", "MAX", "LONG", "ABS", "ALL", "SIZE", "FIRST", "LAST", "PRED", "SUCC",>>
            <<"DESCRIPTOR", "LENGTH", "BASE", "LOOPHOLE", "NIL", "NEW"];>>

        WriteFnName: PROC[n: Tree.NodeName[$min..$new]] = {
            ss.offset _ CSRp.FnName[n].offset;  ss.length _ CSRp.FnName[n].length;
            WriteSubString[ss]};


        <<ApplName: ARRAY Tree.NodeName[$apply..$joinx] OF STRING _ [>>
            <<"APPLY", "APPLY", "", "SIGNAL", "ERROR", "ERROR", "START", "FORK", "JOIN"];>>

        WriteApplName: PROC[n: Tree.NodeName[$apply..$joinx]] = {
            ss.offset _ CSRp.ApplName[n].offset;  ss.length _ CSRp.ApplName[n].length;
            WriteSubString[ss]};

        <<>>
        <<FApplName: ARRAY Tree.NodeName[$restart..$broadcast] OF STRING _ [>>
            <<"RESTART", "STOP", "LOCK", "WAIT", "NOTIFY", "BROADCAST"];>>

        WriteFApplName: PROC[n: Tree.NodeName[$restart..$broadcast]] = {
            ss.offset _ CSRp.FApplName[n].offset;  ss.length _ CSRp.FApplName[n].length;
            WriteSubString[ss]};


        PrintOperator: PROC[op: Tree.NodeName] = {
            IF op IN Tree.NodeName[$apply..$joinx] THEN WriteApplName[op]
            ELSE IF op IN Tree.NodeName[$assignx..$uparrow] THEN WriteOpName[op]
            ELSE IF op IN Tree.NodeName[$min..$new] THEN WriteFnName[op]
            ELSE IF op = $ord THEN errorStream.PutRope["ORD"]
            ELSE IF op IN Tree.NodeName[$call..$join] THEN {
                applMap: ARRAY Tree.NodeName[$call..$join] OF Tree.NodeName = [
                    call: $callx, portcall: $portcallx, signal: $signalx, error: $errorx, syserror: $syserrorx,
                    xerror: $errorx,start: $startx, join: $joinx];
                PrintOperator[applMap[op]]}
            ELSE IF op IN Tree.NodeName[$restart..$broadcast] THEN WriteFApplName[op]
            ELSE errorStream.PutRope["..."]};


        Cutoff: CARDINAL = 3;

        PrintOperand: PROC[t: Tree.Link, tPrec, depth: CARDINAL] = {
            IF t = Tree.Null THEN RETURN;
            WITH e: t SELECT TreeOps.GetTag[t] FROM
                hash => WriteName[e.index];
                symbol => WriteSei[e.index];
                literal => WriteLti[e.index];
                string => WriteSti[e.index];
                subtree => {
                    node: Tree.Index = e.index;
                    tb: Tree.Base _ dataPtr.ownSymbols.tb;
                    op: Tree.NodeName = tb[node].name;
                    IF depth > Cutoff THEN {errorStream.PutRope["..."]; RETURN};
                    SELECT op FROM
                        syserror, syserrorx => errorStream.PutRope["ERROR"];
                        lengthen, --abs,-- IN [first..succ], IN [length..base], nil => {
                            IF tb[node].son[1] # Tree.Null THEN {
                                PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
                                errorStream.PutChar['.]};
                            WriteFnName[op]};
                        ord => {            -- pending reordering of node names
                            PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
                            errorStream.PutRope[".ORD"]};
                        IN [call .. rowcons], stringinit, IN [min .. loophole], val => {
                            OPEN tb[node];
                            args: Tree.Link;
                            SELECT op FROM
                                IN [call .. rowcons], stringinit => {
                                    IF son[1] # Tree.Null THEN PrintOperand[son[1], 0, depth];
                                    args _ son[2]};
                                IN [min .. loophole] => {WriteFnName[op]; args _ son[1]};
                                val => {errorStream.PutRope["VAL"]; args _ son[1]};    -- until reordered
                                ENDCASE;
                            IF args # Tree.Null OR op # nil THEN {
                                errorStream.PutChar['[];
                                IF depth = Cutoff AND TreeOps.GetTag[args] = subtree THEN
                                    errorStream.PutRope["..."]
                                ELSE PrintOperandList[args, depth+1];
                                IF op IN [call .. joinx] AND nSons > 2 THEN
                                    errorStream.PutRope[" !..."];
                                errorStream.PutChar[']]}};
                        IN [assignx .. uparrow] => {
                            OPEN tb[node];
                            prec: CARDINAL = OpPrec[op];
                            IF prec < tPrec THEN errorStream.PutChar['(];
                            SELECT op FROM
                                IN [create .. addr] => {WriteOpName[op]; PrintOperand[son[1], prec, depth]};
                                IN [assignx .. dollar] => {
                                    PrintOperand[son[1], prec, depth+1];
                                    WriteOpName[op];
                                    PrintOperand[son[2], prec+1, depth+1]};
                                uparrow => {
                                    PrintOperand[son[1], prec, depth];
                                    errorStream.PutChar['^]};
                                ENDCASE => errorStream.PutChar['?];
                            IF prec < tPrec THEN errorStream.PutChar[')]};
                        IN [intOO .. intCC] => {
                            OPEN tb[node];
                            errorStream.PutChar[IF op = intOO OR op = intOC THEN '( ELSE '[];
                            PrintOperand[son[1], 0, depth];
                            errorStream.PutRope[".."];
                            PrintOperand[son[2], 0, depth];
                            errorStream.PutChar[IF op = intOO OR op = intCO THEN ') ELSE ']]};
                        clit => {
                            c: CHAR = VAL[CARDINAL[LiteralOps.Value[TreeOps.GetLit[tb[node].son[1]]]]];
                            errorStream.PutChar[''];
                            IF c >= IO.SP THEN errorStream.PutChar[c]
                            ELSE {errorStream.PutF["\\%3b", IO.card[c.ORD]]}};
                        new, cons, listcons => {
                            IF tb[node].son[1] # Tree.Null THEN {
                                PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
                                errorStream.PutChar['.]};
                            errorStream.PutRope[
                                SELECT op FROM new => "NEW", cons => "CONS", ENDCASE => "LIST"];
                            errorStream.PutChar['[];
                            IF depth = Cutoff THEN errorStream.PutRope["..."]
                            ELSE PrintOperandList[tb[node].son[2], depth+1];
                            errorStream.PutChar[']]};
                        atom => {
                            errorStream.PutChar['$];
                            WITH e1: tb[node].son[1] SELECT TreeOps.GetTag[tb[node].son[1]] FROM
                                hash => WriteName[e1.index];
                                ENDCASE};
                        llit, IN [cast .. openx], thread => PrintOperand[tb[node].son[1], tPrec, depth];
                        item => PrintOperand[tb[node].son[2], tPrec, depth];
                        ENDCASE => errorStream.PutRope["..."]};
                ENDCASE};

        PrintOperandList: PROC[t: Tree.Link, depth: CARDINAL] = {
            firstSon: BOOL _ TRUE;

            PrintItem: Tree.Scan = {
                IF ~firstSon THEN errorStream.PutRope[", "];
                firstSon _ FALSE;
                IF t # Tree.Null THEN PrintOperand[t, 0, depth]};

            TreeOps.ScanList[t, PrintItem]};


        PrintType: PROC[root: Log.Type] = {
            seb: Tree.Base _ root.stb.seb;
            ItemPrinter: TYPE = PROC[sei: ISEIndex, depth: NAT];

            PrintSei: ItemPrinter = {WriteId[root.stb, seb[sei].hash]};

            PrintField: ItemPrinter = {
                IF seb[sei].hash # nullName THEN {
                    WriteId[root.stb, seb[sei].hash];  errorStream.PutRope[": "]};
                PrintTypeExp[seb[sei].idType, depth]};

            PrintCtxItems: PROC[ctx: CTXIndex, printer: ItemPrinter, depth: NAT] = {
                nItems: CARDINAL = root.stb.CtxEntries[ctx];
                maxItems: CARDINAL = MIN[nItems, 4/(depth+1)];  
                n: CARDINAL _ 0; 
                FOR sei: ISEIndex _ root.stb.FirstCtxSe[ctx], root.stb.NextSe[sei] UNTIL n = maxItems DO
                    IF n # 0 THEN errorStream.PutRope[", "];
                    printer[sei, depth+1];
                    n _ n + 1;
                    ENDLOOP;
                IF nItems > maxItems THEN {
                    IF n > 0 THEN errorStream.PutRope[", "];  errorStream.PutRope["..."]};
                };

            PrintTypeExp: PROC[type: Symbols.Type, depth: NAT] = {
                IF depth <= Cutoff THEN
                    WITH t: seb[type] SELECT FROM
                        id => WriteId[root.stb, t.hash];
                        cons =>
                            WITH s: t SELECT FROM
                                mode => errorStream.PutRope["TYPE"];
                                enumerated => {
                                    errorStream.PutChar['{];
                                    PrintCtxItems[s.valueCtx, PrintSei, depth];
                                    errorStream.PutChar['}]};
                                record => {
                                    IF ~s.argument THEN errorStream.PutRope["RECORD"];
                                    errorStream.PutChar['[];
                                    PrintCtxItems[s.fieldCtx, PrintField, depth];
                                    errorStream.PutChar[']]};
                                ref => {
                                    IF s.var THEN
                                        errorStream.PutRope[IF s.readOnly THEN "READONLY " ELSE "VAR "]
                                    ELSE {
                                        errorStream.PutRope[IF s.counted THEN "REF " ELSE "POINTER TO "];
                                        IF s.readOnly THEN errorStream.PutRope["READONLY "]};
                                    PrintTypeExp[s.refType, depth+1]};
                                array => {
                                    IF s.packed THEN errorStream.PutRope["PACKED "];
                                    errorStream.PutRope["ARRAY "];
                                    PrintTypeExp[s.indexType, depth+1];
                                    errorStream.PutRope[" OF "];
                                    PrintTypeExp[s.componentType, depth+1]};
                                arraydesc => {
                                    errorStream.PutRope["DESCRIPTOR FOR "];
                                    PrintTypeExp[s.describedType, depth+1]};
                                transfer => {
                                    xferName: ARRAY Symbols.TransferMode OF Rope.ROPE = [
                                        "PROC", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM", NIL];
                                    IF s.safe # dataPtr.cedar THEN
                                        errorStream.PutRope[IF s.safe THEN "SAFE " ELSE "UNSAFE "];
                                    errorStream.PutRope[xferName[s.mode]];
                                    IF s.typeIn # Symbols.nullType THEN PrintTypeExp[s.typeIn, depth];
                                    IF s.typeOut # Symbols.nullType THEN {
                                        errorStream.PutRope[" RETURNS"];  PrintTypeExp[s.typeOut, depth]};
                                    };
                                subrange => {

                                    NumericType: PROC[type: Symbols.Type] RETURNS[BOOL] = INLINE {
                                        nType: CSEIndex = root.stb.NormalType[type];
                                        RETURN[WITH n: seb[nType] SELECT FROM
                                            basic => n.code = codeINT,
                                            ENDCASE => FALSE]
                                        };

                                    PrintTypeExp[s.rangeType, depth+1];
                                    errorStream.PutChar['[];
                                    IF s.filled AND ~s.empty AND NumericType[s.rangeType] THEN
                                        errorStream.Put[IO.int[s.origin], IO.rope[".."], IO.int[s.origin+s.range+1]]
                                    ELSE errorStream.PutRope["..."];
                                    errorStream.PutChar[')]};
                                long => {
                                    IF root.stb.RCType[type] = $simple THEN
                                        PrintTypeExp[s.rangeType, depth]
                                    ELSE {errorStream.PutRope["LONG "]; PrintTypeExp[s.rangeType, depth+1]}};
                                zone => {
                                    IF ~s.counted THEN errorStream.PutRope["UNCOUNTED "];
                                    errorStream.PutRope["ZONE"]};
                                any => errorStream.PutRope["ANY"];
                                ENDCASE => errorStream.PutRope["..."];
                        ENDCASE;
                };

            errorStream.PutRope[" (expected "]; PrintTypeExp[root.type, 0]; errorStream.PutChar[')]};


    <<error-handling routines>>

        ErrorLog: PROC[error: BOOL] = {
            bodyId: ISEIndex;
            index: Loc = dataPtr.textIndex;
            IF error THEN dataPtr.nErrors _ dataPtr.nErrors + 1
            ELSE dataPtr.nWarnings _ dataPtr.nWarnings + 1;
            errorStream.PutRope[", at "];
            IF dataPtr.bodyIndex # BTNull THEN {
                bodyId _ dataPtr.ownSymbols.bb[dataPtr.bodyIndex].id;
                IF bodyId # ISENull THEN WriteSei[bodyId]};
            IF index # nullLoc THEN errorStream.PutF["[%d]", IO.int[Val[index]]];
            errorStream.PutChar[':];  errorStream.PutChar['\n];
            IF index # nullLoc THEN PrintTextLine[index]
            ELSE errorStream.PutRope["(source from inline)\n"];
            errorStream.PutChar['\n]};

        }.

